Created attachment 16381 [details]
patch

The attached patch is as far as I got with this up to now. It regtests fine and makes the following modified version of the test case in comment #0 compile (I think in the original test case there was a "p" missing in the first common block):

subroutine one()
  implicit none
  integer :: a,b
  procedure(real), pointer :: p
  common /com/ a,p,b
  print *,a,b,p(0.0)
end subroutine one

program main
  implicit none
  integer :: x,y
  intrinsic cos
  procedure(real), pointer :: func1
  common /com/ x,func1,y
  x = 5
  y = -9
  func1 => cos
  call one()
end program main

Although this test case compiles without error, it gives the wrong output:
           5          -9             NaN

(In reply to comment #1)
> Created an attachment (id=16381) [edit]
> Although this test case compiles without error, it gives the wrong output:

If you had used -fdump-tree-original, you knew that you created a simple local procedure pointer, which is not in common and thus a NaN or a crash or ... makes sense. Not surprisingly the culprit is the if (proc_pointer) {one line} else { lots of lines } in trans-common.c.

How about the following patch?

$ svn revert trans-common.c
$ patch <<EOF
--- trans-types.c       (Revision 140559)
+++ trans-types.c       (Arbeitskopie)
@@ -1629,0 +1630,9 @@ gfc_sym_type (gfc_symbol * sym)
+  if (sym->attr.proc_pointer)
+    {
+      /* 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;
+    }
+
EOF

PS: You should reorder the items in COMMON as on x86-64 the pointers are 8-bytes wide, which causes a alignment/padding warning be printed.

(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?)

Updated patch: http://gcc.gnu.org/ml/fortran/2008-09/msg00447.html

Subject: Bug 36592

Author: burnus
Date: Tue Sep 30 15:19:25 2008
New Revision: 140790

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=140790
Log:
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.


Added:
    trunk/gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90
    trunk/gcc/testsuite/gfortran.dg/proc_ptr_common_2.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/symbol.c
    trunk/gcc/fortran/trans-types.c
    trunk/gcc/testsuite/ChangeLog

FIXED on the trunk (4.4).