mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-01-10 23:25:32 +08:00
re PR fortran/58749 (PACK(ADJUSTL([" a"," b"]), [.TRUE.,.FALSE.]) causes an internal compiler error)
2015-06-04 Thomas Koenig <tkoenig@netcologne.de> 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 <tkoenig@netcologne.de> PR fortran/58749 * gfortran.dg/adjustl_1.f90: New test. From-SVN: r224137
This commit is contained in:
parent
ecb9f2236c
commit
172f0ce5ab
@ -1,3 +1,10 @@
|
||||
2015-06-04 Thomas Koenig <tkoenig@netcologne.de>
|
||||
|
||||
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 <amacleod@redhat.com>
|
||||
|
||||
* convert.c: Adjust includes for restructured coretypes.h.
|
||||
|
@ -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);
|
||||
}
|
||||
|
||||
|
@ -1,3 +1,8 @@
|
||||
2015-06-04 Thomas Koenig <tkoenig@netcologne.de>
|
||||
|
||||
PR fortran/58749
|
||||
* gfortran.dg/adjustl_1.f90: New test.
|
||||
|
||||
2015-06-04 Jan Hubicka <hubicka@ucw.cz>
|
||||
|
||||
* gcc.dg/lto/c-compatible-types_0.c: New testcase.
|
||||
|
8
gcc/testsuite/gfortran.dg/adjustl_1.f90
Normal file
8
gcc/testsuite/gfortran.dg/adjustl_1.f90
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user