OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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:
Janus Weil 2009-01-16 13:03:51 +01:00
parent 27d62fa48e
commit 6e0d2de7cb
5 changed files with 62 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -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.

3
gcc/fortran/expr.c
View File

@ -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",

22
gcc/fortran/trans-decl.c
View File

@ -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)

5
gcc/testsuite/ChangeLog
View File

@ -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

29
gcc/testsuite/gfortran.dg/proc_ptr_13.f90 Normal file
View File

@ -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" } }