From: Thomas Koenig Date: Thu, 4 Jun 2015 18:55:29 +0000 (+0000) Subject: re PR fortran/58749 (PACK(ADJUSTL([" a"," b"]), [.TRUE.,.FALSE.]) causes an internal... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=172f0ce5ab5fa74a5695cf855c9ba7c4e98c754a;p=gcc.git re PR fortran/58749 (PACK(ADJUSTL([" a"," b"]), [.TRUE.,.FALSE.]) causes an internal compiler error) 2015-06-04 Thomas Koenig PR fortran/58749 * iresolve.c (gfc_resolve_adjustl): If string has a charlen, copy it to the function. (gfc_resolve_adjustr): Likewise. 2015-06-04 Thomas Koenig PR fortran/58749 * gfortran.dg/adjustl_1.f90: New test. From-SVN: r224137 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 33cdf8f91df..b446e90122c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2015-06-04 Thomas Koenig + + PR fortran/58749 + * iresolve.c (gfc_resolve_adjustl): If string has a charlen, + copy it to the function. + (gfc_resolve_adjustr): Likewise. + 2015-06-04 Andrew MacLeod * convert.c: Adjust includes for restructured coretypes.h. diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 735dcc766e9..b6b0fc1cc46 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -215,6 +215,9 @@ gfc_resolve_adjustl (gfc_expr *f, gfc_expr *string) { f->ts.type = BT_CHARACTER; f->ts.kind = string->ts.kind; + if (string->ts.u.cl) + f->ts.u.cl = gfc_new_charlen (gfc_current_ns, string->ts.u.cl); + f->value.function.name = gfc_get_string ("__adjustl_s%d", f->ts.kind); } @@ -224,6 +227,9 @@ gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string) { f->ts.type = BT_CHARACTER; f->ts.kind = string->ts.kind; + if (string->ts.u.cl) + f->ts.u.cl = gfc_new_charlen (gfc_current_ns, string->ts.u.cl); + f->value.function.name = gfc_get_string ("__adjustr_s%d", f->ts.kind); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a64729a648f..4b35e727f3f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-06-04 Thomas Koenig + + PR fortran/58749 + * gfortran.dg/adjustl_1.f90: New test. + 2015-06-04 Jan Hubicka * gcc.dg/lto/c-compatible-types_0.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/adjustl_1.f90 b/gcc/testsuite/gfortran.dg/adjustl_1.f90 new file mode 100644 index 00000000000..1238da8c29d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/adjustl_1.f90 @@ -0,0 +1,8 @@ +! { dg-do run } +! PR 52749 - this used to ICE. +! Original test case by Stefan Mauerberger. +PROGRAM test + character(len=10) :: u + WRITE(unit=u,fmt='(3A)') PACK(ADJUSTL([" a", " b"]), [.TRUE., .FALSE.]) + if (u .ne. 'a ') call abort +END PROGRAM test