re PR fortran/92753 (ICE in gfc_trans_call, at fortran/trans-stmt.c:392)
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 21 Dec 2019 16:19:42 +0000 (16:19 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 21 Dec 2019 16:19:42 +0000 (16:19 +0000)
2019-12-21  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/92753
* expr.c (find_inquiry_ref): Catch INQUIRY_LEN case, where the
temporary expression has been converted to a constant and make
the new expression accordingly. Correct the error in INQUIRY_RE
and INQUIRY_IM cases. The original rather than the resolved
expression was being used as the source in mpfr_set.

2019-12-21  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/92753
* gfortran.dg/inquiry_type_ref_5.f90 : New test.

From-SVN: r279696

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90 [new file with mode: 0644]

index 7e67390a1eb9588154308377bd42817a604e1dda..dee20f6fdee4749afed8729dc035513817663eef 100644 (file)
@@ -1,3 +1,12 @@
+2019-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/92753
+       * expr.c (find_inquiry_ref): Catch INQUIRY_LEN case, where the
+       temporary expression has been converted to a constant and make
+       the new expression accordingly. Correct the error in INQUIRY_RE
+       and INQUIRY_IM cases. The original rather than the resolved
+       expression was being used as the source in mpfr_set.
+
 2019-12-20  Jakub Jelinek  <jakub@redhat.com>
 
        PR middle-end/91512
index fc67a9dd5b0e397447becdabcbaed1bf8d66b8cd..aea4af08f2d8d3b7b2508e2e699af18c8d94733d 100644 (file)
@@ -1787,11 +1787,15 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
          if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
            goto cleanup;
 
-         if (!tmp->ts.u.cl->length
-             || tmp->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+         if (tmp->ts.u.cl->length
+             && tmp->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+           *newp = gfc_copy_expr (tmp->ts.u.cl->length);
+         else if (tmp->expr_type == EXPR_CONSTANT)
+           *newp = gfc_get_int_expr (gfc_default_integer_kind,
+                                     NULL, tmp->value.character.length);
+         else
            goto cleanup;
 
-         *newp = gfc_copy_expr (tmp->ts.u.cl->length);
          break;
 
        case INQUIRY_KIND:
@@ -1814,7 +1818,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
 
          *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
          mpfr_set ((*newp)->value.real,
-                   mpc_realref (p->value.complex), GFC_RND_MODE);
+                   mpc_realref (tmp->value.complex), GFC_RND_MODE);
          break;
 
        case INQUIRY_IM:
@@ -1826,7 +1830,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
 
          *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
          mpfr_set ((*newp)->value.real,
-                   mpc_imagref (p->value.complex), GFC_RND_MODE);
+                   mpc_imagref (tmp->value.complex), GFC_RND_MODE);
          break;
        }
       tmp = gfc_copy_expr (*newp);
index 8ec9fc2e6041a07d61a4dcff1c098f6fb050d87e..1f1dec5c4804bd71304e11bcf801ea3279a04557 100644 (file)
@@ -1,3 +1,8 @@
+2019-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/92753
+       * gfortran.dg/inquiry_type_ref_5.f90 : New test.
+
 2019-12-21  Martin Jambor  <mjambor@suse.cz>
 
        PR ipa/93015
@@ -37,7 +42,7 @@
 
 2019-12-20  Stam Markianos-Wright  <stam.markianos-wright@arm.com>
 
-       * lib/target-supports.exp 
+       * lib/target-supports.exp
        (check_effective_target_arm_v8_2a_i8mm_ok_nocache): New.
        (check_effective_target_arm_v8_2a_i8mm_ok): New.
        (add_options_for_arm_v8_2a_i8mm): New.
diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90
new file mode 100644 (file)
index 0000000..b27943a
--- /dev/null
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! Test the fix for pr92753
+!
+! Contributed by Gerhardt Steinmetz  <gscfq@t-online.de>
+!
+module m
+   type t
+      character(3) :: c
+   end type
+   type u
+      complex :: z
+   end type
+   type(t), parameter :: x = t ('abc')
+   integer, parameter :: l = x%c%len           ! Used to ICE
+
+   type(u), parameter :: z = u ((42.0,-42.0))
+end
+program p
+   use m
+   call s (x%c%len)                            !   ditto
+
+   if (int (z%z%re) .ne. 42) stop 1            ! Produced wrong code and
+   if (int (z%z%re) .ne. -int (z%z%im)) stop 2 ! runtime seg fault
+contains
+   subroutine s(n)
+      if (n .ne. l) stop 3
+   end
+end