[Patch, Fortran] PR fortran/37638: Possible ICE-on-invalid for typebound calls

[Patch, Fortran] PR fortran/37638: Possible ICE-on-invalid for typebound calls

[Daniel Kraft]

[-- Attachment #1: Type: text/plain, Size: 1247 bytes --]

Hi,

when an error is detected during resolution of a type-bound procedure 
binding (like PASS(invalid) where invalid is no actual argument name of 
the target procedure) this error is of course reported, but nothing else 
is done at the moment.  This leads to the problem that the procedure is 
possibly left in an "invalid" state and a later call to it ICEd in the 
PR; with GENERIC procedures basically "the same" is is also possible as 
in the PR's test, see the extended test case in the patch.

This patch adds a new flag to the gfc_typebound_proc structure to flag 
erraneous ones during resolution; later on, those are ignored for calls.

If a GENERIC call is encountered that should resolve to an erraneous 
specific binding, a "no matching specific binding" error is output.  On 
the other hand, if such a procedure is called directly, no error message 
is printed as the main error is the one printed for the PROCEDURE 
itself.  (See the test-case for an example on what errors are printed / 
not printed.)  I believe this is the best solution.  What do you think?

Currently regression testing on GNU/Linux-x86-32.  Ok for trunk if no 
regressions?

Yours,
Daniel

-- 
Done:  Arc-Bar-Cav-Rog-Sam-Val-Wiz
To go: Hea-Kni-Mon-Pri-Ran-Tou

[-- Attachment #2: patch.changelog --]
[-- Type: text/plain, Size: 515 bytes --]

2008-10-04  Daniel Kraft  <d@domob.eu>

	PR fortran/37638
	* gfortran.h (struct gfc_typebound_proc): New flag `error'.
	* resolve.c (update_arglist_pass): Added assertion.
	(update_compcall_arglist): Fail early for erraneous procedures to avoid
	confusion later.
	(resolve_typebound_generic_call): Ignore erraneous specific targets
	and added assertions.
	(resolve_typebound_procedure): Set new `error' flag.

2008-10-04  Daniel Kraft  <d@domob.eu>

	PR fortran/37638
	* gfortran.dg/typebound_call_9.f03: New test.

[-- Attachment #3: patch.diff --]
[-- Type: text/plain, Size: 3624 bytes --]

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 140866)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -1037,6 +1037,7 @@ typedef struct gfc_typebound_proc
   unsigned non_overridable:1;
   unsigned is_generic:1;
   unsigned function:1, subroutine:1;
+  unsigned error:1; /* Ignore it, when an error occurred during resolution.  */
 }
 gfc_typebound_proc;
 
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 140866)
+++ gcc/fortran/resolve.c	(working copy)
@@ -4366,6 +4366,8 @@ fixup_charlen (gfc_expr *e)
 static gfc_actual_arglist*
 update_arglist_pass (gfc_actual_arglist* lst, gfc_expr* po, unsigned argpos)
 {
+  gcc_assert (argpos > 0);
+
   if (argpos == 1)
     {
       gfc_actual_arglist* result;
@@ -4417,6 +4419,9 @@ update_compcall_arglist (gfc_expr* e)
 
   tbp = e->value.compcall.tbp;
 
+  if (tbp->error)
+    return FAILURE;
+
   po = extract_compcall_passed_object (e);
   if (!po)
     return FAILURE;
@@ -4497,6 +4502,10 @@ resolve_typebound_generic_call (gfc_expr
 	  bool matches;
 
 	  gcc_assert (g->specific);
+
+	  if (g->specific->error)
+	    continue;
+
 	  target = g->specific->u.specific->n.sym;
 
 	  /* Get the right arglist by handling PASS/NOPASS.  */
@@ -4508,6 +4517,8 @@ resolve_typebound_generic_call (gfc_expr
 	      if (!po)
 		return FAILURE;
 
+	      gcc_assert (g->specific->pass_arg_num > 0);
+	      gcc_assert (!g->specific->error);
 	      args = update_arglist_pass (args, po, g->specific->pass_arg_num);
 	    }
 	  resolve_actual_arglist (args, target->attr.proc,
@@ -8448,10 +8459,12 @@ resolve_typebound_procedure (gfc_symtree
       goto error;
     }
 
+  stree->typebound->error = 0;
   return;
 
 error:
   resolve_bindings_result = FAILURE;
+  stree->typebound->error = 1;
 }
 
 static gfc_try
Index: gcc/testsuite/gfortran.dg/typebound_call_9.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_call_9.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/typebound_call_9.f03	(revision 0)
@@ -0,0 +1,63 @@
+! { dg-do compile }
+
+! FIXME: Remove once polymorphic PASS is resolved
+! { dg-options "-w" }
+
+! PR fortran/37638
+! If a PASS(arg) is invalid, a call to this routine later would ICE in
+! resolving.  Check that this also works for GENERIC, in addition to the
+! PR's original test.
+
+! Contributed by Salvatore Fillipone <sfilippone@uniroma2.it>
+
+module foo_mod
+  implicit none 
+
+  type base_foo_type 
+    integer           :: nr,nc
+    integer, allocatable :: iv1(:), iv2(:)
+
+  contains
+
+    procedure, pass(a) :: makenull ! { dg-error "has no argument 'a'" }
+    generic :: null2 => makenull
+
+  end type base_foo_type
+
+contains
+
+  subroutine makenull(m)
+    implicit none
+    type(base_foo_type), intent(inout) :: m
+
+    m%nr=0
+    m%nc=0
+
+  end subroutine makenull
+
+  subroutine foo_free(a,info)
+    implicit none
+    Type(base_foo_type), intent(inout)  :: A
+    Integer, intent(out)        :: info
+    integer             :: iret
+    info  = 0
+
+
+    if (allocated(a%iv1)) then
+      deallocate(a%iv1,stat=iret)
+      if (iret /= 0) info = max(info,2)
+    endif
+    if (allocated(a%iv2)) then
+      deallocate(a%iv2,stat=iret)
+      if (iret /= 0) info = max(info,3)
+    endif
+
+    call a%makenull()
+    call a%null2 () ! { dg-error "no matching specific binding" }
+
+    Return
+  End Subroutine foo_free
+
+end module foo_mod
+
+! { dg-final { cleanup-modules "foo_mod" } }

Re: [Patch, Fortran] PR fortran/37638: Possible ICE-on-invalid for typebound calls

[Paul Richard Thomas]

Daniel,

OK for trunk.

Note that I just had to add an 'error' flag to symbol attributes,
which marks the symbol itself as being a dud.

Thanks for the patch.

Paul

Re: [Patch, Fortran] PR fortran/37638: Possible ICE-on-invalid for typebound calls

[Daniel Kraft]

Paul Richard Thomas wrote:
> Daniel,
> 
> OK for trunk.

Thanks for the review!

> Note that I just had to add an 'error' flag to symbol attributes,
> which marks the symbol itself as being a dud.

Do you think I should re-use that flag instead?  That could be possible.

Daniel

-- 
Done:  Arc-Bar-Cav-Rog-Sam-Val-Wiz
To go: Hea-Kni-Mon-Pri-Ran-Tou

Re: [Patch, Fortran] PR fortran/37638: Possible ICE-on-invalid for typebound calls

[Paul Richard Thomas]

Daniel,

> Do you think I should re-use that flag instead?  That could be possible.

I assumed that it wouldn't work - which symbol would you attach the error to?

Paul

Re: [Patch, Fortran] PR fortran/37638: Possible ICE-on-invalid for typebound calls

[Daniel Kraft]

Paul Richard Thomas wrote:
> Daniel,
> 
>> Do you think I should re-use that flag instead?  That could be possible.
> 
> I assumed that it wouldn't work - which symbol would you attach the error to?

The symtree that holds the type-bound procedure; or isn't this possible?

Daniel

-- 
Done:  Arc-Bar-Cav-Rog-Sam-Val-Wiz
To go: Hea-Kni-Mon-Pri-Ran-Tou

Re: [Patch, Fortran] PR fortran/37638: Possible ICE-on-invalid for typebound calls

[Paul Richard Thomas]

Daniel,

If you look at the patch for PR35680. it is the symbol that gets marked.

> The symtree that holds the type-bound procedure; or isn't this possible?
>

Paul

Re: [Patch, Fortran] PR fortran/37638: Possible ICE-on-invalid for typebound calls

[Daniel Kraft]

Paul Richard Thomas wrote:
> Daniel,
> 
> OK for trunk.

Committed as rev. 140880 to trunk.

> Note that I just had to add an 'error' flag to symbol attributes,
> which marks the symbol itself as being a dud.

I did look at the patch and your flag; it would have been possible to 
re-use it indeed but after all I find this solution cleaner so we don't 
get any unexpected interactions with symbol-handling code 
misinterpreting our type-bound error flag on the symbol or something 
like that.  Or at the very least a little clearer code I hope...

Cheers,
Daniel

-- 
Done:  Arc-Bar-Cav-Rog-Sam-Val-Wiz
To go: Hea-Kni-Mon-Pri-Ran-Tou