From: Tobias Burnus <burnus@net-b.de>
Date: Tue, 16 Jun 2009 06:57:09 +0000 (+0200)
Subject: re PR fortran/40383 (incorrect bounds checking with optional character arguments)
X-Git-Tag: releases/gcc-4.5.0~5198
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=3ba558dba3cf0a581a1a70cf8e6de5c2d26dcf96;p=thirdparty%2Fgcc.git

re PR fortran/40383 (incorrect bounds checking with optional character arguments)

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.

From-SVN: r148517
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b47f74865e68..0616247424c5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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-12  Steven G. Kargl  <kargls@comcast.net>
 
 	* arith.c (gfc_enum_initializer): Move function ...
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c647e92a3727..5af00a91a035 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1709,6 +1709,22 @@ create_function_arglist (gfc_symbol * sym)
 	  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.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c961525e9d79..fdfc5a661704 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-06-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40383
+	* gfortran.dg/bounds_check_strlen_8.f90: New test.
+
 2009-06-15  Ian Lance Taylor  <iant@google.com>
 
 	* gcc.dg/Wjump-misses-init-1.c: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90
new file mode 100644
index 000000000000..c54f14144f83
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90
@@ -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" } }