diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2008-09-30 17:19:25 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2008-09-30 17:19:25 +0200 |
| commit | 00625faea4cda0dfc67ab80eb96ece62fecc7423 (patch) | |
| tree | 75cd54d881deff55c9d3b96eaeece2630d5c9711 /gcc/fortran/symbol.c | |
| parent | f249018cc269d703667b34af30285b451b20391c (diff) | |
| download | gcc-00625faea4cda0dfc67ab80eb96ece62fecc7423.zip gcc-00625faea4cda0dfc67ab80eb96ece62fecc7423.tar.gz gcc-00625faea4cda0dfc67ab80eb96ece62fecc7423.tar.bz2 | |
re PR fortran/36592 (F2003: Procedure pointer in COMMON)
2008-09-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/36592
* symbol.c (check_conflict): If a symbol in a COMMON block is a
procedure, it must be a procedure pointer.
(gfc_add_in_common): Symbols in COMMON blocks may be variables or
procedure pointers.
* trans-types.c (gfc_sym_type): Make procedure pointers in
* COMMON
blocks work.
2008-09-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/36592
* gfortran.dg/proc_ptr_common_1.f90: New.
* gfortran.dg/proc_ptr_common_2.f90: New.
From-SVN: r140790
Diffstat (limited to 'gcc/fortran/symbol.c')
| -rw-r--r-- | gcc/fortran/symbol.c | 13 |
1 files changed, 4 insertions, 9 deletions
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 37f07df..42df574 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -636,10 +636,12 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (threadprivate); } + if (!attr->proc_pointer) + conf2 (in_common); + switch (attr->proc) { case PROC_ST_FUNCTION: - conf2 (in_common); conf2 (dummy); break; @@ -649,7 +651,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) case PROC_DUMMY: conf2 (result); - conf2 (in_common); conf2 (threadprivate); break; @@ -1133,13 +1134,7 @@ gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where) /* Duplicate attribute already checked for. */ attr->in_common = 1; - if (check_conflict (attr, name, where) == FAILURE) - return FAILURE; - - if (attr->flavor == FL_VARIABLE) - return SUCCESS; - - return gfc_add_flavor (attr, FL_VARIABLE, name, where); + return check_conflict (attr, name, where); } |