From 6be7c32c59b3316dd4a5dd78913a24c5d18a44c9 Mon Sep 17 00:00:00 2001 From: burnus Date: Tue, 16 Jun 2009 06:57:09 +0000 Subject: [PATCH] 2009-06-16 Tobias Burnus 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 PR fortran/40383 * gfortran.dg/bounds_check_strlen_8.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148517 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/trans-decl.c | 16 +++++++++ gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/bounds_check_strlen_8.f90 | 40 ++++++++++++++++++++++ 4 files changed, 67 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b47f74865e6..0616247424c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-06-16 Tobias Burnus + + 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 * arith.c (gfc_enum_initializer): Move function ... diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index c647e92a372..5af00a91a03 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 c961525e9d7..fdfc5a66170 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-06-16 Tobias Burnus + + PR fortran/40383 + * gfortran.dg/bounds_check_strlen_8.f90: New test. + 2009-06-15 Ian Lance Taylor * 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 00000000000..c54f14144f8 --- /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" } } -- 2.11.0