re PR fortran/38152 (procedure pointers as module variables)

2009-01-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/38152
	* expr.c (gfc_check_pointer_assign): Allow use-associated procedure
	pointers as lvalue.
	* trans-decl.c (get_proc_pointer_decl,gfc_create_module_variable):
	Enable procedure pointers as module variables.

2009-01-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/38152
	* gfortran.dg/proc_ptr_13.f90: New.

From-SVN: r143430

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d4eae5e593c588b5a294d12afdca25c3a753beae..6bdcdbf214f1226d12893173cf16efc5add311db 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-01-16  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/38152
+       * expr.c (gfc_check_pointer_assign): Allow use-associated procedure
+       pointers as lvalue.
+       * trans-decl.c (get_proc_pointer_decl,gfc_create_module_variable):
+       Enable procedure pointers as module variables.
+
 2009-01-14  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        * ChangeLog-2007: Clean out svn merge droppings.

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 8a992ca9e8f0e75f554633805a0dced056c54e27..5d772626ff9e5691bc4644d1ede9da733270e3d0 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3043,7 +3043,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
     }
 
   if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE
-      && lvalue->symtree->n.sym->attr.use_assoc)
+      && lvalue->symtree->n.sym->attr.use_assoc
+      && !lvalue->symtree->n.sym->attr.proc_pointer)
     {
       gfc_error ("'%s' in the pointer assignment at %L cannot be an "
                 "l-value since it is a procedure",

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index af6d01a00ac73d3840ea19fb7b3300dac6ee9467..200948b968a02d95e4823a69807ab037498c9043 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1174,11 +1174,24 @@ get_proc_pointer_decl (gfc_symbol *sym)
       && sym->ns->proc_name->backend_decl == current_function_decl)
       || sym->attr.contained)
     gfc_add_decl_to_function (decl);
-  else
+  else if (sym->ns->proc_name->attr.flavor != FL_MODULE)
     gfc_add_decl_to_parent_function (decl);
 
   sym->backend_decl = decl;
 
+  /* If a variable is USE associated, it's always external.  */
+  if (sym->attr.use_assoc)
+    {
+      DECL_EXTERNAL (decl) = 1;
+      TREE_PUBLIC (decl) = 1;
+    }
+  else if (sym->module && sym->ns->proc_name->attr.flavor == FL_MODULE)
+    {
+      /* This is the declaration of a module variable.  */
+      TREE_PUBLIC (decl) = 1;
+      TREE_STATIC (decl) = 1;
+    }
+
   if (!sym->attr.use_assoc
        && (sym->attr.save != SAVE_NONE || sym->attr.data
              || (sym->value && sym->ns->proc_name->attr.is_main_program)))
@@ -3121,11 +3134,12 @@ gfc_create_module_variable (gfc_symbol * sym)
       gfc_module_add_decl (cur_module, TYPE_STUB_DECL (decl));
     }
 
-  /* Only output variables and array valued, or derived type,
-     parameters.  */
+  /* Only output variables, procedure pointers and array valued,
+     or derived type, parameters.  */
   if (sym->attr.flavor != FL_VARIABLE
        && !(sym->attr.flavor == FL_PARAMETER
-              && (sym->attr.dimension || sym->ts.type == BT_DERIVED)))
+              && (sym->attr.dimension || sym->ts.type == BT_DERIVED))
+       && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
     return;
 
   if ((sym->attr.in_common || sym->attr.in_equivalence) && sym->backend_decl)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0a4383f755bb8890916ad76e5290b2e74f419d8d..ac03e178defadc9d7fa88baa30063f909ce1e6f6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-01-16  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/38152
+       * gfortran.dg/proc_ptr_13.f90: New.
+
 2009-01-15  Jason Merrill  <jason@redhat.com>
 
        PR c++/38850

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_13.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_13.f90
new file mode 100644 (file)
index 0000000..a7f391f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_13.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR 38152: Procedure pointers as module variables.
+!
+! Contributed by Daniel Kraft <domob@gcc.gnu.org>
+
+MODULE myfortran_binding
+
+  IMPLICIT NONE
+  PROCEDURE(error_stop), POINTER :: error_handler
+
+CONTAINS
+
+  LOGICAL FUNCTION myfortran_shutdown ()
+    CALL error_handler ()
+  END FUNCTION myfortran_shutdown
+
+  SUBROUTINE error_stop ()
+  END SUBROUTINE error_stop
+
+END MODULE myfortran_binding
+
+
+use myfortran_binding
+external foo
+error_handler => foo
+end
+
+! { dg-final { cleanup-modules "myfortran_binding" } }