re PR fortran/57697 ([OOP] Segfault with defined assignment for components during...

2013-09-16  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57697
        * resolve.c (generate_component_assignments): Correctly handle
        * the
        case that the LHS is not allocated.

2013-09-16  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57697
        * gfortran.dg/defined_assignment_10.f90: Comment print
        * statement.

From-SVN: r202609

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fdbe4b39c3e5fbd78d4cf79cd7acb0108f0badf7..0f73dfe5f90852ba4365621c7ce07c2cc8ecaa3e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-09-16  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/57697
+       * resolve.c (generate_component_assignments): Correctly handle the
+       case that the LHS is not allocated.
+
 2013-09-15  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/57697

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f2892e226eeb5722b411909aa5b9df5144d00c9e..fbd9a6a2472f76be9b037c4d8ff6c262e228b972 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9547,17 +9547,20 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
                                                t1, (*code)->expr1,
                                NULL, NULL, (*code)->loc);
 
-                 /* For allocatable LHS, check whether it is allocated.  */
-                 if (gfc_expr_attr((*code)->expr1).allocatable)
+                 /* For allocatable LHS, check whether it is allocated.  Note
+                    that allocatable components with defined assignment are
+                    not yet support.  See PR 57696.  */
+                 if ((*code)->expr1->symtree->n.sym->attr.allocatable)
                    {
                      gfc_code *block;
+                     gfc_expr *e =
+                       gfc_lval_expr_from_sym ((*code)->expr1->symtree->n.sym);
                      block = gfc_get_code (EXEC_IF);
                      block->block = gfc_get_code (EXEC_IF);
                      block->block->expr1
                          = gfc_build_intrinsic_call (ns,
-                                   GFC_ISYM_ASSOCIATED, "allocated",
-                                   (*code)->loc, 2,
-                                   gfc_copy_expr ((*code)->expr1), NULL);
+                                   GFC_ISYM_ALLOCATED, "allocated",
+                                   (*code)->loc, 1, e);
                      block->block->next = temp_code;
                      temp_code = block;
                    }
@@ -9570,9 +9573,11 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
              this_code->ext.actual->expr = gfc_copy_expr (t1);
              add_comp_ref (this_code->ext.actual->expr, comp1);
 
-             /* If the LHS is not allocated, we pointer-assign the LHS address
-                to the temporary - after the LHS has been allocated.  */
-             if (gfc_expr_attr((*code)->expr1).allocatable)
+             /* If the LHS variable is allocatable and wasn't allocated and
+                 the temporary is allocatable, pointer assign the address of
+                 the freshly allocated LHS to the temporary.  */
+             if ((*code)->expr1->symtree->n.sym->attr.allocatable
+                 && gfc_expr_attr ((*code)->expr1).allocatable)
                {
                  gfc_code *block;
                   gfc_expr *cond;
@@ -9583,9 +9588,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
                  cond->where = (*code)->loc;
                  cond->value.op.op = INTRINSIC_NOT;
                  cond->value.op.op1 = gfc_build_intrinsic_call (ns,
-                                         GFC_ISYM_ASSOCIATED, "allocated",
-                                         (*code)->loc, 2,
-                                         gfc_copy_expr (t1), NULL);
+                                         GFC_ISYM_ALLOCATED, "allocated",
+                                         (*code)->loc, 1, gfc_copy_expr (t1));
                  block = gfc_get_code (EXEC_IF);
                  block->block = gfc_get_code (EXEC_IF);
                  block->block->expr1 = cond;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d1469d790be94d9ca1156ac21a708313cfacde63..3240989a00c610211d45d219de012ef8d823d90c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-09-16  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/57697
+       * gfortran.dg/defined_assignment_10.f90: Comment print statement.
+
 2013-09-15  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/57697

diff --git a/gcc/testsuite/gfortran.dg/defined_assignment_10.f90 b/gcc/testsuite/gfortran.dg/defined_assignment_10.f90
index 03f92c6a47e775ed2e5b0f62317e7fcc2550d56c..4385925dcd1f45fb864edafc86aa2aaa0b5825ba 100644 (file)
--- a/gcc/testsuite/gfortran.dg/defined_assignment_10.f90
+++ b/gcc/testsuite/gfortran.dg/defined_assignment_10.f90
@@ -28,7 +28,7 @@ program main
   implicit none
   type(parent), allocatable :: left
   type(parent) :: right
-  print *, right%foo
+!  print *, right%foo
   left = right
 !  print *, left%foo
   if (left%foo%i /= 20) call abort()