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 | |
| 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')
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 13 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.c | 10 |
3 files changed, 24 insertions, 9 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 389f8fa..253caa2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +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-25 Jerry DeLisle <jvdelisle@gcc.gnu.org PR fortran/37498 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); } diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 8178ae3..c3d2a91 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1627,6 +1627,16 @@ gfc_sym_type (gfc_symbol * sym) tree type; int byref; + /* Procedure Pointers inside COMMON blocks. */ + if (sym->attr.proc_pointer && sym->attr.in_common) + { + /* Unset proc_pointer as gfc_get_function_type calls gfc_sym_type. */ + sym->attr.proc_pointer = 0; + type = build_pointer_type (gfc_get_function_type (sym)); + sym->attr.proc_pointer = 1; + return type; + } + if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function) return void_type_node; |