2016-20-10 Paul Thomas <pault@gcc.gnu.org>

	* trans-array.c (gfc_conv_expr_descriptor): Detect class object
	with an abstract declared type. Use the type of the data field
	and the dynamic element length from the symbol backend_decl.
	* trans-decl.c (gfc_trans_deferred_vars): Initialize the
	descriptor of allocatable class arrays..



git-svn-id: https://gcc.gnu.org/svn/gcc/branches/fortran-dev@240287 138bc75d-0d04-0410-961f-82ee72b054a4

3 files changed, 46 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog.fortran-dev b/gcc/fortran/ChangeLog.fortran-dev
index 84e7fb12863..9109ddfcd87 100644
--- a/gcc/fortran/ChangeLog.fortran-dev
+++ b/gcc/fortran/ChangeLog.fortran-dev
@@ -1,3 +1,11 @@
+2016-20-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-array.c (gfc_conv_expr_descriptor): Detect class object
+	with an abstract declared type. Use the type of the data field
+	and the dynamic element length from the symbol backend_decl.
+	* trans-decl.c (gfc_trans_deferred_vars): Initialize the
+	descriptor of allocatable class arrays..
+
 2016-09-10  Paul Thomas  <pault@gcc.gnu.org>
 
 	* trans-array.c (gfc_alloc_allocatable_for_assignment): Put
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a7d9331b58b..7706ba95423 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7017,6 +7017,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   int full;
   bool subref_array_target = false;
   bool assumed_size = false;
+  bool abstract_class = false;
   gfc_expr *arg, *ss_expr;
 
   if (se->want_coarray)
@@ -7340,7 +7341,19 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	    }
 
       desc = info->descriptor;
-      elem_type = gfc_typenode_for_spec(&expr->ts);
+
+      /* Classes with an abstract declared type present particular problems
+	 because they mess up the 'desc' totally and they have to be detected
+	 to provide the dynamic type elem_len.
+	 TODO extend this to all class expressions.  */
+      abstract_class = gfc_expr_attr (expr).abstract
+		       && expr->expr_type == EXPR_VARIABLE
+		       && expr->symtree->n.sym->ts.type == BT_CLASS;
+
+      if (abstract_class)
+	elem_type = gfc_typenode_for_spec(&CLASS_DATA (expr->symtree->n.sym)->ts);
+      else
+	elem_type = gfc_typenode_for_spec(&expr->ts);
 
       if (se->direct_byref && !se->byref_noassign)
 	{
@@ -7372,6 +7385,18 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       /* Set elem_len, version, rank, dtype and attribute.  */
       if (expr->ts.type == BT_CHARACTER && !is_subref_array (expr))
 	elem_len = size_of_string_in_bytes (expr->ts.kind, se->string_length);
+      else if (abstract_class)
+	{
+	  tmp = expr->symtree->n.sym->backend_decl;
+	  if (DECL_LANG_SPECIFIC (tmp) && GFC_DECL_SAVED_DESCRIPTOR (tmp))
+	    tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp);
+
+	  tmp = gfc_get_vptr_from_expr (tmp);
+	  if (tmp != NULL_TREE)
+	    elem_len = gfc_vptr_size_get (tmp);
+	  else
+	    elem_len = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
+	}
       else
         /* TODO Set this to the size of elem_type rather than the size of the
 	   descriptor elements.  */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 92bc0dc1e57..332cc725577 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4366,22 +4366,24 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	      gfc_set_backend_locus (&sym->declared_at);
 	      gfc_start_block (&init);
 
-	      if (!sym->attr.dummy && descriptor != NULL_TREE)
+	      if (!sym->attr.dummy && sym->ts.type == BT_CLASS
+		  && CLASS_DATA (sym)->as)
 		{
+		  tree cdesc = gfc_class_data_get (sym->backend_decl);
                   tree type = TREE_TYPE (CLASS_DATA (sym)->backend_decl);
-		  gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as);
-		  gfc_conv_descriptor_elem_len_set (&init, descriptor,
+		  gfc_conv_descriptor_elem_len_set (&init, cdesc,
 				  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
-		  gfc_conv_descriptor_version_set (&init, descriptor);
-		  gfc_conv_descriptor_rank_set (&init, descriptor,
+		  gfc_conv_descriptor_version_set (&init, cdesc);
+		  gfc_conv_descriptor_rank_set (&init, cdesc,
 						CLASS_DATA (sym)->as->rank);
-		  tmp = gfc_conv_descriptor_dtype (descriptor);
+		  tmp = gfc_conv_descriptor_dtype (cdesc);
 		  gfc_add_modify (&init, tmp, gfc_get_dtype (&sym->ts));
-		  gfc_conv_descriptor_attr_set (&init, descriptor,
-                                     CLASS_DATA (sym)->attr.allocatable
-                                     ? GFC_ATTRIBUTE_ALLOCATABLE
-                                     : GFC_ATTRIBUTE_POINTER);
+		  gfc_conv_descriptor_attr_set (&init, cdesc,
+						CLASS_DATA (sym)->attr.allocatable
+						? GFC_ATTRIBUTE_ALLOCATABLE
+						: GFC_ATTRIBUTE_POINTER);
 		}
+
 	      if (!sym->attr.pointer)
 		{
 		  /* Nullify and automatic deallocation of allocatable