[Patch,Fortran] PR 40383 false positive with -fcheck=bounds

[Tobias Burnus <burnus at net-b dot de>]

Since the fix of PR 37746, gfortran's -fbounds-check is
able to diagnose actual arguments with too short string lengths
if the dummy argument has an explicit length, e.g. passing

  call proc("abc")
to
  subroutine sub(a)
    character(len=4) :: a

The testing is done by comparing the argument:
  if (_a < 4) runtime_error
For optional arguments, there is an additional condition.

That works quite nice, but it fails for:

  subroutine sub(a,b)
    character(len=4), optional :: a, b

The reason is that the argument checking is done by saving
the tree of the hidden length as formal->ts.cl->passed_length.
However, in the example above the a->ts.cl and b->ts.cl is
exactly the same. Thus only _b is saved as
formal->ts.cl->passed_length. Consequently, there will be two
checks for _b but none for _a. That way one misses bound
violations - and if optional arguments are involved (see PR)
one also gets false positives.

Solution: One needs to copy cl. One could do this relatively
early, but to reduce the number of backend declarations
(which are bad as the types are the same), I did it quite late
in trans-decl.c. One could guard it with a check for -fcheck=bounds
as it is only used with this flag.

Bootstrapped and regtested on x86-64-linux.
OK for the trunk?

Tobias

2009-06-16  Tobias Burnus  <burnus@net-b.de>

	PR fortran/40383
	* trans-decl.c (create_function_arglist): Copy formal charlist to
	have a proper passed_length for -fcheck=bounds.

2009-06-16  Tobias Burnus  <burnus@net-b.de>

	PR fortran/40383
	* gfortran.dg/bounds_check_strlen_8.f90: New test.


Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 148504)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -1709,6 +1709,22 @@ create_function_arglist (gfc_symbol * sy
 	  gfc_finish_decl (length);
 
 	  /* Remember the passed value.  */
+          if (f->sym->ts.cl->passed_length != NULL)
+            {
+	      /* This can happen if the same type is used for multiple
+		 arguments. We need to copy cl as otherwise
+		 cl->passed_length gets overwritten.  */
+	      gfc_charlen *cl, *cl2;
+	      cl = f->sym->ts.cl;
+	      f->sym->ts.cl = gfc_get_charlen();
+	      f->sym->ts.cl->length = cl->length;
+	      f->sym->ts.cl->backend_decl = cl->backend_decl;
+	      f->sym->ts.cl->length_from_typespec = cl->length_from_typespec;
+	      f->sym->ts.cl->resolved = cl->resolved;
+	      cl2 = f->sym->ts.cl->next;
+	      f->sym->ts.cl->next = cl;
+              cl->next = cl2;
+            }
 	  f->sym->ts.cl->passed_length = length;
 
 	  /* Use the passed value for assumed length variables.  */

Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90	(Revision 0)
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+!
+! PR fortran/40383
+! Gave before a bogus out of bounds.
+! Contributed by Joost VandeVondele.
+!
+MODULE M1
+  INTEGER, PARAMETER :: default_string_length=80
+END MODULE M1
+MODULE M2
+ USE M1
+ IMPLICIT NONE
+CONTAINS
+ FUNCTION F1(a,b,c,d) RESULT(RES)
+   CHARACTER(LEN=default_string_length), OPTIONAL :: a,b,c,d
+   LOGICAL :: res
+ END FUNCTION F1
+END MODULE M2
+
+MODULE M3
+ USE M1
+ USE M2
+ IMPLICIT NONE
+CONTAINS
+ SUBROUTINE S1
+   CHARACTER(LEN=default_string_length) :: a,b
+   LOGICAL :: L1
+   INTEGER :: i
+   DO I=1,10
+      L1=F1(a,b)
+   ENDDO
+ END SUBROUTINE
+END MODULE M3
+
+USE M3
+CALL S1
+END
+
+! { dg-final { cleanup-modules "m1 m2 m3" } }