From b1f16cae7dda8111a41bd351be63c808d593546d Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 21 Dec 2019 16:19:42 +0000 Subject: [PATCH] re PR fortran/92753 (ICE in gfc_trans_call, at fortran/trans-stmt.c:392) MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 2019-12-21  Paul Thomas   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   PR fortran/92753 * gfortran.dg/inquiry_type_ref_5.f90 : New test. From-SVN: r279696 --- gcc/fortran/ChangeLog | 9 ++++++++ gcc/fortran/expr.c | 14 ++++++++---- gcc/testsuite/ChangeLog | 7 +++++- gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90 | 29 ++++++++++++++++++++++++ 4 files changed, 53 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7e67390..dee20f6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2019-12-21  Paul Thomas   + + 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 PR middle-end/91512 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index fc67a9d..aea4af0 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8ec9fc2..1f1dec5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-12-21  Paul Thomas   + + PR fortran/92753 + * gfortran.dg/inquiry_type_ref_5.f90 : New test. + 2019-12-21 Martin Jambor PR ipa/93015 @@ -37,7 +42,7 @@ 2019-12-20 Stam Markianos-Wright - * 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 index 0000000..b27943a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_5.f90 @@ -0,0 +1,29 @@ +! { dg-do run } +! +! Test the fix for pr92753 +! +! Contributed by Gerhardt Steinmetz +! +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 -- 2.7.4