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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aac02b9..13598b7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,15 @@
 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
        * resolve.c (resolve_symbol): Add character dummy VALUE check.
 

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b4beef9..52553a4 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 05c7eae..8f2ab83 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 019fbd6..862958a 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 18be927..8e85108 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" } }