fortran/

2007-01-31  Tobias Burnus  <burnus@net-b.de>

       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.

testsuite/
2007-01-31  Tobias Burnus  <burnus@net-b.de>

       PR fortran/30520
       * gfortran.dg/volatile8.f90: New argument conformance test.
       * gfortran.dg/volatile9.f90: New scope test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@121379 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f8b33dd..7d6680f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2007-01-31  Tobias Burnus  <burnus@net-b.de>
+
+       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  <kazu@codesourcery.com>
 
        * simplify.c, trans-array.c: Fix comment typos.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2470722..b25bcc0 100644 (file)
--- 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 91674bf..9ce42cc 100644 (file)
--- 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 c130dee..05c7eae 100644 (file)
--- 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;
-
-  if (attr->volatile_)
+  /* 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.  */
+
+  /* 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 dccd3b9..28e5e0d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2007-01-31  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/30520
+       * gfortran.dg/volatile8.f90: New argument conformance test.
+       * gfortran.dg/volatile9.f90: New scope test.
+
 2007-01-30  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
 
        PR c++/24745

diff --git a/gcc/testsuite/gfortran.dg/volatile8.f90 b/gcc/testsuite/gfortran.dg/volatile8.f90
new file mode 100644 (file)
index 0000000..b97b851
--- /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 (file)
index 0000000..e7cba6b
--- /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" } }