From 18246c420fd53a12be68b4ddfcfebf1e80056435 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 23 Dec 2018 17:35:13 +0000 Subject: [PATCH] re PR fortran/77703 (ICE on assignment to pointer function) 2018-12-23 Paul Thomas PR fortran/77703 * resolve.c (get_temp_from_expr): Use the string length of constant character expressions. 2018-12-23 Paul Thomas PR fortran/77703 * gfortran.dg/ptr_func_assign_5.f08 : New test. From-SVN: r267379 --- gcc/fortran/ChangeLog | 8 ++++- gcc/fortran/resolve.c | 5 +++ gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 | 45 +++++++++++++++++++++++++ 4 files changed, 62 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d351d50..a952a8f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-12-23 Paul Thomas + + PR fortran/77703 + * resolve.c (get_temp_from_expr): Use the string length of + constant character expressions. + 2018-12-22 Steven G. Kargl PR fortran/88328 @@ -11,7 +17,7 @@ * decl.c (gfc_match_data): If a component of a derived type entity appears in data statement, check that does not have the allocatable attribute. - + 2018-12-22 Steven G. Kargl PR fortran/88169 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9ce01c7..ec8070f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10637,6 +10637,11 @@ get_temp_from_expr (gfc_expr *e, gfc_namespace *ns) gfc_get_sym_tree (name, ns, &tmp, false); gfc_add_type (tmp->n.sym, &e->ts, NULL); + if (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_CHARACTER) + tmp->n.sym->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind, + NULL, + e->value.character.length); + as = NULL; ref = NULL; aref = NULL; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 806b141..a469ec9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-12-23 Paul Thomas + + PR fortran/77703 + * gfortran.dg/ptr_func_assign_5.f08 : New test. + 2018-12-22 Steven G. Kargl PR fortran/88328 diff --git a/gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 b/gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 new file mode 100644 index 0000000..9aa19e6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 @@ -0,0 +1,45 @@ +! { dg-do run } +! +! Test the fix for PR77703, in which calls of the pointer function +! caused an ICE in 'gfc_trans_auto_character_variable'. +! +! Contributed by Gerhard Steinmetz +! +module m + implicit none + private + integer, parameter, public :: n = 2 + integer, parameter :: ell = 6 + + character(len=n*ell), target, public :: s + + public :: t +contains + function t( idx ) result( substr ) + integer, intent(in) :: idx + character(len=ell), pointer :: substr + + if ( (idx < 0).or.(idx > n) ) then + error stop + end if + substr => s((idx-1)*ell+1:idx*ell) + end function t +end module m + +program p + use m, only : s, t, n + integer :: i + + ! Define 's' + s = "123456789012" + + ! Then perform operations involving 't' + if (t(1) .ne. "123456") stop 1 + if (t(2) .ne. "789012") stop 2 + + ! Do the pointer function assignments + t(1) = "Hello " + if (s .ne. "Hello 789012") Stop 3 + t(2) = "World!" + if (s .ne. "Hello World!") Stop 4 +end program p -- 2.7.4