From 6e0d2de7cbeacd8cd5b6121fcfaecd4f59edc1da Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Fri, 16 Jan 2009 13:03:51 +0100 Subject: [PATCH] re PR fortran/38152 (procedure pointers as module variables) 2009-01-16 Janus Weil 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 PR fortran/38152 * gfortran.dg/proc_ptr_13.f90: New. From-SVN: r143430 --- gcc/fortran/ChangeLog | 8 +++++++ gcc/fortran/expr.c | 3 ++- gcc/fortran/trans-decl.c | 22 +++++++++++++---- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/proc_ptr_13.f90 | 29 +++++++++++++++++++++++ 5 files changed, 62 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_13.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d4eae5e593c..6bdcdbf214f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2009-01-16 Janus Weil + + 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 * ChangeLog-2007: Clean out svn merge droppings. diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 8a992ca9e8f..5d772626ff9 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 af6d01a00ac..200948b968a 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 0a4383f755b..ac03e178def 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-01-16 Janus Weil + + PR fortran/38152 + * gfortran.dg/proc_ptr_13.f90: New. + 2009-01-15 Jason Merrill 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 00000000000..a7f391f1b2d --- /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 + +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" } }