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.
2009-04-11 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145958
138bc75d-0d04-0410-961f-
82ee72b054a4
+2009-04-11 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.
+
2009-04-11 Janus Weil <janus@gcc.gnu.org>
PR fortran/39692
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;
}
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. */
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;
}
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)
}
+/* 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
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);
+2009-04-11 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.
+
2009-04-11 Janus Weil <janus@gcc.gnu.org>
PR fortran/39692
--- /dev/null
+! { 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\\)" }
--- /dev/null
+! { 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\\)" }
+! { dg-final { cleanup-modules "m" } }
--- /dev/null
+! { 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\\)" }
+! { dg-final { cleanup-modules "m" } }
--- /dev/null
+! { 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\\)" }
+! { dg-final { cleanup-modules "m" } }
--- /dev/null
+! { 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\\)" }
+! { dg-final { cleanup-modules "m" } }
--- /dev/null
+! { 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
+
+! { dg-final { cleanup-modules "m" } }
--- /dev/null
+! { 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\\)" }
+! { dg-final { cleanup-modules "m" } }
end
function w(str)
- character(len=8) str
+ character(len=7) str
integer w
w = index(str, "R")
end
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)
OSDN Git Service
