[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]> |
Dear All, when a type-spec was provided with a character array constructor, it seemed to get "lost" when passing the array constructor to a procedure, even to the LEN() intrinsic. The attached patch fixes this, enables simplification of LEN() when passed an array constructor with type-spec, and also adds the type-spec to the fortran dump. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
pr85547.diff
(text/x-patch, 9.3 KB)
From 6774eb3fd3762a663c82d5a8c0993d033e87f67d Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Mon, 5 Jan 2026 21:20:11 +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-array.cc (get_array_charlen): If there is an explicit type-spec, use it. (gfc_conv_array_parameter): Likewise. * 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-array.cc | 22 ++++- gcc/fortran/trans-intrinsic.cc | 8 ++ gcc/testsuite/gfortran.dg/string_length_5.f90 | 82 +++++++++++++++++++ 6 files changed, 135 insertions(+), 4 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 3d0410501b6..72e202f5a8a 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -10385,7 +10385,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; @@ -10449,7 +10449,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-array.cc b/gcc/fortran/trans-array.cc index 0b0d50263e9..d2ba00c37f2 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -8081,6 +8081,14 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) return; } + /* If there is an explicit type-spec, use it. */ + if (expr->ts.u.cl->length && expr->ts.u.cl->length_from_typespec) + { + if (!expr->ts.u.cl->backend_decl) + gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre); + return; + } + switch (expr->expr_type) { case EXPR_ARRAY: @@ -9211,8 +9219,18 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77, if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER) { - get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp); - expr->ts.u.cl->backend_decl = tmp; + /* If there is an explicit type-spec, use it. Otherwise obtain the + string length from the constructor. */ + if (expr->ts.u.cl->length && expr->ts.u.cl->length_from_typespec) + { + gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre); + tmp = expr->ts.u.cl->backend_decl; + } + else + { + get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp); + expr->ts.u.cl->backend_decl = tmp; + } se->string_length = tmp; } diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 722ea933249..01a662520e0 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..96a6b9189e1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/string_length_5.f90 @@ -0,0 +1,82 @@ +! { 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/' + 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 ]]) + 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