This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR fortran/37746: -fbounds-check for string lengths of dummy arguments
- From: Daniel Kraft <d at domob dot eu>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 21 Dec 2008 19:04:25 +0100
- Subject: [Patch, Fortran] PR fortran/37746: -fbounds-check for string lengths of dummy arguments
Hi,
the attached patch implements a runtime check that the string length of
an actual argument matches the expected one for a (non-assumed length)
character dummy argument, if -fbounds-check is given. This fixes PR
37746 (the original test case, although it was meant to mean something
else by the reporter, now gives the expected error), you may also want
to look at the test cases for what this is supposed to catch.
I had to change two torture-tests because I believe they are wrong and
the new check complained about this; please verify the changes are ok,
although I'm quite sure I didn't change anything about the meaning of
the test. I'm not an expert about the code touched, so please feel free
to find any things I did miss :D
Regression-testing at the moment on GNU/Linux-x86-32. Ok for trunk if no
regressions? I'm also open to queue this one up for 4.5, but as only
behaviour with -fbounds-check active is affected, I think we can also
put this in for 4.4, as it's also a bug fix.
Yours,
Daniel
PS: Sorry for that many test cases, but I don't think it is possible to
check for multiple runtime errors with just one file; or is it?
--
Done: Arc-Bar-Cav-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri-Ran
2008-12-21 Daniel Kraft <d@domob.eu>
PR fortran/37746
* gfortran.h (struct gfc_charlen): New field `passed_length' to store
the actual passed string length for dummy arguments.
* trans-decl.c (gfc_create_string_length): Formatting fixes and added
assertion, moved a local variable into the innermost block it is needed.
(create_function_arglist): Removed TODO about the check being
implemented and initialize cl->passed_length here.
(add_argument_checking): New method.
(gfc_generate_function_code): Call the argument checking method.
2008-12-21 Daniel Kraft <d@domob.eu>
PR fortran/37746
* gfortran.dg/bounds_check_strlen_1.f90: New test.
* gfortran.dg/bounds_check_strlen_2.f90: New test.
* gfortran.dg/bounds_check_strlen_3.f90: New test.
* gfortran.dg/bounds_check_strlen_4.f90: New test.
* gfortran.dg/bounds_check_strlen_5.f90: New test.
* gfortran.dg/bounds_check_strlen_6.f90: New test.
* gfortran.dg/bounds_check_strlen_7.f90: New test.
* gfortran.fortran-torture/execute/intrinsic_index.f90: Fix wrong
expected string length that failed with -fbounds-check now.
* gfortran.fortran-torture/execute/intrinsic_trim.f90: Ditto.
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 142849)
+++ gcc/fortran/gfortran.h (working copy)
@@ -793,6 +793,7 @@ typedef struct gfc_charlen
struct gfc_charlen *next;
bool length_from_typespec; /* Length from explicit array ctor typespec? */
tree backend_decl;
+ tree passed_length; /* Length argument explicitelly passed. */
int resolved;
}
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 142849)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -877,13 +877,12 @@ gfc_build_dummy_array_decl (gfc_symbol *
static tree
gfc_create_string_length (gfc_symbol * sym)
{
- tree length;
-
gcc_assert (sym->ts.cl);
gfc_conv_const_charlen (sym->ts.cl);
-
+
if (sym->ts.cl->backend_decl == NULL_TREE)
{
+ tree length;
char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
/* Also prefix the mangled name. */
@@ -895,9 +894,11 @@ gfc_create_string_length (gfc_symbol * s
TREE_USED (length) = 1;
if (sym->ns->proc_name->tlink != NULL)
gfc_defer_symbol_init (sym);
+
sym->ts.cl->backend_decl = length;
}
+ gcc_assert (sym->ts.cl->backend_decl != NULL_TREE);
return sym->ts.cl->backend_decl;
}
@@ -1595,7 +1596,8 @@ create_function_arglist (gfc_symbol * sy
TREE_READONLY (length) = 1;
gfc_finish_decl (length);
- /* TODO: Check string lengths when -fbounds-check. */
+ /* Remember the passed value. */
+ f->sym->ts.cl->passed_length = length;
/* Use the passed value for assumed length variables. */
if (!f->sym->ts.cl->length)
@@ -3646,6 +3648,86 @@ gfc_trans_entry_master_switch (gfc_entry
}
+/* Add code to string lengths of actual arguments passed to a function against
+ the expected lengths of the dummy arguments. */
+
+static void
+add_argument_checking (stmtblock_t* block, gfc_symbol* sym)
+{
+ gfc_formal_arglist* formal;
+
+ for (formal = sym->formal; formal; formal = formal->next)
+ if (formal->sym && formal->sym->ts.type == BT_CHARACTER)
+ {
+ enum tree_code comparison;
+ tree cond;
+ tree argname;
+ gfc_symbol* fsym;
+ gfc_charlen* cl;
+ const char* message;
+
+ fsym = formal->sym;
+ cl = fsym->ts.cl;
+
+ gcc_assert (cl);
+ gcc_assert (cl->passed_length != NULL_TREE);
+ gcc_assert (cl->backend_decl != NULL_TREE);
+
+ /* For POINTER, ALLOCATABLE and assumed-shape dummy arguments, the
+ string lengths must match exactly. Otherwise, it is only required
+ that the actual string length is *at least* the expected one. */
+ if (fsym->attr.pointer || fsym->attr.allocatable
+ || (fsym->as && fsym->as->type == AS_ASSUMED_SHAPE))
+ {
+ comparison = NE_EXPR;
+ message = _("Actual string length does not match the declared one"
+ " for dummy argument '%s' (%ld/%ld)");
+ }
+ else
+ {
+ comparison = LT_EXPR;
+ message = _("Actual string length is shorter than the declared one"
+ " for dummy argument '%s' (%ld/%ld)");
+ }
+
+ /* Build the condition. For optional arguments, an actual length
+ of 0 is also acceptable if the associated string is NULL, which
+ means the argument was not passed. */
+ cond = fold_build2 (comparison, boolean_type_node,
+ cl->passed_length, cl->backend_decl);
+ if (fsym->attr.optional)
+ {
+ tree not_absent;
+ tree not_0length;
+ tree absent_failed;
+
+ not_0length = fold_build2 (NE_EXPR, boolean_type_node,
+ cl->passed_length,
+ fold_convert (gfc_charlen_type_node,
+ integer_zero_node));
+ not_absent = fold_build2 (NE_EXPR, boolean_type_node,
+ fsym->backend_decl, null_pointer_node);
+
+ absent_failed = fold_build2 (TRUTH_OR_EXPR, boolean_type_node,
+ not_0length, not_absent);
+
+ cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
+ cond, absent_failed);
+ }
+
+ /* Build the runtime check. */
+ argname = gfc_build_cstring_const (fsym->name);
+ argname = gfc_build_addr_expr (pchar_type_node, argname);
+ gfc_trans_runtime_check (true, false, cond, block, &fsym->declared_at,
+ message, argname,
+ fold_convert (long_integer_type_node,
+ cl->passed_length),
+ fold_convert (long_integer_type_node,
+ cl->backend_decl));
+ }
+}
+
+
/* Generate code for a function. */
void
@@ -3840,6 +3922,12 @@ gfc_generate_function_code (gfc_namespac
gfc_add_expr_to_block (&body, tmp);
}
+ /* If bounds-checking is enabled, generate code to check passed in actual
+ arguments against the expected dummy argument attributes (e.g. string
+ lengths). */
+ if (flag_bounds_check)
+ add_argument_checking (&body, sym);
+
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_4.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_4.f90 (revision 0)
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+
+CONTAINS
+
+ SUBROUTINE test (str)
+ IMPLICIT NONE
+ CHARACTER(len=5), ALLOCATABLE :: str(:)
+ END SUBROUTINE test
+
+ SUBROUTINE test2 (n)
+ IMPLICIT NONE
+ INTEGER :: n
+ CHARACTER(len=n), ALLOCATABLE :: str(:)
+ CALL test (str)
+ END SUBROUTINE test2
+
+END MODULE m
+
+PROGRAM main
+ USE m
+ IMPLICIT NONE
+ CALL test2 (7) ! Too long.
+END PROGRAM main
+
+! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_6.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_6.f90 (revision 0)
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+
+! PR fortran/37746
+! Ensure that too long or matching string lengths don't trigger the runtime
+! error for matching string lengths, if the dummy argument is neither
+! POINTER nor ALLOCATABLE or assumed-shape.
+! Also check that absent OPTIONAL arguments don't trigger the check.
+
+MODULE m
+CONTAINS
+
+ SUBROUTINE test (str, opt)
+ IMPLICIT NONE
+ CHARACTER(len=5) :: str
+ CHARACTER(len=5), OPTIONAL :: opt
+ END SUBROUTINE test
+
+END MODULE m
+
+PROGRAM main
+ USE m
+ IMPLICIT NONE
+ CALL test ('abcde') ! String length matches.
+ CALL test ('abcdef') ! String too long, is ok.
+END PROGRAM main
Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_1.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_1.f90 (revision 0)
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+SUBROUTINE test (str)
+ IMPLICIT NONE
+ CHARACTER(len=5) :: str
+END SUBROUTINE test
+
+PROGRAM main
+ IMPLICIT NONE
+ CALL test ('abc') ! String is too short.
+END PROGRAM main
+
+! { dg-output "shorter than the declared one for dummy argument 'str' \\(3/5\\)" }
Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_3.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_3.f90 (revision 0)
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+
+CONTAINS
+
+ SUBROUTINE test (str)
+ IMPLICIT NONE
+ CHARACTER(len=5), POINTER :: str
+ END SUBROUTINE test
+
+ SUBROUTINE test2 (n)
+ IMPLICIT NONE
+ INTEGER :: n
+ CHARACTER(len=n), POINTER :: str
+ CALL test (str)
+ END SUBROUTINE test2
+
+END MODULE m
+
+PROGRAM main
+ USE m
+ IMPLICIT NONE
+ CALL test2 (7) ! Too long.
+END PROGRAM main
+
+! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_5.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_5.f90 (revision 0)
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+
+CONTAINS
+
+ SUBROUTINE test (str)
+ IMPLICIT NONE
+ CHARACTER(len=5) :: str(:) ! Assumed shape.
+ END SUBROUTINE test
+
+ SUBROUTINE test2 (n)
+ IMPLICIT NONE
+ INTEGER :: n
+ CHARACTER(len=n) :: str(2)
+ CALL test (str)
+ END SUBROUTINE test2
+
+END MODULE m
+
+PROGRAM main
+ USE m
+ IMPLICIT NONE
+ CALL test2 (7) ! Too long.
+END PROGRAM main
+
+! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90 (revision 0)
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+CONTAINS
+
+ SUBROUTINE test (opt)
+ IMPLICIT NONE
+ CHARACTER(len=5), OPTIONAL :: opt
+ END SUBROUTINE test
+
+END MODULE m
+
+PROGRAM main
+ USE m
+ IMPLICIT NONE
+ CALL test ('') ! 0 length, but not absent argument.
+END PROGRAM main
+
+! { dg-output "shorter than the declared one for dummy argument 'opt' \\(0/5\\)" }
Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90 (revision 0)
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+
+CONTAINS
+
+ SUBROUTINE test (str, n)
+ IMPLICIT NONE
+ CHARACTER(len=n) :: str
+ INTEGER :: n
+ END SUBROUTINE test
+
+ SUBROUTINE test2 (str)
+ IMPLICIT NONE
+ CHARACTER(len=*) :: str
+ CALL test (str, 5) ! Expected length of str is 5.
+ END SUBROUTINE test2
+
+END MODULE m
+
+PROGRAM main
+ USE m
+ IMPLICIT NONE
+ CALL test2 ('abc') ! String is too short.
+END PROGRAM main
+
+! { dg-output "shorter than the declared one for dummy argument 'str' \\(3/5\\)" }
Index: gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90
===================================================================
--- gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90 (revision 142849)
+++ gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90 (working copy)
@@ -8,7 +8,7 @@ program test
end
function w(str)
- character(len=8) str
+ character(len=7) str
integer w
w = index(str, "R")
end
Index: gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trim.f90
===================================================================
--- gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trim.f90 (revision 142849)
+++ gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trim.f90 (working copy)
@@ -3,7 +3,7 @@ program intrinsic_trim
character(len=8) a
character(len=4) b,work
a='1234 '
- b=work(9,a)
+ b=work(8,a)
if (llt(b,"1234")) call abort()
a=' '
b=trim(a)