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

re PR fortran/25829 ([F03] Asynchronous IO support)

Browse Source 
2010-01-08  Tobias Burnus  <burnus@net-b.de

        PR/fortran 25829
        * symbol.c (check_conflict, gfc_copy_attr): Add
        ASYNCHRONOUS support.
        (gfc_add_asynchronous): New function.
        * decl.c (match_attr_spec): Add ASYNCHRONOUS support.
        (gfc_match_asynchronous): New function.
        * dump-parse-tree.c (show_attr): Add ASYNCHRONOUS support.
        * gfortran.h (symbol_attribute): New ASYNCHRONOUS bit.
        (gfc_add_asynchronous): New Prototype.
        * module.c (ab_attribute, mio_symbol_attribute): Add
        ASYNCHRONOUS support.
        * resolve.c (was_declared): Ditto.
        * match.h (gfc_match_asynchronous): New prototype.
        * parse.c (decode_specification_statement,decode_statement):
        Add ASYNCHRONOUS support.

2010-01-08  Tobias Burnus  <burnus@net-b.de

        PR/fortran 25829
        * gfortran.dg/asynchronous_1.f90: New test.
        * gfortran.dg/asynchronous_2.f90: New test.
        * gfortran.dg/conflicts.f90: Update error message.

From-SVN: r155732
This commit is contained in:
Tobias Burnus 2010-01-08 10:23:26 +01:00 committed by Tobias Burnus
parent 4e98c66c4f
commit 1eee5628bd
13 changed files with 214 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/fortran/ChangeLog
View File

@ -1,3 +1,21 @@
2010-01-08 Tobias Burnus <burnus@net-b.de
PR/fortran 25829
* symbol.c (check_conflict, gfc_copy_attr): Add
ASYNCHRONOUS support.
(gfc_add_asynchronous): New function.
* decl.c (match_attr_spec): Add ASYNCHRONOUS support.
(gfc_match_asynchronous): New function.
* dump-parse-tree.c (show_attr): Add ASYNCHRONOUS support.
* gfortran.h (symbol_attribute): New ASYNCHRONOUS bit.
(gfc_add_asynchronous): New Prototype.
* module.c (ab_attribute, mio_symbol_attribute): Add
ASYNCHRONOUS support.
* resolve.c (was_declared): Ditto.
* match.h (gfc_match_asynchronous): New prototype.
* parse.c (decode_specification_statement,decode_statement):
Add ASYNCHRONOUS support.
2010-01-07 Tobias Burnus <burnus@net-b.de>
PR fortran/42597

89
gcc/fortran/decl.c
View File

@ -2819,7 +2819,7 @@ match_attr_spec (void)
DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE,
DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE,
DECL_IS_BIND_C, DECL_NONE,
DECL_IS_BIND_C, DECL_ASYNCHRONOUS, DECL_NONE,
GFC_DECL_END /* Sentinel */
}
decl_types;
@ -2864,9 +2864,25 @@ match_attr_spec (void)
switch (gfc_peek_ascii_char ())
{
case 'a':
if (match_string_p ("allocatable"))
d = DECL_ALLOCATABLE;
break;
gfc_next_ascii_char ();
switch (gfc_next_ascii_char ())
{
case 'l':
if (match_string_p ("locatable"))
{
/* Matched "allocatable". */
d = DECL_ALLOCATABLE;
}
break;
case 's':
if (match_string_p ("ynchronous"))
{
/* Matched "asynchronous". */
d = DECL_ASYNCHRONOUS;
}
break;
}
case 'b':
/* Try and match the bind(c). */
@ -3047,6 +3063,9 @@ match_attr_spec (void)
case DECL_ALLOCATABLE:
attr = "ALLOCATABLE";
break;
case DECL_ASYNCHRONOUS:
attr = "ASYNCHRONOUS";
break;
case DECL_DIMENSION:
attr = "DIMENSION";
break;
@ -3173,6 +3192,15 @@ match_attr_spec (void)
t = gfc_add_allocatable (&current_attr, &seen_at[d]);
break;
case DECL_ASYNCHRONOUS:
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: ASYNCHRONOUS attribute at %C")
== FAILURE)
t = FAILURE;
else
t = gfc_add_asynchronous (&current_attr, NULL, &seen_at[d]);
break;
case DECL_DIMENSION:
t = gfc_add_dimension (&current_attr, NULL, &seen_at[d]);
break;
@ -6485,6 +6513,59 @@ syntax:
}
match
gfc_match_asynchronous (void)
{
gfc_symbol *sym;
match m;
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASYNCHRONOUS 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(;;)
{
/* ASYNCHRONOUS is special because it can be added to host-associated
symbols locally. */
m = gfc_match_symbol (&sym, 1);
switch (m)
{
case MATCH_YES:
if (gfc_add_asynchronous (&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 ASYNCHRONOUS 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

@ -589,6 +589,8 @@ show_attr (symbol_attribute *attr)
if (attr->allocatable)
fputs (" ALLOCATABLE", dumpfile);
if (attr->asynchronous)
fputs (" ASYNCHRONOUS", dumpfile);
if (attr->dimension)
fputs (" DIMENSION", dumpfile);
if (attr->external)

7
gcc/fortran/gfortran.h
View File

@ -652,7 +652,7 @@ typedef struct
unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
implied_index:1, subref_array_pointer:1, proc_pointer:1;
implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1;
/* For CLASS containers, the pointer attribute is sometimes set internally
even though it was not directly specified. In this case, keep the
@ -741,8 +741,8 @@ typedef struct
/* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
unsigned ext_attr:EXT_ATTR_NUM;
/* The namespace where the VOLATILE attribute has been set. */
struct gfc_namespace *volatile_ns;
/* The namespace where the attribute has been set. */
struct gfc_namespace *volatile_ns, *asynchronous_ns;
}
symbol_attribute;
@ -2426,6 +2426,7 @@ gfc_try gfc_add_recursive (symbol_attribute *, locus *);
gfc_try gfc_add_function (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);

1
gcc/fortran/match.h
View File

@ -162,6 +162,7 @@ void gfc_set_constant_character_len (int, gfc_expr *, int);
/* Matchers for attribute declarations. */
match gfc_match_allocatable (void);
match gfc_match_asynchronous (void);
match gfc_match_dimension (void);
match gfc_match_external (void);
match gfc_match_gcc_attributes (void);

8
gcc/fortran/module.c
View File

@ -1671,13 +1671,14 @@ typedef enum
AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER
AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS
}
ab_attribute;
static const mstring attr_bits[] =
{
minit ("ALLOCATABLE", AB_ALLOCATABLE),
minit ("ASYNCHRONOUS", AB_ASYNCHRONOUS),
minit ("DIMENSION", AB_DIMENSION),
minit ("EXTERNAL", AB_EXTERNAL),
minit ("INTRINSIC", AB_INTRINSIC),
@ -1792,6 +1793,8 @@ mio_symbol_attribute (symbol_attribute *attr)
{
if (attr->allocatable)
MIO_NAME (ab_attribute) (AB_ALLOCATABLE, attr_bits);
if (attr->asynchronous)
MIO_NAME (ab_attribute) (AB_ASYNCHRONOUS, attr_bits);
if (attr->dimension)
MIO_NAME (ab_attribute) (AB_DIMENSION, attr_bits);
if (attr->external)
@ -1887,6 +1890,9 @@ mio_symbol_attribute (symbol_attribute *attr)
case AB_ALLOCATABLE:
attr->allocatable = 1;
break;
case AB_ASYNCHRONOUS:
attr->asynchronous = 1;
break;
case AB_DIMENSION:
attr->dimension = 1;
break;

3
gcc/fortran/parse.c
View File

@ -129,6 +129,8 @@ decode_specification_statement (void)
case 'a':
match ("abstract% interface", gfc_match_abstract_interface,
ST_INTERFACE);
match ("allocatable", gfc_match_asynchronous, ST_ATTR_DECL);
match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
break;
case 'b':
@ -328,6 +330,7 @@ decode_statement (void)
match ("allocate", gfc_match_allocate, ST_ALLOCATE);
match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT);
match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
break;
case 'b':

3
gcc/fortran/resolve.c
View File

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

33
gcc/fortran/symbol.c
View File

@ -369,7 +369,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
*use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
*cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
*volatile_ = "VOLATILE", *is_protected = "PROTECTED",
*is_bind_c = "BIND(C)", *procedure = "PROCEDURE";
*is_bind_c = "BIND(C)", *procedure = "PROCEDURE",
*asynchronous = "ASYNCHRONOUS";
static const char *threadprivate = "THREADPRIVATE";
const char *a1, *a2;
@ -559,6 +560,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (is_protected, external)
conf (is_protected, in_common)
conf (asynchronous, intrinsic)
conf (asynchronous, external)
conf (volatile_, intrinsic)
conf (volatile_, external)
@ -576,6 +580,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (procedure, target)
conf (procedure, value)
conf (procedure, volatile_)
conf (procedure, asynchronous)
conf (procedure, entry)
a1 = gfc_code2string (flavors, attr->flavor);
@ -598,6 +603,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (dimension);
conf2 (dummy);
conf2 (volatile_);
conf2 (asynchronous);
conf2 (pointer);
conf2 (is_protected);
conf2 (target);
@ -640,8 +646,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
if (attr->subroutine)
{
a1 = subroutine;
conf2 (target);
conf2 (allocatable);
conf2 (volatile_);
conf2 (asynchronous);
conf2 (in_namelist);
conf2 (dimension);
conf2 (function);
@ -708,6 +717,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (in_common);
conf2 (value);
conf2 (volatile_);
conf2 (asynchronous);
conf2 (threadprivate);
conf2 (value);
conf2 (is_bind_c);
@ -1099,6 +1109,25 @@ gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where)
}
gfc_try
gfc_add_asynchronous (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 ASYNCHRONOUS attribute. */
if (attr->asynchronous && attr->asynchronous_ns == gfc_current_ns)
if (gfc_notify_std (GFC_STD_LEGACY,
"Duplicate ASYNCHRONOUS attribute specified at %L",
where) == FAILURE)
return FAILURE;
attr->asynchronous = 1;
attr->asynchronous_ns = gfc_current_ns;
return check_conflict (attr, name, where);
}
gfc_try
gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
{
@ -1659,6 +1688,8 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
goto fail;
if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
goto fail;
if (src->asynchronous && gfc_add_asynchronous (dest, NULL, where) == FAILURE)
goto fail;
if (src->threadprivate
&& gfc_add_threadprivate (dest, NULL, where) == FAILURE)
goto fail;

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2010-01-08 Tobias Burnus <burnus@net-b.de
PR/fortran 25829
* gfortran.dg/asynchronous_1.f90: New test.
* gfortran.dg/asynchronous_2.f90: New test.
* gfortran.dg/conflicts.f90: Update error message.
2010-01-07 Dodji Seketeli <dodji@redhat.com>
c++/40155

42
gcc/testsuite/gfortran.dg/asynchronous_1.f90 Normal file
View File

@ -0,0 +1,42 @@
! { dg-do compile }
!
! PR/fortran 25829
!
! Check parsing and checking of ASYNCHRONOUS
!
type(t) function func0()
asynchronous :: a
integer, asynchronous:: b
allocatable :: c
volatile :: d
type t
sequence
integer :: i = 5
end type t
end function func0
integer function func()
asynchronous :: func
integer, asynchronous:: b
allocatable :: c
volatile :: func
type t
sequence
integer :: i = 5
end type t
end function func
function func2() result(res)
volatile res
asynchronous res
end function func2
subroutine sub()
asynchronous sub ! { dg-error "SUBROUTINE attribute conflicts with ASYNCHRONOUS" }
volatile sub ! { dg-error "SUBROUTINE attribute conflicts with VOLATILE" }
end subroutine sub
program main
asynchronous main ! { dg-error "PROGRAM attribute conflicts with ASYNCHRONOUS" }
volatile main ! { dg-error "PROGRAM attribute conflicts with VOLATILE" }
end program main

10
gcc/testsuite/gfortran.dg/asynchronous_2.f90 Normal file
View File

@ -0,0 +1,10 @@
! { dg-do compile }
! { dg-options "-std=f95" }
!
! PR/fortran 25829
!
! Check parsing ASYNCHRONOUS
!
function func2() result(res)
asynchronous res ! { dg-error "Fortran 2003: ASYNCHRONOUS" }
end function func2

2
gcc/testsuite/gfortran.dg/conflicts.f90
View File

@ -17,7 +17,7 @@ end function f2
subroutine f3()
implicit none
dimension f3(3) ! { dg-error "PROCEDURE attribute conflicts with DIMENSION attribute" }
dimension f3(3) ! { dg-error "SUBROUTINE attribute conflicts with DIMENSION attribute" }
end subroutine f3
subroutine f4(b)