procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/46060 ([F03] procedure pointer component referenced without argument list)

Browse source 
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
This commit is contained in:
Janus Weil 2010-10-21 13:31:55 +02:00
parent 46241ea9d1
commit 837c4b78f6
7 changed files with 67 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View file

@ -1,3 +1,16 @@
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

2
gcc/fortran/decl.c
View file

@ -1673,8 +1673,10 @@ match_pointer_init (gfc_expr **init, int procptr)
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;

5
gcc/fortran/match.c
View file

@ -27,6 +27,7 @@ along with GCC; see the file COPYING3. If not see
#include "match.h"
#include "parse.h"
int gfc_matching_ptr_assignment = 0;
int gfc_matching_procptr_assignment = 0;
bool gfc_matching_prefix = false;
@ -1331,6 +1332,7 @@ gfc_match_pointer_assignment (void)
old_loc = gfc_current_locus;
lvalue = rvalue = NULL;
gfc_matching_ptr_assignment = 0;
gfc_matching_procptr_assignment = 0;
m = gfc_match (" %v =>", &lvalue);
@ -1343,8 +1345,11 @@ gfc_match_pointer_assignment (void)
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;

1
gcc/fortran/match.h
View file

@ -31,6 +31,7 @@ extern gfc_symbol *gfc_new_block;
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;

17
gcc/fortran/primary.c
View file

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

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
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>

25
gcc/testsuite/gfortran.dg/proc_ptr_comp_25.f90 Normal file
View file

@ -0,0 +1,25 @@
! { 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