GCC Bugzilla will be upgraded from version 4.4.9 to 5.0rc3 on Saturday, April 25, starting around 17:00 UTC. The upgrade process should only last a few minutes. Check bug 64968 for details.
Bug 36592 - F2003: Procedure pointer in COMMON
F2003: Procedure pointer in COMMON
Status: RESOLVED FIXED
Product: gcc
Classification: Unclassified
Component: fortran
4.4.0
: P3 enhancement
: ---
Assigned To: janus
:
Depends on: 32580
Blocks: 20585
  Show dependency treegraph
 
Reported: 2008-06-21 19:47 UTC by Tobias Burnus
Modified: 2008-09-30 15:22 UTC (History)
2 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2008-09-23 12:44:14


Attachments
patch (2.20 KB, patch)
2008-09-22 16:50 UTC, janus
Details | Diff

Note You need to log in before you can comment on or make changes to this bug.
Description Tobias Burnus 2008-06-21 19:47:44 UTC
Procedure pointers in COMMON are currently rejected (gfc_error), but they are valid and should thus be supported.

"5.5.2 COMMON statement"
"R558 common-block-object is variable-name [ ( explicit-shape-spec-list ) ]
                          or proc-pointer-name"

Test program (hopefully correct):

subroutine one()
 implicit none
 integer :: a,b
 procedure(real), pointer :: p
 common /com/ a,b
 if(a /= 5 .or. b /= -9) call abort()
 if(p(0.0)/= 1.0) call abort
end subroutine one

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


First patch:

--- symbol.c    (revision 136801)
+++ symbol.c    (working copy)
@@ -1114,7 +1131,7 @@ gfc_add_in_common (symbol_attribute *att
  if (check_conflict (attr, name, where) == FAILURE)
    return FAILURE;

-  if (attr->flavor == FL_VARIABLE)
+  if (attr->flavor == FL_VARIABLE || attr->proc_pointer)
    return SUCCESS;

  return gfc_add_flavor (attr, FL_VARIABLE, name, where);


Actually, there is probably the following missing as well:
" || (attr->pointer && attr->external && attr->if_source != IFSRC_IFBODY)"

But this is not enough and produces tons of ICEs.
Comment 1 janus 2008-09-22 16:50:22 UTC
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
Comment 2 Tobias Burnus 2008-09-22 20:22:46 UTC
(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.
Comment 3 janus 2008-09-23 12:44:13 UTC
(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?)
Comment 4 janus 2008-09-29 09:40:26 UTC
Updated patch: http://gcc.gnu.org/ml/fortran/2008-09/msg00447.html
Comment 5 Tobias Burnus 2008-09-30 15:20:53 UTC
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

Comment 6 Tobias Burnus 2008-09-30 15:22:39 UTC
FIXED on the trunk (4.4).