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

re PR fortran/29601 (VOLATILE attribute and statement) 

fortran/
2006-11-06  Tobias Burnus  <burnus@net-b.de>

    PR fortran/29601
    * symbol.c (check_conflict, gfc_add_volatile): Add volatile support.
    * decl.c (match_attr_spec, gfc_match_volatile): Add volatile support.
    * gfortran.h (symbol_attribute): Add volatile_ to struct.
    * resolve.c (was_declared): Add volatile support.
    * trans-decl.c (gfc_finish_var_decl): Add volatile support.
    * match.h: Declare gfc_match_volatile.
    * parse.c (decode_statement): Recognize volatile.
    * modules.c (ab_attribute, attr_bits, mio_symbol_attribute):
      Add volatile support.
    * dump-parse-tree.c (gfc_show_attr): Add volatile support.


testsuite/
2006-11-06  Tobias Burnus  <burnus@net-b.de>

    PR fortran/29601
    * gfortran.dg/volatile.f90: Add.
    * gfortran.dg/volatile2.f90: Add.
    * gfortran.dg/volatile3.f90: Add.
    * gfortran.dg/volatile4.f90: Add.
    * gfortran.dg/volatile5.f90: Add.
    * gfortran.dg/volatile6.f90: Add.
    * gfortran.dg/volatile7.f90: Add.

From-SVN: r118545
This commit is contained in:
Tobias Burnus 2006-11-07 14:27:53 +01:00 committed by Tobias Burnus
parent c927b11c78
commit 775e6c3a7b
18 changed files with 305 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,17 @@
2006-11-07 Tobias Burnus <burnus@net-b.de>
PR fortran/29601
* symbol.c (check_conflict, gfc_add_volatile): Add volatile support.
* decl.c (match_attr_spec, gfc_match_volatile): Add volatile support.
* gfortran.h (symbol_attribute): Add volatile_ to struct.
* resolve.c (was_declared): Add volatile support.
* trans-decl.c (gfc_finish_var_decl): Add volatile support.
* match.h: Declare gfc_match_volatile.
* parse.c (decode_statement): Recognize volatile.
* modules.c (ab_attribute, attr_bits, mio_symbol_attribute):
Add volatile support.
* dump-parse-tree.c (gfc_show_attr): Add volatile support.
2006-11-06 Tobias Burnus <burnus@net-b.de>
* decl.c (match_attr_spec, gfc_match_enum): Unify gfc_notify_std

68
gcc/fortran/decl.c
View File

@ -2025,7 +2025,7 @@ match_attr_spec (void)
DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
DECL_PARAMETER, DECL_POINTER, DECL_PRIVATE, DECL_PUBLIC, DECL_SAVE,
DECL_TARGET, DECL_COLON, DECL_NONE,
DECL_TARGET, DECL_VOLATILE, DECL_COLON, DECL_NONE,
GFC_DECL_END /* Sentinel */
}
decl_types;
@ -2048,6 +2048,7 @@ match_attr_spec (void)
minit (", public", DECL_PUBLIC),
minit (", save", DECL_SAVE),
minit (", target", DECL_TARGET),
minit (", volatile", DECL_VOLATILE),
minit ("::", DECL_COLON),
minit (NULL, DECL_NONE)
};
@ -2168,6 +2169,9 @@ match_attr_spec (void)
case DECL_TARGET:
attr = "TARGET";
break;
case DECL_VOLATILE:
attr = "VOLATILE";
break;
default:
attr = NULL; /* This shouldn't happen */
}
@ -2282,6 +2286,15 @@ match_attr_spec (void)
t = gfc_add_target (&current_attr, &seen_at[d]);
break;
case DECL_VOLATILE:
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: VOLATILE attribute at %C")
== FAILURE)
t = FAILURE;
else
t = gfc_add_volatile (&current_attr, NULL, &seen_at[d]);
break;
default:
gfc_internal_error ("match_attr_spec(): Bad attribute");
}
@ -3944,6 +3957,59 @@ syntax:
}
match
gfc_match_volatile (void)
{
gfc_symbol *sym;
match m;
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: VOLATILE statement at %C")
== FAILURE)
return MATCH_ERROR;
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
{
return MATCH_ERROR;
}
if (gfc_match_eos () == MATCH_YES)
goto syntax;
for(;;)
{
m = gfc_match_symbol (&sym, 0);
switch (m)
{
case MATCH_YES:
if (gfc_add_volatile (&sym->attr, sym->name,
&gfc_current_locus) == FAILURE)
return MATCH_ERROR;
goto next_item;
case MATCH_NO:
break;
case MATCH_ERROR:
return MATCH_ERROR;
}
next_item:
if (gfc_match_eos () == MATCH_YES)
break;
if (gfc_match_char (',') != MATCH_YES)
goto syntax;
}
return MATCH_YES;
syntax:
gfc_error ("Syntax error in VOLATILE statement at %C");
return MATCH_ERROR;
}
/* Match a module procedure statement. Note that we have to modify
symbols in the parent's namespace because the current one was there
to receive symbols that are in an interface's formal argument list. */

2
gcc/fortran/dump-parse-tree.c
View File

@ -552,6 +552,8 @@ gfc_show_attr (symbol_attribute * attr)
gfc_status (" POINTER");
if (attr->save)
gfc_status (" SAVE");
if (attr->volatile_)
gfc_status (" VOLATILE");
if (attr->threadprivate)
gfc_status (" THREADPRIVATE");
if (attr->target)

3
gcc/fortran/gfortran.h
View File

@ -477,7 +477,7 @@ typedef struct
{
/* Variable attributes. */
unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
optional:1, pointer:1, save:1, target:1,
optional:1, pointer:1, save:1, target:1, volatile_:1,
dummy:1, result:1, assign:1, threadprivate:1;
unsigned data:1, /* Symbol is named in a DATA statement. */
@ -1866,6 +1866,7 @@ try gfc_add_pure (symbol_attribute *, locus *);
try gfc_add_recursive (symbol_attribute *, locus *);
try gfc_add_function (symbol_attribute *, const char *, locus *);
try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
try gfc_add_volatile (symbol_attribute *, const char *, locus *);
try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);

1
gcc/fortran/match.h
View File

@ -146,6 +146,7 @@ match gfc_match_public (gfc_statement *);
match gfc_match_save (void);
match gfc_match_modproc (void);
match gfc_match_target (void);
match gfc_match_volatile (void);
/* primary.c */
match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **);

8
gcc/fortran/module.c
View File

@ -1435,7 +1435,7 @@ typedef enum
AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON,
AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE,
AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER,
AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP
AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP, AB_VOLATILE
}
ab_attribute;
@ -1448,6 +1448,7 @@ static const mstring attr_bits[] =
minit ("OPTIONAL", AB_OPTIONAL),
minit ("POINTER", AB_POINTER),
minit ("SAVE", AB_SAVE),
minit ("VOLATILE", AB_VOLATILE),
minit ("TARGET", AB_TARGET),
minit ("THREADPRIVATE", AB_THREADPRIVATE),
minit ("DUMMY", AB_DUMMY),
@ -1518,6 +1519,8 @@ mio_symbol_attribute (symbol_attribute * attr)
MIO_NAME(ab_attribute) (AB_POINTER, attr_bits);
if (attr->save)
MIO_NAME(ab_attribute) (AB_SAVE, attr_bits);
if (attr->volatile_)
MIO_NAME(ab_attribute) (AB_VOLATILE, attr_bits);
if (attr->target)
MIO_NAME(ab_attribute) (AB_TARGET, attr_bits);
if (attr->threadprivate)
@ -1596,6 +1599,9 @@ mio_symbol_attribute (symbol_attribute * attr)
case AB_SAVE:
attr->save = 1;
break;
case AB_VOLATILE:
attr->volatile_ = 1;
break;
case AB_TARGET:
attr->target = 1;
break;

4
gcc/fortran/parse.c
View File

@ -282,6 +282,10 @@ decode_statement (void)
match ("use% ", gfc_match_use, ST_USE);
break;
case 'v':
match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
break;
case 'w':
match ("write", gfc_match_write, ST_WRITE);
break;

2
gcc/fortran/resolve.c
View File

@ -677,7 +677,7 @@ was_declared (gfc_symbol * sym)
return 1;
if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
|| a.optional || a.pointer || a.save || a.target
|| a.optional || a.pointer || a.save || a.target || a.volatile_
|| a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN)
return 1;

40
gcc/fortran/symbol.c
View File

@ -265,14 +265,15 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
{
static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
*target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
*intrinsic = "INTRINSIC", *allocatable = "ALLOCATABLE",
*elemental = "ELEMENTAL", *private = "PRIVATE", *recursive = "RECURSIVE",
*intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
*allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL",
*private = "PRIVATE", *recursive = "RECURSIVE",
*in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST",
*public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY",
*function = "FUNCTION", *subroutine = "SUBROUTINE",
*dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
*use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
*cray_pointee = "CRAY POINTEE", *data = "DATA";
*cray_pointee = "CRAY POINTEE", *data = "DATA", *volatile_ = "VOLATILE";
static const char *threadprivate = "THREADPRIVATE";
const char *a1, *a2;
@ -399,6 +400,16 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
conf (data, allocatable);
conf (data, use_assoc);
conf (volatile_, intrinsic)
conf (volatile_, external)
if (attr->volatile_ && attr->intent == INTENT_IN)
{
a1 = volatile_;
a2 = intent_in;
goto conflict;
}
a1 = gfc_code2string (flavors, attr->flavor);
if (attr->in_namelist
@ -508,6 +519,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
conf2 (dummy);
conf2 (in_common);
conf2 (save);
conf2 (volatile_);
conf2 (threadprivate);
break;
@ -812,6 +824,26 @@ gfc_add_save (symbol_attribute * attr, const char *name, locus * where)
return check_conflict (attr, name, where);
}
try
gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
{
if (check_used (attr, name, where))
return FAILURE;
if (attr->volatile_)
{
if (gfc_notify_std (GFC_STD_LEGACY,
"Duplicate VOLATILE attribute specified at %L",
where)
== FAILURE)
return FAILURE;
}
attr->volatile_ = 1;
return check_conflict (attr, name, where);
}
try
gfc_add_threadprivate (symbol_attribute * attr, const char *name, locus * where)
@ -1249,6 +1281,8 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
goto fail;
if (src->save && gfc_add_save (dest, NULL, where) == FAILURE)
goto fail;
if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
goto fail;
if (src->threadprivate && gfc_add_threadprivate (dest, NULL, where) == FAILURE)
goto fail;
if (src->target && gfc_add_target (dest, where) == FAILURE)

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

@ -513,7 +513,15 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
if ((sym->attr.save || sym->attr.data || sym->value)
&& !sym->attr.use_assoc)
TREE_STATIC (decl) = 1;
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;
}
/* Keep variables larger than max-stack-var-size off stack. */
if (!sym->ns->proc_name->attr.recursive
&& INTEGER_CST_P (DECL_SIZE_UNIT (decl))

11
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,14 @@
2006-11-07 Tobias Burnus <burnus@net-b.de>
PR fortran/29601
* gfortran.dg/volatile.f90: Add.
* gfortran.dg/volatile2.f90: Add.
* gfortran.dg/volatile3.f90: Add.
* gfortran.dg/volatile4.f90: Add.
* gfortran.dg/volatile5.f90: Add.
* gfortran.dg/volatile6.f90: Add.
* gfortran.dg/volatile7.f90: Add.
2006-11-06 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/io_constraints_2.f90: Adjust pattern

11
gcc/testsuite/gfortran.dg/volatile.f90 Normal file
View File

@ -0,0 +1,11 @@
! { dg-do run }
! Test whether volatile statements and attributes are accepted
! PR fortran/29601
program volatile_test
implicit none
real :: l,m
real, volatile :: r = 3.
volatile :: l
l = 4.0
m = 3.0
end program volatile_test

14
gcc/testsuite/gfortran.dg/volatile2.f90 Normal file
View File

@ -0,0 +1,14 @@
! { dg-do compile }
! { dg-shouldfail "VOLATILE not part of F95" }
! { dg-options "-std=f95" }
! Test whether volatile statements and attributes are rejected
! with -std=f95.
! PR fortran/29601
program volatile_test
implicit none
real, volatile :: foo ! { dg-error "VOLATILE attribute" }
real :: l
volatile :: l ! { dg-error "VOLATILE statement" }
l = 4.0
foo = 3.0 ! { dg-error "no IMPLICIT type" }
end program volatile_test

22
gcc/testsuite/gfortran.dg/volatile3.f90 Normal file
View File

@ -0,0 +1,22 @@
! { dg-do compile }
! { dg-shouldfail "Invalid use of VOLATILE" }
! Test whether volatile statements and attributes are
! properly error checked.
! PR fortran/29601
program volatile_test
implicit none
real, external, volatile :: foo ! { dg-error "VOLATILE attribute conflicts with EXTERNAL attribute" }
real, intrinsic, volatile :: sin ! { dg-error "VOLATILE attribute conflicts with INTRINSIC attribute" }
real, parameter, volatile :: r = 5.5 ! { dg-error "PARAMETER attribute conflicts with VOLATILE attribute" }
real :: l,m
real,volatile :: n
real, volatile,volatile :: r = 3. ! { dg-error "Duplicate VOLATILE attribute" }
volatile :: l,n ! { dg-error "Duplicate VOLATILE attribute" }
volatile ! { dg-error "Syntax error in VOLATILE statement" }
l = 4.0
m = 3.0
contains
subroutine foo(a) ! { dg-error "has no IMPLICIT type" } ! due to error below
integer, intent(in), volatile :: a ! { dg-error "VOLATILE attribute conflicts with INTENT\\(IN\\)" }
end subroutine
end program volatile_test

18
gcc/testsuite/gfortran.dg/volatile4.f90 Normal file
View File

@ -0,0 +1,18 @@
! { dg-do compile }
! { dg-options "-O2 -fdump-tree-optimized" }
! Tests whether volatile really works
! PR fortran/29601
logical, volatile :: t1
logical :: t2
integer :: i
t2 = .false.
t1 = .false.
do i = 1, 2
if(t1) print *, 'VolatileNotOptimizedAway'
if(t2) print *, 'NonVolatileNotOptimizedAway'
end do
end
! { dg-final { scan-tree-dump "VolatileNotOptimizedAway" "optimized" } } */
! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway" "optimized" } } */
! { dg-final { cleanup-tree-dump "optimized" } } */

43
gcc/testsuite/gfortran.dg/volatile5.f90 Normal file
View File

@ -0,0 +1,43 @@
! { dg-do compile }
! { dg-options "-O3 -fdump-tree-optimized" }
! Tests whether volatile really works with modules
! PR fortran/29601
module volmod
implicit none
integer, volatile :: a
logical :: b,c
volatile :: b
contains
subroutine sample
a = 33.
if(a /= 432) print *,'aPresent'
b = .false.
if(b) print *,'bPresent'
c = .false.
if(c) print *,'cPresent'
end subroutine sample
end module volmod
program main
use volmod
implicit none
a = 432
if(a /= 432) print *,'aStillPresent'
b = .false.
if(b) print *,'bStillPresent'
c = .false.
if(c) print *,'cStillPresent'
end program main
! { dg-final { scan-tree-dump "aPresent" "optimized" } }
! { dg-final { scan-tree-dump "bPresent" "optimized" } }
! { dg-final { scan-tree-dump "aStillPresent" "optimized" } }
! { dg-final { scan-tree-dump "bStillPresent" "optimized" } }
! { dg-final { scan-tree-dump-not "cPresent" "optimized" } }
! { dg-final { scan-tree-dump-not "cStillPresent" "optimized" } }
! { dg-final { cleanup-tree-dump "optimized" } }
! { dg-final { cleanup-modules "volmod" } }

26
gcc/testsuite/gfortran.dg/volatile6.f90 Normal file
View File

@ -0,0 +1,26 @@
! { dg-do compile }
! { dg-options "-O2 -fdump-tree-optimized" }
! Tests whether volatile really works for arrays
! PR fortran/29601
logical, allocatable, volatile :: t1(:)
logical, allocatable :: t2(:)
integer :: i
allocate(t1(1),t2(1))
t1 = .false.
t2 = .false.
do i = 1, 2
if(ubound(t1,1) /= 1) print *, 'VolatileNotOptimizedAway1'
if(ubound(t2,1) /= 1) print *, 'NonVolatileNotOptimizedAway1'
end do
t1 = .false.
if(t1(1)) print *, 'VolatileNotOptimizedAway2'
t2 = .false.
if(t2(1)) print *, 'NonVolatileNotOptimizedAway2'
end
! { dg-final { scan-tree-dump "VolatileNotOptimizedAway1" "optimized" } }
! { dg-final { scan-tree-dump "VolatileNotOptimizedAway2" "optimized" } }
! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway1" "optimized" } }
! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway2" "optimized" } }
! { dg-final { cleanup-tree-dump "optimized" } }

16
gcc/testsuite/gfortran.dg/volatile7.f90 Normal file
View File

@ -0,0 +1,16 @@
! { dg-do compile }
! { dg-options "-O2 -fdump-tree-optimized" }
! Tests whether volatile really works for pointers
! PR fortran/29601
logical, pointer, volatile :: t1
logical, pointer :: t2
integer :: i
t1 => NULL(t1)
if(associated(t1)) print *, 'VolatileNotOptimizedAway'
t2 => NULL(t2)
if(associated(t2)) print *, 'NonVolatileNotOptimizedAway'
end
! { dg-final { scan-tree-dump "VolatileNotOptimizedAway" "optimized" } }
! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway" "optimized" } }
! { dg-final { cleanup-tree-dump "optimized" } }