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

5 files changed, 62 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d4eae5e..6bdcdbf 100644
--- 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 8a992ca..5d77262 100644
--- 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 af6d01a..200948b 100644
--- 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 0a4383f..ac03e17 100644
--- 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
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" } }