diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 16 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90 | 40 |
4 files changed, 67 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b47f748..0616247 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 c647e92..5af00a9 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 c961525..fdfc5a6 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 0000000..c54f141 --- /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" } } |