------- Comment #3 from janus at gcc dot gnu dot org 2008-09-23 12:44 -------
(In reply to comment #2)
> How about the following patch?
Looks very good, and does what it should. Just one thing: We will also have to
check for attr.in_common, so that normal procptrs don't get messed up.
Otherwise it's fine. The complete patch then looks like this:
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 140547)
+++ gcc/fortran/symbol.c (working copy)
@@ -1133,13 +1133,7 @@ gfc_add_in_common (symbol_attribute *att
/* 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);
}
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c (revision 140547)
+++ gcc/fortran/trans-types.c (working copy)
@@ -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;
This correctly compiles and runs the following extended test case:
subroutine one()
implicit none
common /com/ p1,p2,a,b
procedure(real), pointer :: p1,p2
integer :: a,b
print *,a,b,p1(0.0),p2(0.0)
end subroutine one
program main
implicit none
integer :: x,y
intrinsic sin,cos
procedure(real), pointer :: func1
external func2
pointer func2
common /com/ func1,func2,x,y
x = 5
y = -9
func1 => cos
func2 => sin
call one()
end program main
I'm checking for regressions right now. Is there anything else we need to take
care of? (If I read the standard correctly, procptrs are forbidden in
EQUIVALENCE statements, right?)
--
janus at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
AssignedTo|unassigned at gcc dot gnu |janus at gcc dot gnu dot org
|dot org |
Status|NEW |ASSIGNED
Last reconfirmed|2008-09-22 20:22:49 |2008-09-23 12:44:14
date| |
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=36592
