re PR fortran/30522 (Host-/use-associated VOLATILE variable: volatile scope, redunden...

fortran/
2007-02-20  Tobias Burnus  <burnus@net-b.de>

        PR fortran/30522
        * symbol.c (gfc_add_volatile): Allow to set VOLATILE
          attribute for host-associated variables.
        * gfortran.h (symbol_attribute): Save namespace
          where VOLATILE has been set.
        * trans-decl.c (gfc_finish_var_decl): Move variable
          declaration to the top.

testsuite/
2007-02-20  Tobias Burnus  <burnus@net-b.de>

       PR fortran/30522
       * gfortran.dg/volatile10.f90: New test.

From-SVN: r122157

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aac02b9d05c4f26b300014c919a5b1da4ffe1372..13598b7a4a249956bd5ca7e7db0a4be540b1f515 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2007-02-20  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/30522
+       * symbol.c (gfc_add_volatile): Allow to set VOLATILE
+         attribute for host-associated variables.
+       * gfortran.h (symbol_attribute): Save namespace
+         where VOLATILE has been set.
+       * trans-decl.c (gfc_finish_var_decl): Move variable
+         declaration to the top.
+
 2007-02-20  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/30783

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b4beef9f0f5317aa7e4f330b2e9457e833d1a55a..52553a430050cdbe5d632d1f916df2c4918578a0 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -542,6 +542,9 @@ typedef struct
   /* The symbol is a derived type with allocatable components, possibly nested.
    */
   unsigned alloc_comp:1;
+
+  /* The namespace where the VOLATILE attribute has been set.  */
+  struct gfc_namespace *volatile_ns;
 }
 symbol_attribute;
 

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 05c7eaef7ccd7c9070e14c82485e71d735223771..8f2ab83b56a84aeda34299e145c566bbc8714cc2 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -876,24 +876,18 @@ gfc_add_value (symbol_attribute * attr, const char *name, locus * where)
 try
 gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
 {
-
   /* 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",
-                           where) 
-           == FAILURE)
-         return FAILURE;
-    }
+  if (attr->volatile_ && attr->volatile_ns == gfc_current_ns)
+    if (gfc_notify_std (GFC_STD_LEGACY, 
+                       "Duplicate VOLATILE attribute specified at %L", where)
+        == FAILURE)
+      return FAILURE;
 
   attr->volatile_ = 1;
+  attr->volatile_ns = gfc_current_ns;
   return check_conflict (attr, name, where);
 }
 

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 019fbd6bdc2b8472ef26341d9b73cba65dd1a620..862958a1a95928894f9b52cf93301fab5eec1b41 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -468,6 +468,7 @@ gfc_finish_decl (tree decl, tree init)
 static void
 gfc_finish_var_decl (tree decl, gfc_symbol * sym)
 {
+  tree new;
   /* TREE_ADDRESSABLE means the address of this variable is actually needed.
      This is the equivalent of the TARGET variables.
      We also need to set this if the variable is passed by reference in a
@@ -518,7 +519,6 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
 
   if (sym->attr.volatile_)
     {
-      tree new;
       TREE_THIS_VOLATILE (decl) = 1;
       new = build_qualified_type (TREE_TYPE (decl), TYPE_QUAL_VOLATILE);
       TREE_TYPE (decl) = new;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 18be9274f26ba545971c9f7429e2666770ed4f83..8e85108942fe811573b9e0c643e1b29d93ffd06a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-02-20  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/30522
+       * gfortran.dg/volatile10.f90: New test.
+
 2007-02-19  Thomas Koenig  <Thomas.Koenig@online.de>
 
        PR libfortran/30533

diff --git a/gcc/testsuite/gfortran.dg/volatile10.f90 b/gcc/testsuite/gfortran.dg/volatile10.f90
new file mode 100644 (file)
index 0000000..493abf7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile10.f90
@@ -0,0 +1,149 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-optimized -O3" }
+! Test setting host-/use-associated variables as VOLATILE
+! PR fortran/30522
+
+module impl
+  implicit REAL (A-Z)
+  volatile :: x
+end module impl
+
+module one
+  implicit none
+  logical :: l, lv
+  volatile :: lv
+contains
+  subroutine test1(cmp)
+    logical  :: cmp
+    volatile :: l, lv
+    if (l  .neqv. cmp) call abort()
+    if (lv .neqv. cmp) call abort()
+    l = .false.
+    lv = .false.
+    if(l .or. lv) print *, 'one_test1' ! not optimized away
+  end subroutine test1
+  subroutine test2(cmp)
+    logical  :: cmp
+    if (l  .neqv. cmp) call abort()
+    if (lv .neqv. cmp) call abort()
+    l = .false.
+    if(l)  print *, 'one_test2_1' ! optimized away
+    lv = .false.
+    if(lv) print *, 'one_test2_2' ! not optimized away
+  end subroutine test2
+end module one
+
+module two
+  use :: one
+  implicit none
+  volatile :: lv,l
+contains
+  subroutine test1t(cmp)
+    logical  :: cmp
+    volatile :: l, lv
+    if (l  .neqv. cmp) call abort()
+    if (lv .neqv. cmp) call abort()
+    l = .false.
+    if(l)  print *, 'two_test1_1' ! not optimized away
+    lv = .false.
+    if(lv) print *, 'two_test1_2' ! not optimized away
+  end subroutine test1t
+  subroutine test2t(cmp)
+    logical  :: cmp
+    if (l  .neqv. cmp) call abort()
+    if (lv .neqv. cmp) call abort()
+    l = .false.
+    if(l)  print *, 'two_test2_1' ! not optimized away
+    lv = .false.
+    if(lv) print *, 'two_test2_2' ! not optimized away
+  end subroutine test2t
+end module two
+
+program main
+  use :: two, only: test1t, test2t
+  implicit none
+  logical :: lm, lmv
+  volatile :: lmv
+  lm = .true.
+  lmv = .true.
+  call test1m(.true.)
+  lm = .true.
+  lmv = .true.
+  call test2m(.true.)
+  lm = .false.
+  lmv = .false.
+  call test1m(.false.)
+  lm = .false.
+  lmv = .false.
+  call test2m(.false.)
+contains
+  subroutine test1m(cmp)
+    use :: one
+    logical  :: cmp
+    volatile :: lm,lmv
+    if(lm  .neqv. cmp) call abort()
+    if(lmv .neqv. cmp) call abort()
+    l  = .false.
+    lv = .false.
+    call test1(.false.)
+    l  = .true.
+    lv = .true.
+    call test1(.true.)
+    lm  = .false.
+    lmv = .false.
+    if(lm .or. lmv) print *, 'main_test1_1' ! not optimized away
+    l   = .false.
+    if(l)  print *, 'main_test1_2'          ! optimized away
+    lv  = .false.
+    if(lv) print *, 'main_test1_3'          ! not optimized away
+    l  = .false.
+    lv = .false.
+    call test2(.false.)
+    l  = .true.
+    lv = .true.
+    call test2(.true.)
+  end subroutine test1m
+  subroutine test2m(cmp)
+    use :: one
+    logical  :: cmp
+    volatile :: lv
+    if(lm .neqv. cmp) call abort
+    if(lmv .neqv. cmp) call abort()
+    l  = .false.
+    lv = .false.
+    call test1(.false.)
+    l  = .true.
+    lv = .true.
+    call test1(.true.)
+    lm  = .false.
+    if(lm) print *, 'main_test2_1' ! not optimized away
+    lmv = .false.
+    if(lmv)print *, 'main_test2_2' ! not optimized away
+    l   = .false.
+    if(l)  print *, 'main_test2_3' ! optimized away
+    lv  = .false.
+    if(lv) print *, 'main_test2_4' ! not optimized away
+    l  = .false.
+    lv = .false.
+    call test2(.false.)
+    l  = .true.
+    lv = .true.
+    call test2(.true.)
+  end subroutine test2m
+end program main
+
+! { dg-final { scan-tree-dump      "one_test1"   "optimized" } }
+! TODO: dg-final { scan-tree-dump-not  "one_test2_1" "optimized" } 
+! { dg-final { scan-tree-dump      "one_test2_2" "optimized" } }
+! { dg-final { scan-tree-dump      "one_test2_2" "optimized" } }
+! { dg-final { scan-tree-dump      "two_test2_1" "optimized" } }
+! { dg-final { scan-tree-dump      "two_test2_2" "optimized" } }
+! { dg-final { scan-tree-dump      "main_test1_1" "optimized" } }
+! TODO: dg-final { scan-tree-dump-not  "main_test1_2" "optimized" } 
+! { dg-final { scan-tree-dump      "main_test1_3" "optimized" } }
+! { dg-final { scan-tree-dump      "main_test2_1" "optimized" } }
+! { dg-final { scan-tree-dump      "main_test2_2" "optimized" } }
+! TODO: dg-final { scan-tree-dump-not  "main_test2_3" "optimized" } 
+! { dg-final { scan-tree-dump      "main_test2_4" "optimized" } }
+! { dg-final { cleanup-tree-dump  "optimized" } }
+! { dg-final { cleanup-modules "one two" } }