[Fortran, patch] Fix missing parts of host-/use-associated VOLATILE (PR30522)
Tobias Burnus
burnus@net-b.de
Fri Feb 16 15:18:00 GMT 2007
*ping*
Tobias Burnus wrote:
> :ADDPATCH fortran:
>
> The following patch fixes the following issue with host-/use-associated
> VOLATILE:
>
> Now a proper error is given for:
>
> module A
> real :: v
> module A
>
> module B
> use :: A
> volatile :: v
> volatile :: v ! ERROR, but was accepted
> end module B
>
> While the following is now accepted:
>
> module test
> real, volatile :: A
> contains
> subroutine sub
> volatile :: A ! VALID, but was rejected
> end subroutine sub
> end module test
>
>
> I decided to fill a new PR30733 about the missed optimization:
> Currently, a variable is marked VOLATILE everywhere. It should only
> be VOLATILE in the scope where it has be marked as such.
> But I don't expect many program to profit from this optimization.
>
> Bootstapped and regression tested on x86_64-unknown-linux-gnu.
>
> Ok for the trunk? (It is not in any branch, except in fortran-experiments.)
>
> Tobias
>
>
> ------------------------------------------------------------------------
>
> testsuite/
> 2007-02-08 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-08 Tobias Burnus <burnus@net-b.de>
>
> PR fortran/30522
> * gfortran.dg/volatile10.f90: New test.
>
> Index: gcc/fortran/symbol.c
> ===================================================================
> --- gcc/fortran/symbol.c (Revision 121710)
> +++ gcc/fortran/symbol.c (Arbeitskopie)
> @@ -876,24 +876,18 @@
> 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);
> }
>
> Index: gcc/fortran/gfortran.h
> ===================================================================
> --- gcc/fortran/gfortran.h (Revision 121710)
> +++ gcc/fortran/gfortran.h (Arbeitskopie)
> @@ -542,6 +542,9 @@
> /* 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;
>
> Index: gcc/fortran/trans-decl.c
> ===================================================================
> --- gcc/fortran/trans-decl.c (Revision 121710)
> +++ gcc/fortran/trans-decl.c (Arbeitskopie)
> @@ -468,6 +468,7 @@
> 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 @@
>
> 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;
> Index: gcc/testsuite/gfortran.dg/volatile10.f90
> ===================================================================
> --- gcc/testsuite/gfortran.dg/volatile10.f90 (Revision 0)
> +++ gcc/testsuite/gfortran.dg/volatile10.f90 (Revision 0)
> @@ -0,0 +1,147 @@
> +! { dg-do run }
> +! { dg-options "-fdump-tree-optimized -O3" }
> +
> +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" } }
>
More information about the Gcc-patches
mailing list