public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-9996] Fortran: ALLOCATE of fixed-length CHARACTER with SOURCE/MOLD [PR113793]
@ 2024-04-16 16:48 Harald Anlauf
0 siblings, 0 replies; only message in thread
From: Harald Anlauf @ 2024-04-16 16:48 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:48024a99e3c2ae522d0026eedd591390506b68ca
commit r14-9996-g48024a99e3c2ae522d0026eedd591390506b68ca
Author: Harald Anlauf <anlauf@gmx.de>
Date: Sat Apr 13 19:09:24 2024 +0200
Fortran: ALLOCATE of fixed-length CHARACTER with SOURCE/MOLD [PR113793]
F2008 requires for ALLOCATE with SOURCE= or MOLD= specifier that the kind
type parameters of allocate-object and source-expr have the same values.
Add compile-time diagnostics for different character length and a runtime
check (under -fcheck=bounds). Use length from allocate-object to prevent
heap corruption and to allow string padding or truncation on assignment.
gcc/fortran/ChangeLog:
PR fortran/113793
* resolve.cc (resolve_allocate_expr): Reject ALLOCATE with SOURCE=
or MOLD= specifier for unequal length.
* trans-stmt.cc (gfc_trans_allocate): If an allocatable character
variable has fixed length, use it and do not use the source length.
With bounds-checking enabled, add a runtime check for same length.
gcc/testsuite/ChangeLog:
PR fortran/113793
* gfortran.dg/allocate_with_source_29.f90: New test.
* gfortran.dg/allocate_with_source_30.f90: New test.
* gfortran.dg/allocate_with_source_31.f90: New test.
Diff:
---
gcc/fortran/resolve.cc | 10 +++++
gcc/fortran/trans-stmt.cc | 36 +++++++++++++--
.../gfortran.dg/allocate_with_source_29.f90 | 48 ++++++++++++++++++++
.../gfortran.dg/allocate_with_source_30.f90 | 51 ++++++++++++++++++++++
.../gfortran.dg/allocate_with_source_31.f90 | 38 ++++++++++++++++
5 files changed, 179 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 4cbf7186119..6b3e5ba4fcb 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8278,6 +8278,16 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
goto failure;
}
+ /* Check F2008:C639: "Corresponding kind type parameters of
+ allocate-object and source-expr shall have the same values." */
+ if (e->ts.type == BT_CHARACTER
+ && !e->ts.deferred
+ && e->ts.u.cl->length
+ && code->expr3->ts.type == BT_CHARACTER
+ && !gfc_check_same_strlen (e, code->expr3, "ALLOCATE with "
+ "SOURCE= or MOLD= specifier"))
+ goto failure;
+
/* Check TS18508, C702/C703. */
if (code->expr3->ts.type == BT_DERIVED
&& ((codimension && gfc_expr_attr (code->expr3).event_comp)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 7997c167bae..c34e0b4c0cd 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6829,10 +6829,26 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
in the array is needed, which is the product of the len and
esize for char arrays. For unlimited polymorphics len can be
zero, therefore take the maximum of len and one. */
+ tree lhs_len;
+
+ /* If an allocatable character variable has fixed length, use it.
+ Otherwise use source length. As different lengths are not
+ allowed by the standard, generate a runtime check. */
+ if (expr->ts.type == BT_CHARACTER && !expr->ts.deferred)
+ {
+ gfc_trans_same_strlen_check ("ALLOCATE with SOURCE= or MOLD=",
+ &code->expr3->where,
+ se.string_length, expr3_len,
+ &block);
+ lhs_len = fold_convert (TREE_TYPE (expr3_len), se.string_length);
+ }
+ else
+ lhs_len = expr3_len;
+
tmp = fold_build2_loc (input_location, MAX_EXPR,
TREE_TYPE (expr3_len),
- expr3_len, fold_convert (TREE_TYPE (expr3_len),
- integer_one_node));
+ lhs_len, fold_convert (TREE_TYPE (expr3_len),
+ integer_one_node));
tmp = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (expr3_esize), expr3_esize,
fold_convert (TREE_TYPE (expr3_esize), tmp));
@@ -6877,10 +6893,22 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
allocate.
expr3_len is set when expr3 is an unlimited polymorphic
- object or a deferred length string. */
+ object or a deferred length string.
+
+ If an allocatable character variable has fixed length, use it.
+ Otherwise use source length. As different lengths are not
+ allowed by the standard, a runtime check was inserted
+ above. */
if (expr3_len != NULL_TREE)
{
- tmp = fold_convert (TREE_TYPE (expr3_esize), expr3_len);
+ tree lhs_len;
+ if (expr->ts.type == BT_CHARACTER && !expr->ts.deferred)
+ lhs_len = fold_convert (TREE_TYPE (expr3_len),
+ se.string_length);
+ else
+ lhs_len = expr3_len;
+
+ tmp = fold_convert (TREE_TYPE (expr3_esize), lhs_len);
tmp = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (expr3_esize),
expr3_esize, tmp);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_29.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_29.f90
new file mode 100644
index 00000000000..b3d4c8ae520
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_29.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+! PR fortran/113793
+!
+! Static checks of string length for ALLOCATE with SOURCE= or MOLD=
+
+program p
+ implicit none
+ character(kind=1,len=8), allocatable :: a(:), d, b(:,:)
+ character(kind=4,len=6), allocatable :: c(:), e, f(:,:)
+ character(kind=1,len=2) :: c1 = "xx"
+ character(kind=1,len=8) :: c2 = "yy"
+ character(kind=4,len=6) :: c3 = 4_"ww"
+ character(kind=4,len=3) :: c4 = 4_"zz"
+
+ ALLOCATE (a(1),source= "a") ! { dg-error "Unequal character lengths .8/1. " }
+ ALLOCATE (a(2),mold = "bb") ! { dg-error "Unequal character lengths .8/2. " }
+ ALLOCATE (c(3),source=4_"yyy") ! { dg-error "Unequal character lengths .6/3. " }
+ ALLOCATE (c(4),mold =4_"zzzz") ! { dg-error "Unequal character lengths .6/4. " }
+ ALLOCATE (d, source= "12345") ! { dg-error "Unequal character lengths .8/5. " }
+ ALLOCATE (d, source= "12345678")
+ ALLOCATE (d, mold = "123456") ! { dg-error "Unequal character lengths .8/6. " }
+ ALLOCATE (e, source=4_"654321")
+ ALLOCATE (e, mold =4_"7654321") ! { dg-error "Unequal character lengths .6/7. " }
+ ALLOCATE (a(5),source=c1) ! { dg-error "Unequal character lengths .8/2. " }
+ ALLOCATE (a(6),mold =c1) ! { dg-error "Unequal character lengths .8/2. " }
+ ALLOCATE (c(7),source=c4) ! { dg-error "Unequal character lengths .6/3. " }
+ ALLOCATE (c(8),mold =c4) ! { dg-error "Unequal character lengths .6/3. " }
+ ALLOCATE (a,source=[c1,c1,c1]) ! { dg-error "Unequal character lengths .8/2. " }
+ ALLOCATE (a,source=[c2,c2,c2])
+ ALLOCATE (c,source=[c3,c3])
+ ALLOCATE (c,source=[c4,c4]) ! { dg-error "Unequal character lengths .6/3. " }
+ ALLOCATE (d,source=c1) ! { dg-error "Unequal character lengths .8/2. " }
+ ALLOCATE (e,source=c4) ! { dg-error "Unequal character lengths .6/3. " }
+ ALLOCATE (b,source=reshape([c1],[1,1])) ! { dg-error "Unequal character lengths .8/2. " }
+ ALLOCATE (b,source=reshape([c2],[1,1]))
+ ALLOCATE (f,source=reshape([c3],[1,1]))
+ ALLOCATE (f,source=reshape([c4],[1,1])) ! { dg-error "Unequal character lengths .6/3. " }
+contains
+ subroutine foo (s)
+ character(*), intent(in) :: s
+ character(len=8), allocatable :: f(:), g
+ ALLOCATE (f(3), source=s)
+ ALLOCATE (d, source=s)
+ ALLOCATE (f(3), mold=s)
+ ALLOCATE (d, mold=s)
+ end
+end
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_30.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_30.f90
new file mode 100644
index 00000000000..f8a71d11708
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_30.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-additional-options "-std=f2008 -fcheck=bounds -g -fdump-tree-original" }
+! { dg-output "At line 43 .*" }
+! { dg-shouldfail "Unequal character lengths .3/2. in ALLOCATE with SOURCE= or MOLD=" }
+!
+! PR fortran/113793
+!
+! Test runtime checks of string length for ALLOCATE with SOURCE= or MOLD=
+
+program p
+ implicit none
+ character(kind=1,len=2) :: c1 = "xx"
+ character(kind=1,len=8) :: c2 = "yy"
+ character(kind=4,len=6) :: c3 = 4_"ww"
+ call sub1 (len (c2), c2)
+ call sub4 (len (c3), c3)
+ call test (len (c1) + 1, c1)
+contains
+ subroutine sub1 (n, s)
+ integer, intent(in) :: n
+ character(*), intent(in) :: s
+ character(len=8), allocatable :: f(:), g
+ character(len=n), allocatable :: h(:), j
+ ALLOCATE (f(7), source=s)
+ ALLOCATE (g, source=s)
+ ALLOCATE (h(5), mold=s)
+ ALLOCATE (j, mold=s)
+ end
+ subroutine sub4 (n, s)
+ integer, intent(in) :: n
+ character(kind=4,len=*), intent(in) :: s
+ character(kind=4,len=6), allocatable :: f(:), g
+ character(kind=4,len=n), allocatable :: h(:), j
+ ALLOCATE (f(3), source=s)
+ ALLOCATE (g, source=s)
+ ALLOCATE (h(5), mold=s)
+ ALLOCATE (j, mold=s)
+ end
+ subroutine test (n, s)
+ integer, intent(in) :: n
+ character(*), intent(in) :: s
+ character(len=n), allocatable :: str
+ ALLOCATE (str, source=s)
+ end
+end
+
+! { dg-final { scan-tree-dump-times "__builtin_malloc .72.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc .24.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc .56.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc .8.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "ALLOCATE with SOURCE= or MOLD=" 9 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_31.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_31.f90
new file mode 100644
index 00000000000..50c6098126e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_31.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-additional-options "-std=gnu -fcheck=no-bounds" }
+!
+! PR fortran/113793
+!
+! Test extension for ALLOCATE with SOURCE= or MOLD= that strings
+! are truncated or padded and no memory corruption occurs
+
+program p
+ implicit none
+ call test_pad (8, "12345")
+ call test_trunc (6, "123456789")
+contains
+ subroutine test_pad (n, s)
+ integer, intent(in) :: n
+ character(*), intent(in) :: s
+ character(len=n), allocatable :: a(:), b(:,:)
+ if (len (s) >= n) stop 111
+ ALLOCATE (a(100),source=s)
+ ALLOCATE (b(5,6),source=s)
+! print *, ">", a(42), "<"
+! print *, ">", b(3,4), "<"
+ if (a(42) /= s) stop 1
+ if (b(3,4) /= s) stop 2
+ end
+ subroutine test_trunc (n, s)
+ integer, intent(in) :: n
+ character(*), intent(in) :: s
+ character(len=n), allocatable :: a(:), b(:,:)
+ if (len (s) <= n) stop 222
+ ALLOCATE (a(100),source=s)
+ ALLOCATE (b(5,6),source=s)
+! print *, ">", a(42), "<"
+! print *, ">", b(3,4), "<"
+ if (a(42) /= s(1:n)) stop 3
+ if (b(3,4) /= s(1:n)) stop 4
+ end
+end
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2024-04-16 16:48 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-04-16 16:48 [gcc r14-9996] Fortran: ALLOCATE of fixed-length CHARACTER with SOURCE/MOLD [PR113793] Harald Anlauf
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).