This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, Fortran] PING: PR fortran/37746: -fbounds-check for string lengths of dummy arguments


Hi Steve,

after some time, rediffed and addressed your comments below. Running a fresh regtest now.

Ok for trunk if successful?

Daniel

Steve Kargl wrote:
On Sat, Mar 28, 2009 at 10:57:50PM +0100, Daniel Kraft wrote:
Hi,

PING for the patch below.

No regressions with a fresh test. Ok for trunk?


A couple of comments.


First, your testcases contain MODULEs.  Do you need to cleanup
any *.mod files.  That is, add

!{ dg-final { cleanup-modules "module names here" } }

where needed.

+static void
+add_argument_checking (stmtblock_t* block, gfc_symbol* sym)

Elsewhere in gfortran one finds for whitespace about * either


add_argument_checking (stmtblock_t * block, gfc_symbol * sym)

or

add_argument_checking (stmtblock_t *block, gfc_symbol *sym)

+{
+  gfc_formal_arglist* formal;

The preferred style is 'gfc_formal_arglist *formal'.


+	gfc_symbol* fsym;
+	gfc_charlen* cl;
+	const char* message;

Ditto.

-- Done: Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz To go: Hea-Kni-Mon-Pri
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.
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 145949)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -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;
 }
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 145949)
+++ 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;
 }
 
@@ -1646,7 +1647,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)
@@ -3704,6 +3706,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
@@ -3920,6 +4002,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,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" } }
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,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" } }
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,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" } }
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,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" } }
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,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" } }
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,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" } }
Index: gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90
===================================================================
--- gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_index.f90	(revision 145949)
+++ 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 145949)
+++ 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)

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]