https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114024

kargl at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Priority|P3                          |P4

--- Comment #2 from kargl at gcc dot gnu.org ---
This is ugly.  Essentially, the translation of an allocate statement is
mot prepared to have a complex-part-ref as the source expression.  For this
code

program foo
   implicit none
   complex :: cmp(3)
   real, allocatable :: xx(:), yy(:), zz(:)
   cmp = (3.45,6.78)
   allocate (xx, source = cmp%re)       ! ICE
   allocate (yy, source = cmp(1:3)%re)  ! ICE
   allocate (zz, source = (cmp%re))
   print *, xx
   print *, yy
   print *, zz
end

The lines marked with ICE will cause gfortran to, well, ICE.  The
following patch cures the issues by impose a set of parentheses 
about the source expression.  There is likely a better way.

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 5247d3d39d7..6ff3f12d7ed 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6355,8 +6355,24 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
        vtab_needed = (al->expr->ts.type == BT_CLASS);

       gfc_init_se (&se, NULL);
-      /* When expr3 is a variable, i.e., a very simple expression,
-            then convert it once here.  */
+
+      /* When expr3 is a variable, i.e., a very simple expression, then
+        convert it once here.  Note, if one has source = z%re or z%im, 
+        then things can go sideways with the complex-part-ref, so wrap
+        the entity in parentheses to force evaluation of an expression.
+        That is, the else-branch of the ensuing if-else-stmt is entered.  */
+
+      if (code->expr3->ref
+         && ((code->expr3->ref->u.i == INQUIRY_RE
+              || code->expr3->ref->u.i == INQUIRY_IM)
+             || (code->expr3->ref->type == REF_ARRAY
+                 && code->expr3->ref->u.ar.type == AR_SECTION)))
+       {
+         gfc_expr *etmp = gfc_get_parentheses (code->expr3);
+         code->expr3 = gfc_copy_expr (etmp);
+         gfc_free_expr (etmp);
+       }
+
       if (code->expr3->expr_type == EXPR_VARIABLE
          || code->expr3->expr_type == EXPR_ARRAY
          || code->expr3->expr_type == EXPR_CONSTANT)

Reply via email to