OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Tobias Burnus 2007-02-20 10:22:28 +01:00 committed by Tobias Burnus
parent 1084b6b03b
commit 77bb16aadd
6 changed files with 174 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -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

3
gcc/fortran/gfortran.h
View File

@ -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;

18
gcc/fortran/symbol.c
View File

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

2
gcc/fortran/trans-decl.c
View File

@ -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;

5
gcc/testsuite/ChangeLog
View File

@ -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

149
gcc/testsuite/gfortran.dg/volatile10.f90 Normal file
View File

@ -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" } }