+2010-10-21 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/46060
+ * match.h (gfc_matching_ptr_assignment): New global variable to indicate
+ we're currently matching a (non-proc-)pointer assignment.
+ * decl.c (match_pointer_init): Set it.
+ * match.c (gfc_match_pointer_assignment): Ditto.
+ * primary.c (matching_actual_arglist): New global variable to indicate
+ we're currently matching an actual argument list.
+ (gfc_match_actual_arglist): Set it.
+ (gfc_match_varspec): Reject procedure pointer component calls with
+ missing argument list.
+
2010-10-21 Janus Weil <janus@gcc.gnu.org>
PR fortran/46067
return m;
/* Match non-NULL initialization. */
+ gfc_matching_ptr_assignment = !procptr;
gfc_matching_procptr_assignment = procptr;
m = gfc_match_rvalue (init);
+ gfc_matching_ptr_assignment = 0;
gfc_matching_procptr_assignment = 0;
if (m == MATCH_ERROR)
return MATCH_ERROR;
#include "match.h"
#include "parse.h"
+int gfc_matching_ptr_assignment = 0;
int gfc_matching_procptr_assignment = 0;
bool gfc_matching_prefix = false;
old_loc = gfc_current_locus;
lvalue = rvalue = NULL;
+ gfc_matching_ptr_assignment = 0;
gfc_matching_procptr_assignment = 0;
m = gfc_match (" %v =>", &lvalue);
if (lvalue->symtree->n.sym->attr.proc_pointer
|| gfc_is_proc_ptr_comp (lvalue, NULL))
gfc_matching_procptr_assignment = 1;
+ else
+ gfc_matching_ptr_assignment = 1;
m = gfc_match (" %e%t", &rvalue);
+ gfc_matching_ptr_assignment = 0;
gfc_matching_procptr_assignment = 0;
if (m != MATCH_YES)
goto cleanup;
separate. */
extern gfc_st_label *gfc_statement_label;
+extern int gfc_matching_ptr_assignment;
extern int gfc_matching_procptr_assignment;
extern bool gfc_matching_prefix;
#include "parse.h"
#include "constructor.h"
+int matching_actual_arglist = 0;
+
/* Matches a kind-parameter expression, which is either a named
symbolic constant or a nonnegative integer constant. If
successful, sets the kind value to the correct integer. */
return MATCH_YES;
head = NULL;
+ matching_actual_arglist++;
+
for (;;)
{
if (head == NULL)
}
*argp = head;
+ matching_actual_arglist--;
return MATCH_YES;
syntax:
cleanup:
gfc_free_actual_arglist (head);
gfc_current_locus = old_loc;
-
+ matching_actual_arglist--;
return MATCH_ERROR;
}
if (component->attr.proc_pointer && ppc_arg
&& !gfc_matching_procptr_assignment)
{
+ /* Procedure pointer component call: Look for argument list. */
m = gfc_match_actual_arglist (sub_flag,
&primary->value.compcall.actual);
if (m == MATCH_ERROR)
return MATCH_ERROR;
+
+ if (m == MATCH_NO && !gfc_matching_ptr_assignment
+ && !matching_actual_arglist)
+ {
+ gfc_error ("Procedure pointer component '%s' requires an "
+ "argument list at %C", component->name);
+ return MATCH_ERROR;
+ }
+
if (m == MATCH_YES)
primary->expr_type = EXPR_PPC;
+2010-10-21 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/46060
+ * gfortran.dg/proc_ptr_comp_25.f90: New.
+
2010-10-21 Richard Guenther <rguenther@suse.de>
Michael Matz <matz@suse.de>
--- /dev/null
+! { dg-do compile }
+!
+! PR 46060: [F03] procedure pointer component referenced without argument list
+!
+! Contributed by Stephen J. Bespalko <sjbespa@comcast.net>
+
+implicit none
+
+abstract interface
+ function name_func (ivar) result (res)
+ integer, intent(in) :: ivar
+ character(len=8) :: res
+ end function name_func
+end interface
+
+type var_type
+ procedure(name_func), nopass, pointer :: name
+end type var_type
+
+type(var_type) :: vars
+character(len=8) name
+
+name = vars%name ! { dg-error "requires an argument list" }
+
+end