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
This commit is contained in:
parent
27d62fa48e
commit
6e0d2de7cb
|
@ -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>
|
2009-01-14 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||||
|
|
||||||
* ChangeLog-2007: Clean out svn merge droppings.
|
* ChangeLog-2007: Clean out svn merge droppings.
|
||||||
|
|
|
@ -3043,7 +3043,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE
|
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 "
|
gfc_error ("'%s' in the pointer assignment at %L cannot be an "
|
||||||
"l-value since it is a procedure",
|
"l-value since it is a procedure",
|
||||||
|
|
|
@ -1174,11 +1174,24 @@ get_proc_pointer_decl (gfc_symbol *sym)
|
||||||
&& sym->ns->proc_name->backend_decl == current_function_decl)
|
&& sym->ns->proc_name->backend_decl == current_function_decl)
|
||||||
|| sym->attr.contained)
|
|| sym->attr.contained)
|
||||||
gfc_add_decl_to_function (decl);
|
gfc_add_decl_to_function (decl);
|
||||||
else
|
else if (sym->ns->proc_name->attr.flavor != FL_MODULE)
|
||||||
gfc_add_decl_to_parent_function (decl);
|
gfc_add_decl_to_parent_function (decl);
|
||||||
|
|
||||||
sym->backend_decl = 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
|
if (!sym->attr.use_assoc
|
||||||
&& (sym->attr.save != SAVE_NONE || sym->attr.data
|
&& (sym->attr.save != SAVE_NONE || sym->attr.data
|
||||||
|| (sym->value && sym->ns->proc_name->attr.is_main_program)))
|
|| (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));
|
gfc_module_add_decl (cur_module, TYPE_STUB_DECL (decl));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Only output variables and array valued, or derived type,
|
/* Only output variables, procedure pointers and array valued,
|
||||||
parameters. */
|
or derived type, parameters. */
|
||||||
if (sym->attr.flavor != FL_VARIABLE
|
if (sym->attr.flavor != FL_VARIABLE
|
||||||
&& !(sym->attr.flavor == FL_PARAMETER
|
&& !(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;
|
return;
|
||||||
|
|
||||||
if ((sym->attr.in_common || sym->attr.in_equivalence) && sym->backend_decl)
|
if ((sym->attr.in_common || sym->attr.in_equivalence) && sym->backend_decl)
|
||||||
|
|
|
@ -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>
|
2009-01-15 Jason Merrill <jason@redhat.com>
|
||||||
|
|
||||||
PR c++/38850
|
PR c++/38850
|
||||||
|
|
|
@ -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" } }
|
Loading…
Reference in New Issue