From 00625faea4cda0dfc67ab80eb96ece62fecc7423 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Tue, 30 Sep 2008 17:19:25 +0200 Subject: re PR fortran/36592 (F2003: Procedure pointer in COMMON) 2008-09-30 Janus Weil 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 PR fortran/36592 * gfortran.dg/proc_ptr_common_1.f90: New. * gfortran.dg/proc_ptr_common_2.f90: New. From-SVN: r140790 --- gcc/fortran/ChangeLog | 10 ++++++++++ gcc/fortran/symbol.c | 13 ++++--------- gcc/fortran/trans-types.c | 10 ++++++++++ 3 files changed, 24 insertions(+), 9 deletions(-) (limited to 'gcc/fortran') 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 + + 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 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; -- cgit v1.1