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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1bc4917..5ade0ec 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,18 @@
 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
        * interface.c (gfc_compare_interfaces): Switch arguments of type
        comparison (important for polymorphic variables).

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 5b4ab18..009b010 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -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;

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 836c95c..efde1a6 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -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;

diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 501049e..69f1d9e 100644 (file)
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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;
 

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 054c66f..9632d1c 100644 (file)
--- 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;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8b12fca..51877d1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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>
 

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_25.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_25.f90
new file mode 100644 (file)
index 0000000..6835526
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_25.f90
@@ -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