Re: [PATCH] Fortran: fix string length for array constructors with type-spec [PR85547]
Harald Anlauf <[email protected]>
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <[email protected]> |
Am 07.02.26 um 8:36 PM schrieb Harald Anlauf: > I therefore plan to split this part into a part 1 > that is the submitted one minus the trans-array.cc > part, and will continue to work on the remaining issues. Part 1 is been pushed to mainline as (r16-7400-gdf7f52b3a4ca00. See also attached. Thanks, Harald
pr85547-part1.diff
(text/x-patch, 8 KB)
From df7f52b3a4ca00b64baf31c57c506fe3afe51c9f Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Sun, 8 Feb 2026 21:00:49 +0100 Subject: [PATCH] Fortran: fix string length for array constructors with type-spec [PR85547] PR fortran/85547 gcc/fortran/ChangeLog: * decl.cc (gfc_match_volatile): Fix frontend memleak. (gfc_match_asynchronous): Likewise. * dump-parse-tree.cc (show_expr): Show type-spec for character array constructor when given. * simplify.cc (gfc_simplify_len): Simplify LEN() when type-spec is provided for character array constructor. * trans-intrinsic.cc (gfc_conv_intrinsic_len): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/string_length_5.f90: New test. --- gcc/fortran/decl.cc | 4 +- gcc/fortran/dump-parse-tree.cc | 8 ++ gcc/fortran/simplify.cc | 15 ++++ gcc/fortran/trans-intrinsic.cc | 8 ++ gcc/testsuite/gfortran.dg/string_length_5.f90 | 88 +++++++++++++++++++ 5 files changed, 121 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/string_length_5.f90 diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index e646d6b8f9a..2908007d75c 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -10405,7 +10405,7 @@ gfc_match_volatile (void) switch (m) { case MATCH_YES: - name = XCNEWVAR (char, strlen (sym->name) + 1); + name = XALLOCAVAR (char, strlen (sym->name) + 1); strcpy (name, sym->name); if (!check_function_name (name)) return MATCH_ERROR; @@ -10469,7 +10469,7 @@ gfc_match_asynchronous (void) switch (m) { case MATCH_YES: - name = XCNEWVAR (char, strlen (sym->name) + 1); + name = XALLOCAVAR (char, strlen (sym->name) + 1); strcpy (name, sym->name); if (!check_function_name (name)) return MATCH_ERROR; diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index b51414c13e2..028c946d2d9 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -545,6 +545,14 @@ show_expr (gfc_expr *p) case EXPR_ARRAY: fputs ("(/ ", dumpfile); + if (p->ts.type == BT_CHARACTER + && p->ts.u.cl + && p->ts.u.cl->length_from_typespec + && p->ts.u.cl->length) + { + show_typespec (&p->ts); + fputs (" :: ", dumpfile); + } show_constructor (p->value.constructor); fputs (" /)", dumpfile); diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index a3af457b5de..c6291d7ea1d 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -5083,6 +5083,21 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) } } } + else if (e->expr_type == EXPR_ARRAY && e->ts.type == BT_CHARACTER + && e->ts.u.cl + && e->ts.u.cl->length_from_typespec + && e->ts.u.cl->length + && e->ts.u.cl->length->ts.type == BT_INTEGER) + { + gfc_typespec ts; + gfc_clear_ts (&ts); + ts.type = BT_INTEGER; + ts.kind = k; + result = gfc_copy_expr (e->ts.u.cl->length); + gfc_convert_type_warn (result, &ts, 2, 0); + return result; + } + return NULL; } diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index ec98f967200..39ed230e874 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -7647,6 +7647,14 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr) break; case EXPR_ARRAY: + /* If there is an explicit type-spec, use it. */ + if (arg->ts.u.cl->length && arg->ts.u.cl->length_from_typespec) + { + gfc_conv_string_length (arg->ts.u.cl, arg, &se->pre); + len = arg->ts.u.cl->backend_decl; + break; + } + /* Obtain the string length from the function used by trans-array.cc(gfc_trans_array_constructor). */ len = NULL_TREE; diff --git a/gcc/testsuite/gfortran.dg/string_length_5.f90 b/gcc/testsuite/gfortran.dg/string_length_5.f90 new file mode 100644 index 00000000000..12ae5a18466 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/string_length_5.f90 @@ -0,0 +1,88 @@ +! { dg-do run } +! PR fortran/85547 - string length for array constructors with type-spec +! +! Reported by Walter Spector + +program p + implicit none + integer, parameter :: k = 16 + integer :: m = k + integer, volatile :: n = k + character(10) :: path = 'xyz/' + character(8) :: path2 = 'abc/' + character(*), parameter :: s = 'ijk/' + if (k /= len ( [ character(k) :: path ] )) stop 1 + if (k /= len ( [ character(m) :: path ] )) stop 2 + if (k /= len ( [ character(n) :: path ] )) stop 3 + if (k /= len ( [ character(k) :: path ] ,kind=2)) stop 4 + if (k /= len ( [ character(m) :: path ] ,kind=2)) stop 5 + if (k /= len ( [ character(n) :: path ] ,kind=2)) stop 6 + + if (k /= len ( [ character(k) :: ] )) stop 7 + if (k /= len ( [ character(m) :: ] )) stop 8 + if (k /= len ( [ character(n) :: ] )) stop 9 + if (k /= len ( [ character(k) :: ] ,kind=2)) stop 10 + if (k /= len ( [ character(m) :: ] ,kind=2)) stop 11 + if (k /= len ( [ character(n) :: ] ,kind=2)) stop 12 + if (k /= len ( [ character(2*n/2) :: ] )) stop 13 + if (k /= len ( [ character(2*n/2) :: ] ,kind=2)) stop 14 + if (k /= len ( [ character((m+n)/2) ::] ,kind=2)) stop 15 + if (k /= len ( [ character((m+n)/2) ::] ,kind=2)) stop 16 + if (k /= len ([[ character(k) :: ]],kind=2)) stop 17 + if (k /= len ([[ character(m) :: ]],kind=2)) stop 18 + if (k /= len ([[ character(n) :: ]],kind=2)) stop 19 + if (k /= len ([[ character((m+n)/2) ::]],kind=2)) stop 20 + + if (k /= len ( [ character(k) :: path,path2 ] ,kind=2)) stop 21 + if (k /= len ( [ character(m) :: path,path2 ] ,kind=2)) stop 22 + if (k /= len ( [ character(n) :: path,path2 ] ,kind=2)) stop 23 + if (k /= len ( [ character((m+n)/2) :: path,path2 ] ,kind=2)) stop 24 + if (k /= len ([[ character(k) :: path,path2 ]],kind=2)) stop 25 + if (k /= len ([[ character(m) :: path,path2 ]],kind=2)) stop 26 + if (k /= len ([[ character(n) :: path,path2 ]],kind=2)) stop 27 + if (k /= len ([[ character((m+n)/2) :: path,path2 ]],kind=2)) stop 28 + + call sub () +contains + subroutine sub () +! call print_string (31, [ character(k) :: ] ) +! call print_string (32, [ character(m) :: ] ) +! call print_string (33, [ character(n) :: ] ) +! call print_string (34, [ character((m+n)/2) :: ] ) +! call print_string (35, [ character(k) :: path ] ) +! call print_string (36, [ character(m) :: path ] ) +! call print_string (37, [ character(n) :: path ] ) +! call print_string (38, [ character((m+n)/2) :: path ] ) +! call print_string (39, [ character(k) :: path,path2 ] ) +! call print_string (40, [ character(m) :: path,path2 ] ) +! call print_string (41, [ character(n) :: path,path2 ] ) +! call print_string (42, [ character((m+n)/2) :: path,path2 ] ) +! +! call print_string (51,[[ character(k) :: ]]) +! call print_string (52,[[ character(m) :: ]]) +! call print_string (53,[[ character(n) :: ]]) +! call print_string (54,[[ character((m+n)/2) :: ]]) +! call print_string (55,[[ character(k) :: path ]]) +! call print_string (56,[[ character(m) :: path ]]) +! call print_string (57,[[ character(n) :: path ]]) +! call print_string (58,[[ character((m+n)/2) :: path ]]) +! call print_string (59,[[ character(k) :: path,path2 ]]) +! call print_string (60,[[ character(m) :: path,path2 ]]) +! call print_string (61,[[ character(n) :: path,path2 ]]) +! call print_string (62,[[ character((m+n)/2) :: path,path2 ]]) + +! call print_string (70, [ character(k) :: ] ) + call print_string (71, [ character(k) :: s ] ) + call print_string (72, [ character(k) :: s,s ] ) + + end subroutine sub + + subroutine print_string (i, s) + integer, intent(in) :: i + character(*), intent(in) :: s(:) + if (len(s) /= k) then + print *, i, len(s), len(s)==k, size (s), s(:) + stop i + end if + end subroutine +end program -- 2.51.0