diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-10-21 13:31:55 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-10-21 13:31:55 +0200 |
| commit | 837c4b78f697de3a047f6e6dba919c02fd769809 (patch) | |
| tree | 9476e2f4bdc3f2072057ad7def2aa663cf81b0a9 /gcc/fortran/primary.c | |
| parent | 46241ea9d1ecf8a9b337bc6cbeb4f28421060f85 (diff) | |
| download | gcc-837c4b78f697de3a047f6e6dba919c02fd769809.zip gcc-837c4b78f697de3a047f6e6dba919c02fd769809.tar.gz gcc-837c4b78f697de3a047f6e6dba919c02fd769809.tar.bz2 | |
re PR fortran/46060 ([F03] procedure pointer component referenced without argument list)
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/46060
* gfortran.dg/proc_ptr_comp_25.f90: New.
From-SVN: r165769
Diffstat (limited to 'gcc/fortran/primary.c')
| -rw-r--r-- | gcc/fortran/primary.c | 17 |
1 files changed, 16 insertions, 1 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 054c66f..9632d1c 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -28,6 +28,8 @@ along with GCC; see the file COPYING3. If not see #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. */ @@ -1610,6 +1612,8 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp) return MATCH_YES; head = NULL; + matching_actual_arglist++; + for (;;) { if (head == NULL) @@ -1684,6 +1688,7 @@ gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp) } *argp = head; + matching_actual_arglist--; return MATCH_YES; syntax: @@ -1692,7 +1697,7 @@ syntax: cleanup: gfc_free_actual_arglist (head); gfc_current_locus = old_loc; - + matching_actual_arglist--; return MATCH_ERROR; } @@ -1883,10 +1888,20 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, 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; |