diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f8b33dd88f2..7d6680f7d1f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2007-01-31 Tobias Burnus + + PR fortran/30520 + * interface.c (compare_actual_formal): Check conformance between + actual and VOLATILE dummy arguments. + * symbol.c (gfc_add_volatile): Allow setting of VOLATILE + multiple times in different scopes. + * decl.c (gfc_match_volatile): Search symbol in host association. + 2007-01-31 Kazu Hirata * simplify.c, trans-array.c: Fix comment typos. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2470722b8b2..b25bcc07273 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4221,7 +4221,9 @@ gfc_match_volatile (void) for(;;) { - m = gfc_match_symbol (&sym, 0); + /* VOLATILE is special because it can be added to host-associated + symbols locally. */ + m = gfc_match_symbol (&sym, 1); switch (m) { case MATCH_YES: diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 91674bffbb2..9ce42cc3e2c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1417,6 +1417,54 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, return 0; } + /* C1232 (R1221) For an actual argument which is an array section or + an assumed-shape array, the dummy argument shall be an assumed- + shape array, if the dummy argument has the VOLATILE attribute. */ + + if (f->sym->attr.volatile_ + && a->expr->symtree->n.sym->as + && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE + && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) + { + if (where) + gfc_error ("Assumed-shape actual argument at %L is " + "incompatible with the non-assumed-shape " + "dummy argument '%s' due to VOLATILE attribute", + &a->expr->where,f->sym->name); + return 0; + } + + if (f->sym->attr.volatile_ + && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION + && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) + { + if (where) + gfc_error ("Array-section actual argument at %L is " + "incompatible with the non-assumed-shape " + "dummy argument '%s' due to VOLATILE attribute", + &a->expr->where,f->sym->name); + return 0; + } + + /* C1233 (R1221) For an actual argument which is a pointer array, the + dummy argument shall be an assumed-shape or pointer array, if the + dummy argument has the VOLATILE attribute. */ + + if (f->sym->attr.volatile_ + && a->expr->symtree->n.sym->attr.pointer + && a->expr->symtree->n.sym->as + && !(f->sym->as + && (f->sym->as->type == AS_ASSUMED_SHAPE + || f->sym->attr.pointer))) + { + if (where) + gfc_error ("Pointer-array actual argument at %L requires " + "an assumed-shape or pointer-array dummy " + "argument '%s' due to VOLATILE attribute", + &a->expr->where,f->sym->name); + return 0; + } + match: if (a == actual) na = i; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index c130dee6e71..05c7eaef7cc 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -877,10 +877,14 @@ try gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where) { - if (check_used (attr, name, where)) - return FAILURE; + /* No check_used needed as 11.2.1 of the F2003 standard allows + that the local identifier made accessible by a use statement can be + given a VOLATILE attribute. */ - if (attr->volatile_) + /* TODO: The following allows multiple VOLATILE statements for + use-associated variables and it prevents setting VOLATILE for a host- + associated variable which is already marked as VOLATILE in the host. */ + if (attr->volatile_ && !attr->use_assoc) { if (gfc_notify_std (GFC_STD_LEGACY, "Duplicate VOLATILE attribute specified at %L", diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index dccd3b9c13b..28e5e0d8c03 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-01-31 Tobias Burnus + + PR fortran/30520 + * gfortran.dg/volatile8.f90: New argument conformance test. + * gfortran.dg/volatile9.f90: New scope test. + 2007-01-30 Manuel Lopez-Ibanez PR c++/24745 diff --git a/gcc/testsuite/gfortran.dg/volatile8.f90 b/gcc/testsuite/gfortran.dg/volatile8.f90 new file mode 100644 index 00000000000..b97b8519b23 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/volatile8.f90 @@ -0,0 +1,58 @@ +! Check for compatibily of actual arguments +! with dummy arguments marked as volatile +! +! Contributed by Steven Correll. +! +! PR fortran/30520 + +! { dg-do compile } + + subroutine s8() + implicit none + interface + subroutine sub8(dummy8) + integer, volatile, dimension(3) :: dummy8 + end subroutine sub8 + subroutine sub8a(dummy8a) + integer, volatile, dimension(:) :: dummy8a + end subroutine sub8a + end interface + integer, dimension(8) :: a + call sub8 (a(1:5:2)) ! { dg-error "Array-section actual argument" } + call sub8a(a(1:5:2)) + end subroutine s8 + + subroutine s9(s9dummy) + implicit none + integer, dimension(:) :: s9dummy + interface + subroutine sub9(dummy9) + integer, volatile, dimension(3) :: dummy9 + end subroutine sub9 + subroutine sub9a(dummy9a) + integer, volatile, dimension(:) :: dummy9a + end subroutine sub9a + end interface + integer, dimension(9) :: a + call sub9 (s9dummy) ! { dg-error "Assumed-shape actual argument" } + call sub9a(s9dummy) + end subroutine s9 + + subroutine s10() + implicit none + interface + subroutine sub10(dummy10) + integer, volatile, dimension(3) :: dummy10 + end subroutine sub10 + subroutine sub10a(dummy10a) + integer, volatile, dimension(:) :: dummy10a + end subroutine sub10a + subroutine sub10b(dummy10b) + integer, volatile, dimension(:), pointer :: dummy10b + end subroutine sub10b + end interface + integer, dimension(:), pointer :: a + call sub10 (a) ! { dg-error "Pointer-array actual argument" } + call sub10a(a) + call sub10b(a) + end subroutine s10 diff --git a/gcc/testsuite/gfortran.dg/volatile9.f90 b/gcc/testsuite/gfortran.dg/volatile9.f90 new file mode 100644 index 00000000000..e7cba6b0724 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/volatile9.f90 @@ -0,0 +1,44 @@ +! Check for valid VOLATILE uses +! +! Contributed by Steven Correll. +! +! PR fortran/30520 + +! { dg-do compile } + + function f() result(fr) + integer, volatile :: fr + fr = 5 + end function f + + module mod13 + implicit none + integer :: v13 + end module mod13 + + module mod13a + use mod13 + implicit none + volatile :: v13 + real :: v14 + contains + subroutine s13() + volatile :: v13 + volatile :: v14 + end subroutine s13 + end module mod13a + + module mod13b + use mod13a + implicit none + volatile :: v13 + end module mod13b + + + subroutine s14() + use mod13a + implicit none + volatile :: v13 + end subroutine s14 + +! { dg-final { cleanup-modules "mod13 mod13a mod13b" } }