This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR 40176: Fortran 2003: Procedure pointers with array return value
- From: Janus Weil <janus at gcc dot gnu dot org>
- To: gfortran <fortran at gcc dot gnu dot org>, gcc patches <gcc-patches at gcc dot gnu dot org>, Barron Bichon <barron dot bichon at swri dot org>
- Date: Thu, 21 May 2009 13:56:22 +0200
- Subject: [Patch, Fortran] PR 40176: Fortran 2003: Procedure pointers with array return value
Hi all,
this patch fixes some problems related to procedure pointers with
array return value, and a small one related to procedure pointer
assignments with dummy arguments. Note that there are still some
remaining issues regarding PPCs with array return values (i.e.
actually calling them does not work yet). This is a bit more
complicated to fix, since it requires interface re-mapping etc, and I
will take care of it later. First I want to get these problems with
'ordinary' procedure pointers out of the way.
Reg-tested on x86_64-unknown-linux-gnu. Ok for trunk?
Cheers,
Janus
2009-05-21 Janus Weil <janus@gcc.gnu.org>
PR fortran/40176
* resolve.c (resolve_fl_derived): Make sure the interface of a
procedure pointer component has been resolved.
(resolve_symbol): Make sure the interface of a procedure pointer has
been resolved.
* trans-expr.c (gfc_conv_component_ref): Handle procedure pointer
components with array return value.
(gfc_trans_pointer_assignment): Handle procedure pointer assignments,
where the rhs is a dummy argument.
* trans-types.c (gfc_get_ppc_type,gfc_get_derived_type): Handle
procedure pointer components with array return value.
2009-05-21 Janus Weil <janus@gcc.gnu.org>
PR fortran/40176
* gfortran.dg/proc_ptr_18.f90: New.
* gfortran.dg/proc_ptr_19.f90: New.
* gfortran.dg/proc_ptr_comp_9.f90: New.
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 147761)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -476,8 +476,8 @@ gfc_conv_component_ref (gfc_se * se, gfc
se->string_length = tmp;
}
- if ((c->attr.pointer || c->attr.proc_pointer) && c->attr.dimension == 0
- && c->ts.type != BT_CHARACTER)
+ if ((c->attr.pointer && c->attr.dimension == 0 && c->ts.type != BT_CHARACTER)
+ || c->attr.proc_pointer)
se->expr = build_fold_indirect_ref (se->expr);
}
@@ -4053,6 +4053,10 @@ gfc_trans_pointer_assignment (gfc_expr *
&& expr1->symtree->n.sym->attr.dummy)
lse.expr = build_fold_indirect_ref (lse.expr);
+ if (expr2->symtree && expr2->symtree->n.sym->attr.proc_pointer
+ && expr2->symtree->n.sym->attr.dummy)
+ rse.expr = build_fold_indirect_ref (rse.expr);
+
gfc_add_block_to_block (&block, &lse.pre);
gfc_add_block_to_block (&block, &rse.pre);
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c (revision 147761)
+++ gcc/fortran/trans-types.c (working copy)
@@ -1875,7 +1875,7 @@ tree
gfc_get_ppc_type (gfc_component* c)
{
tree t;
- if (c->attr.function)
+ if (c->attr.function && !c->attr.dimension)
t = gfc_typenode_for_spec (&c->ts);
else
t = void_type_node;
@@ -1997,7 +1997,7 @@ gfc_get_derived_type (gfc_symbol * deriv
/* This returns an array descriptor type. Initialization may be
required. */
- if (c->attr.dimension)
+ if (c->attr.dimension && !c->attr.proc_pointer)
{
if (c->attr.pointer || c->attr.allocatable)
{
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 147761)
+++ gcc/fortran/resolve.c (working copy)
@@ -8982,6 +8982,9 @@ ensure_not_abstract (gfc_symbol* sub, gf
}
+static void resolve_symbol (gfc_symbol *sym);
+
+
/* Resolve the components of a derived type. */
static gfc_try
@@ -9019,6 +9022,7 @@ resolve_fl_derived (gfc_symbol *sym)
|| c->ts.interface->attr.intrinsic)
{
gfc_symbol *ifc = c->ts.interface;
+ resolve_symbol (ifc);
if (ifc->attr.intrinsic)
resolve_intrinsic (ifc, &ifc->declared_at);
@@ -9414,6 +9418,7 @@ resolve_symbol (gfc_symbol *sym)
|| sym->ts.interface->attr.intrinsic)
{
gfc_symbol *ifc = sym->ts.interface;
+ resolve_symbol (ifc);
if (ifc->attr.intrinsic)
resolve_intrinsic (ifc, &ifc->declared_at);
! { dg-do run }
!
! PR 40176: Fortran 2003: Procedure pointers with array return value
!
! Original test case by Barron Bichon <barron.bichon@swri.org>
! Modified by Janus Weil <janus@gcc.gnu.org>
PROGRAM test_prog
PROCEDURE(triple), POINTER :: f
f => triple
if (sum(f(2.,4.)-triple(2.,4.))>1E-3) call abort()
CONTAINS
FUNCTION triple(a,b) RESULT(tre)
REAL, INTENT(in) :: a, b
REAL :: tre(2)
tre(1) = 3.*a
tre(2) = 3.*b
END FUNCTION triple
END PROGRAM test_prog
! { dg-do run }
!
! PR 40176: Fortran 2003: Procedure pointers with array return value
!
! This example tests for a bug in procedure pointer assignments,
! where the rhs is a dummy.
!
! Original test case by Barron Bichon <barron.bichon@swri.org>
! Modified by Janus Weil <janus@gcc.gnu.org>
PROGRAM test_prog
PROCEDURE(add), POINTER :: forig, fset
forig => add
CALL set_ptr(forig,fset)
if (forig(1,2) /= fset(1,2)) call abort()
CONTAINS
SUBROUTINE set_ptr(f1,f2)
PROCEDURE(add), POINTER :: f1, f2
f2 => f1
END SUBROUTINE set_ptr
FUNCTION add(a,b)
INTEGER :: a,b,add
add = a+b
END FUNCTION add
END PROGRAM test_prog
! { dg-do run }
!
! PR 40176: Fortran 2003: Procedure pointers with array return value
!
! Original test case by Barron Bichon <barron.bichon@swri.org>
! Modified by Janus Weil <janus@gcc.gnu.org>
PROGRAM test_prog
TYPE ProcPointerType
PROCEDURE(triple), POINTER, NOPASS :: f
END TYPE ProcPointerType
TYPE (ProcPointerType) :: ppt
PROCEDURE(triple), POINTER :: f
REAL :: tre(2)
ppt%f => triple
f => ppt%f
tre = f(2,[2.,4.])
if (abs(tre(1)-6.)>1E-3) call abort()
if (abs(tre(2)-12.)>1E-3) call abort()
CONTAINS
FUNCTION triple(n,x) RESULT(tre)
INTEGER, INTENT(in) :: n
REAL, INTENT(in) :: x(2)
REAL :: tre(2)
tre = 3.*x
END FUNCTION triple
END PROGRAM test_prog