Dear all,
the attached patch fixes a rejects-valid / rejects-potentially-valid code issue
for ALLOCATE of CHARACTER with type-spec, and add character length checking
with -fcheck=bounds for the case at hand. It also improves checking of
character function declarations and references slightly, using the diagnostics
of NAG as a guidance.
Some testcases popped up during regtesting, suggesting that one needs to be
careful not to generate too many false positives, so I decided to not spend
to much time on the FIXME's therein. (Character length might be expressions
in an explicit interface and the actual declaration, where we don't have a
reliable way to compare.)
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From d09473af7e25c81bad95ff6c66c89e2d184147e6 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Sun, 17 Nov 2024 23:04:58 +0100
Subject: [PATCH] Fortran: add bounds-checking for ALLOCATE of CHARACTER with
type-spec [PR53357]
Fix a rejects-(potentially)-valid code for ALLOCATE of CHARACTER with
type-spec, and implement a string-length check for -fcheck=bounds.
Implement more detailed errors or warnings when character function
declarations and references do not match.
PR fortran/53357
gcc/fortran/ChangeLog:
* dependency.cc (gfc_dep_compare_expr): Return correct result if
relationship of expressions could not be determined.
* interface.cc (gfc_check_result_characteristics): Implement error
messages if character function declations and references do not
agree, else emit warning in cases where a mismatch is suspected.
* trans-stmt.cc (gfc_trans_allocate): Implement a string length
check for -fcheck=bounds.
gcc/testsuite/ChangeLog:
* gfortran.dg/auto_char_len_4.f90: Adjust patterns.
* gfortran.dg/typebound_override_1.f90: Likewise.
* gfortran.dg/bounds_check_strlen_10.f90: New test.
---
gcc/fortran/dependency.cc | 2 +-
gcc/fortran/interface.cc | 27 ++++++++++++++++---
gcc/fortran/trans-stmt.cc | 11 ++++++++
gcc/testsuite/gfortran.dg/auto_char_len_4.f90 | 25 ++++++++++++-----
.../gfortran.dg/bounds_check_strlen_10.f90 | 21 +++++++++++++++
.../gfortran.dg/typebound_override_1.f90 | 4 +--
6 files changed, 77 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_strlen_10.f90
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index 2d3db9541bb..1fd65bbadca 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -474,7 +474,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
}
if (e1->expr_type != e2->expr_type)
- return -3;
+ return -2;
switch (e1->expr_type)
{
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 61c506bfdb5..176c7d4a8ed 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -1692,9 +1692,30 @@ gfc_check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
return false;
case -2:
- /* FIXME: Implement a warning for this case.
- snprintf (errmsg, err_len, "Possible character length mismatch "
- "in function result");*/
+ if (r1->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+ {
+ snprintf (errmsg, err_len,
+ "Function declared with a non-constant character "
+ "length referenced with a constant length");
+ return false;
+ }
+ else if (r2->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+ {
+ snprintf (errmsg, err_len,
+ "Function declared with a constant character "
+ "length referenced with a non-constant length");
+ return false;
+ }
+ /* Warn if length expression types are different, except for
+ possibly false positives where complex expressions might have
+ been used. */
+ else if ((r1->ts.u.cl->length->expr_type
+ != r2->ts.u.cl->length->expr_type)
+ && (r1->ts.u.cl->length->expr_type != EXPR_OP
+ || r2->ts.u.cl->length->expr_type != EXPR_OP))
+ gfc_warning (0, "Possible character length mismatch in "
+ "function result between %L and %L",
+ &r1->declared_at, &r2->declared_at);
break;
case 0:
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 520ab505659..a409c25b899 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6393,6 +6393,7 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
gfc_symtree *newsym = NULL;
symbol_attribute caf_attr;
gfc_actual_arglist *param_list;
+ tree ts_string_length = NULL_TREE;
if (!code->ext.alloc.list)
return NULL_TREE;
@@ -6741,6 +6742,7 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
gfc_init_se (&se_sz, NULL);
gfc_conv_expr (&se_sz, sz);
gfc_free_expr (sz);
+ ts_string_length = fold_convert (gfc_charlen_type_node, se_sz.expr);
tmp = gfc_get_char_type (code->ext.alloc.ts.kind);
tmp = TYPE_SIZE_UNIT (tmp);
tmp = fold_convert (TREE_TYPE (se_sz.expr), tmp);
@@ -6951,6 +6953,15 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
else
tmp = expr3_esize;
+ /* Create runtime check for ALLOCATE of character with type-spec. */
+ if (expr->ts.type == BT_CHARACTER && !expr->ts.deferred
+ && ts_string_length
+ && se.string_length)
+ gfc_trans_same_strlen_check ("ALLOCATE with type-spec",
+ &al->expr->where,
+ ts_string_length, se.string_length,
+ &block);
+
gfc_omp_namelist *omp_alloc_item = NULL;
if (omp_allocate)
{
diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_4.f90
index 16789fafcc7..74a50c38844 100644
--- a/gcc/testsuite/gfortran.dg/auto_char_len_4.f90
+++ b/gcc/testsuite/gfortran.dg/auto_char_len_4.f90
@@ -13,26 +13,37 @@ FUNCTION a()
END FUNCTION a
SUBROUTINE s(n)
- CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "Character length mismatch" }
- CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "Character length mismatch" }
+ CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "declared with a constant character length" }
+ CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "declared with a constant character length" }
interface
function b (m) ! This is OK
- CHARACTER(LEN=m) :: b
integer :: m
+ CHARACTER(LEN=m) :: b
end function b
+ function e (m) ! { dg-warning "Possible character length mismatch" }
+ integer :: m
+ CHARACTER(LEN=m) :: e
+ end function e
end interface
write(6,*) a()
write(6,*) b(n)
write(6,*) c()
write(6,*) d()
+ write(6,*) e(n)
contains
- function c () ! This is OK
- CHARACTER(LEN=n):: c
- c = ""
- end function c
+ function c () ! This is OK
+ CHARACTER(LEN=n):: c
+ c = ""
+ end function c
END SUBROUTINE s
FUNCTION d()
CHARACTER(len=99) :: d
d = ''
END FUNCTION d
+
+function e(k) ! { dg-warning "Possible character length mismatch" }
+ integer :: k
+ character(len=k+1-1) :: e
+ e = ''
+end function e
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_10.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_10.f90
new file mode 100644
index 00000000000..accc3faebe8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_10.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-additional-options "-fcheck=bounds -fdump-tree-optimized" }
+!
+! PR fortran/53357 - bounds-check for character type-spec in ALLOCATE
+
+program pr53357
+ implicit none
+ integer :: i, j
+ i = 3
+ j = 5
+ block
+ character(len=i), allocatable :: str1
+ character(len=j), allocatable :: str2
+ allocate (character(len=3) :: &
+ str1, & ! runtime check optimized away
+ str2 ) ! runtime check kept
+ end block
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "At line 16 of file" 1 "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_override_1.f90 b/gcc/testsuite/gfortran.dg/typebound_override_1.f90
index 7eb685615f4..393f634f157 100644
--- a/gcc/testsuite/gfortran.dg/typebound_override_1.f90
+++ b/gcc/testsuite/gfortran.dg/typebound_override_1.f90
@@ -21,9 +21,9 @@ module m
contains
procedure, nopass :: a => a2 ! { dg-error "Character length mismatch in function result" }
procedure, nopass :: b => b2 ! { dg-error "Rank mismatch in function result" }
- procedure, nopass :: c => c2 ! FIXME: dg-warning "Possible character length mismatch"
+ procedure, nopass :: c => c2 ! FIXME: dg-warning "Possible character length mismatch"
procedure, nopass :: d => d2 ! valid, check for commutativity (+,*)
- procedure, nopass :: e => e2 ! { dg-error "Character length mismatch in function result" }
+ procedure, nopass :: e => e2 ! { dg-error "declared with a constant character length" }
end type
contains
--
2.35.3
