[Fortran, Patch] Fix for pr61275 - Invalid initialization expression for ALLOCATABLE component in structure constructor at (1)

[Andre Vehreschild <vehre at gmx dot de>]

Hi all,

please find attached a fix for pr61275. With the help of Tobias Burnus, who
installed the changes necessary to replace deferred_parameter with artificial
this patch now completes my latest fix on pr60357. This also means, that the
patch for pr60357 is needed for this one to work! 

Special thanks to Tobias Burnus for his help.

Bootstraps and regtests ok on x86_64-linux-gnu.

Please comment.

Regards,
	Andre
-- 
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Tel.: +49 241 9291018 * Email: vehre@gmx.de

Attachment: pr61275_1.clog
Description: Binary data

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d4bfeea..9ce9ef0 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -850,9 +850,6 @@ typedef struct
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
 
-  /* Is a parameter associated with a deferred type component.  */
-  unsigned deferred_parameter:1;
-
   /* The namespace where the attribute has been set.  */
   struct gfc_namespace *volatile_ns, *asynchronous_ns;
 }
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 6b1822d..91b35cc 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2379,7 +2379,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
 				   "structure constructor at %C", comp->name))
 		return false;
 	    }
-	  else if (!comp->attr.deferred_parameter)
+	  else if (!comp->attr.artificial)
 	    {
 	      gfc_error ("No initializer for component %qs given in the"
 			 " structure constructor at %C!", comp->name);
@@ -2461,7 +2461,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
 	{
 	  /* Components without name are not allowed after the first named
 	     component initializer!  */
-	  if (!comp || comp->attr.deferred_parameter)
+	  if (!comp || comp->attr.artificial)
 	    {
 	      if (last_name)
 		gfc_error ("Component initializer without name after component"
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8855a0e..9b23273 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12653,7 +12653,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	      strlen->ts.type = BT_INTEGER;
 	      strlen->ts.kind = gfc_charlen_int_kind;
 	      strlen->attr.access = ACCESS_PRIVATE;
-	      strlen->attr.deferred_parameter = 1;
+	      strlen->attr.artificial = 1;
 	    }
 	}
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3dd3dfc..610eec4 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1951,7 +1952,10 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
 
   se->expr = tmp;
 
-  if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer)
+  /* Allocatable deferred char arrays are to be handled by the gfc_deferred_
+     strlen () conditional below.  */
+  if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer
+      && !(c->attr.allocatable && c->ts.deferred))
     {
       tmp = c->ts.u.cl->backend_decl;
       /* Components must always be constant length.  */
@@ -6550,7 +6553,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 	  gfc_add_expr_to_block (&block, tmp);
 	}
     }
-  else if (!cm->attr.deferred_parameter)
+  else if (!cm->attr.artificial)
     {
       /* Scalar component (excluding deferred parameters).  */
       gfc_init_se (&se, NULL);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index cdc5897..52256e0 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1101,12 +1101,7 @@ gfc_typenode_for_spec (gfc_typespec * spec)
       break;
 
     case BT_CHARACTER:
-#if 0
-      if (spec->deferred)
-	basetype = gfc_get_character_type (spec->kind, NULL);
-      else
-#endif
-	basetype = gfc_get_character_type (spec->kind, spec->u.cl);
+      basetype = gfc_get_character_type (spec->kind, spec->u.cl);
       break;
 
     case BT_HOLLERITH:
@@ -2150,9 +2145,11 @@ gfc_sym_type (gfc_symbol * sym)
 
   if (sym->ts.type == BT_CHARACTER
       && ((sym->attr.function && sym->attr.is_bind_c)
	  || (sym->attr.result
 	      && sym->ns->proc_name
-	      && sym->ns->proc_name->attr.is_bind_c)))
+	      && sym->ns->proc_name->attr.is_bind_c)
+	  || (sym->ts.deferred && (!sym->ts.u.cl
+				   || !sym->ts.u.cl->backend_decl))))
     type = gfc_character1_type_node;
   else
     type = gfc_typenode_for_spec (&sym->ts);
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_14.f08 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_14.f08
new file mode 100644
index 0000000..194dff9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_14.f08
@@ -0,0 +1,46 @@
+! { dg-do run }
+! Test for allocatable scalar components and deferred length char arrays.
+! Check that fix for pr61275 works.
+! Contributed by Antony Lewis <antony@cosmologist.info> and
+!                Andre Vehreschild <vehre@gmx.de>
+!
+module typeA
+    Type A
+        integer :: X
+        integer, allocatable :: y
+        character(len=:), allocatable :: c
+    end type A
+end module
+
+program test_allocatable_components
+    use typeA
+    Type(A) :: Me
+    Type(A) :: Ea
+
+    Me= A(X= 1, Y= 2, C="correctly allocated")
+
+    if (Me%X /= 1) call abort()
+    if (.not. allocated(Me%y) .or. Me%y /= 2) call abort()
+    if (.not. allocated(Me%c)) call abort()
+    if (len(Me%c) /= 19) call abort()
+    if (Me%c /= "correctly allocated") call abort()
+
+    ! Now check explicitly allocated components.
+    Ea%X = 9
+    allocate(Ea%y)
+    Ea%y = 42
+    ! Implicit allocate on assign in the next line
+    Ea%c = "13 characters"
+
+    if (Ea%X /= 9) call abort()
+    if (.not. allocated(Ea%y) .or. Ea%y /= 42) call abort()
+    if (.not. allocated(Ea%c)) call abort()
+    if (len(Ea%c) /= 13) call abort()
+    if (Ea%c /= "13 characters") call abort()
+
+    deallocate(Ea%y)
+    deallocate(Ea%c)
+    if (allocated(Ea%y)) call abort()
+    if (allocated(Ea%c)) call abort()
+end program
+