This patch is straight forward and well explained by the ChangeLogs.
The ICE comes about because the simplification of the inquiry_part_ref
expressions produced bad expressions.
Thanks to Steve for spotting the error in the INQUIRY_RE and
INQUIRY_IM parts that was so blindingly obvious that I couldn't see
it. This was not in the PR but was detected while fixing it.
Regtested on FC31/x86_64 - OK for 9- and 10- branches?
Cheers
Paul
2019-12-15 Paul Thomas <pa...@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-15 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/92753
* gfortran.dg/inquiry_type_ref_5.f90 : New test.
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c (revision 278354)
--- gcc/fortran/expr.c (working copy)
*************** find_inquiry_ref (gfc_expr *p, gfc_expr
*** 1787,1797 ****
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)
goto cleanup;
- *newp = gfc_copy_expr (tmp->ts.u.cl->length);
break;
case INQUIRY_KIND:
--- 1787,1801 ----
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)
! *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;
break;
case INQUIRY_KIND:
*************** find_inquiry_ref (gfc_expr *p, gfc_expr
*** 1814,1820 ****
*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);
break;
case INQUIRY_IM:
--- 1818,1824 ----
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
! mpc_realref (tmp->value.complex), GFC_RND_MODE);
break;
case INQUIRY_IM:
*************** find_inquiry_ref (gfc_expr *p, gfc_expr
*** 1826,1832 ****
*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);
break;
}
tmp = gfc_copy_expr (*newp);
--- 1830,1836 ----
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
! mpc_imagref (tmp->value.complex), GFC_RND_MODE);
break;
}
tmp = gfc_copy_expr (*newp);
Index: gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90 (working copy)
***************
*** 0 ****
--- 1,29 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for pr92753
+ !
+ ! Contributed by Gerhardt Steinmetz <gs...@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
