PR fortran/42045
* resolve.c (resolve_actual_arglist): Make sure procedure pointer
actual arguments are resolved correctly.
(resolve_function): An EXPR_FUNCTION which is a procedure pointer
component, has already been resolved.
(resolve_fl_derived): Procedure pointer components should not be
implicitly typed.
2009-11-24 Janus Weil <janus@gcc.gnu.org>
PR fortran/42045
* gfortran.dg/proc_ptr_comp_2.f90: Correct invalid test case.
* gfortran.dg/proc_ptr_comp_3.f90: Extended test case.
* gfortran.dg/proc_ptr_comp_24.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154492
138bc75d-0d04-0410-961f-
82ee72b054a4
+2009-11-24 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/42045
+ * resolve.c (resolve_actual_arglist): Make sure procedure pointer
+ actual arguments are resolved correctly.
+ (resolve_function): An EXPR_FUNCTION which is a procedure pointer
+ component, has already been resolved.
+ (resolve_fl_derived): Procedure pointer components should not be
+ implicitly typed.
+
2009-11-21 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/41807
e->rank = comp->as->rank;
e->expr_type = EXPR_FUNCTION;
}
+ if (gfc_resolve_expr (e) == FAILURE)
+ return FAILURE;
goto argument_list;
}
if (expr->symtree)
sym = expr->symtree->n.sym;
+ /* If this is a procedure pointer component, it has already been resolved. */
+ if (gfc_is_proc_ptr_comp (expr, NULL))
+ return SUCCESS;
+
if (sym && sym->attr.intrinsic
&& resolve_intrinsic (sym, &expr->where) == FAILURE)
return FAILURE;
}
else if (c->attr.proc_pointer && c->ts.type == BT_UNKNOWN)
{
- c->ts = *gfc_get_default_type (c->name, NULL);
- c->attr.implicit_type = 1;
+ /* Since PPCs are not implicitly typed, a PPC without an explicit
+ interface must be a subroutine. */
+ gfc_add_subroutine (&c->attr, c->name, &c->loc);
}
/* Procedure pointer components: Check PASS arg. */
+2009-11-24 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/42045
+ * gfortran.dg/proc_ptr_comp_2.f90: Correct invalid test case.
+ * gfortran.dg/proc_ptr_comp_3.f90: Extended test case.
+ * gfortran.dg/proc_ptr_comp_24.f90: New.
+
2009-11-23 Andy Hutchinson <hutchinsonandy@gcc.gnu.org>
* gcc.c-torture/execute/pr40404.c: Use long for bitfield on 16bit
type t\r
procedure(fcn), pointer, nopass :: ppc\r
procedure(abstr), pointer, nopass :: ppc1
- procedure(), nopass, pointer:: iptr3\r
integer :: i\r
end type\r
\r
if (base/=12) call abort\r
call foo (f,7)
-! Check with implicit interface
- obj%iptr3 => iabs
- base=obj%iptr3(-9)
- if (base/=9) call abort\r
-\r
contains\r
\r
integer function fcn(x)\r
--- /dev/null
+! { dg-do compile }
+!
+! PR42045: [F03] passing a procedure pointer component to a procedure pointer dummy
+!
+! Contributed by John McFarland <john.mcfarland@swri.org>
+
+PROGRAM prog
+ TYPE object
+ PROCEDURE(), POINTER, NOPASS :: f
+ END TYPE object
+ TYPE container
+ TYPE (object), POINTER :: o(:)
+ END TYPE container
+ TYPE (container) :: c
+ TYPE (object) :: o1, o2
+ PROCEDURE(), POINTER :: f => NULL()
+ o1%f => f
+ CALL set_func(o2,f)
+ CALL set_func(o2,o1%f)
+ ALLOCATE( c%o(5) )
+ c%o(5)%f => f
+ CALL set_func(o2,c%o(5)%f)
+CONTAINS
+ SUBROUTINE set_func(o,f)
+ TYPE (object) :: o
+ PROCEDURE(), POINTER :: f
+ o%f => f
+ END SUBROUTINE set_func
+END PROGRAM prog
external :: aaargh
type :: t
+ procedure(), pointer, nopass :: ptr1
procedure(real), pointer, nopass :: ptr2
procedure(sub), pointer, nopass :: ptr3
procedure(), pointer, nopass ptr4 ! { dg-error "Expected '::'" }
x => x%ptr2 ! { dg-error "Pointer assignment to non-POINTER" }
+print *, x%ptr1() ! { dg-error "attribute conflicts with" }
call x%ptr2() ! { dg-error "attribute conflicts with" }
print *,x%ptr3() ! { dg-error "attribute conflicts with" }