[Bug fortran/36592] F2003: Procedure pointer in COMMON

[janus at gcc dot gnu dot org]

------- 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