re PR fortran/30522 (Host-/use-associated VOLATILE variable: volatile scope, redundent attributes)

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

gcc/fortran/ChangeLog

 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.
 

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;
 

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);
 }
 

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;

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/volatile10.f90

+! { 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" } }