git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/37746 (bounds check of string dummy arguments) 

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  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.

From-SVN: r145958
This commit is contained in:
Daniel Kraft 2009-04-11 18:44:37 +02:00 committed by Daniel Kraft
parent d1e49db443
commit cadb8f4246
13 changed files with 324 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
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

1
gcc/fortran/gfortran.h
View File

@ -794,6 +794,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;
}

96
gcc/fortran/trans-decl.c
View File

@ -877,13 +877,12 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
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 * sym)
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;
}
@ -1646,7 +1647,8 @@ create_function_arglist (gfc_symbol * sym)
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)
@ -3704,6 +3706,86 @@ gfc_trans_entry_master_switch (gfc_entry_list * el)
}
/* 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
@ -3920,6 +4002,12 @@ gfc_generate_function_code (gfc_namespace * ns)
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);

14
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,17 @@
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

18
gcc/testsuite/gfortran.dg/bounds_check_strlen_1.f90 Normal file
View File

@ -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\\)" }

33
gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90 Normal file
View File

@ -0,0 +1,33 @@
! { 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" } }

33
gcc/testsuite/gfortran.dg/bounds_check_strlen_3.f90 Normal file
View File

@ -0,0 +1,33 @@
! { 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" } }

33
gcc/testsuite/gfortran.dg/bounds_check_strlen_4.f90 Normal file
View File

@ -0,0 +1,33 @@
! { 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" } }

33
gcc/testsuite/gfortran.dg/bounds_check_strlen_5.f90 Normal file
View File

@ -0,0 +1,33 @@
! { 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" } }

28
gcc/testsuite/gfortran.dg/bounds_check_strlen_6.f90 Normal file
View File

@ -0,0 +1,28 @@
! { 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" } }

25
gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90 Normal file
View File

@ -0,0 +1,25 @@
! { 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" } }

2
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90
View File

@ -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

2
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trim.f90
View File

@ -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)