This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR27900 - ICE using intrinsics as arguments


:ADDPATCH fortran:

After quite a lot of worrying at this one by both FX and myself, the fix turns out to be quite simple and self explanatory. The testcase is a slight development of the reporter's.

Bootstrapped and regtested on ia64/FC5 - OK for trunk and 4.2?

Paul
2006-12-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/27900
	* resolve.c (resolve_actual_arglist): If all else fails and a
	procedure actual argument has no type, see if a specific
	intrinsic matches.

2006-12-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/27900
	* gfortran.dg/intrinsic_actual_4.f90: New test.
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 120244)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_actual_arglist (gfc_actual_argli
*** 938,943 ****
--- 938,958 ----
  		      && sym->ns->parent->proc_name == sym)))
  	    goto got_variable;
  
+ 	  if (sym->attr.function
+ 		&& sym->ts.type == BT_UNKNOWN
+ 		&& sym->attr.intrinsic)
+ 	    {
+ 	      gfc_intrinsic_sym *isym;
+ 	      isym = gfc_find_function (sym->name);
+ 	      if (isym == NULL || !isym->specific)
+ 		{
+ 		  gfc_error ("Unable to find a specific INTRINSIC procedure "
+ 			     "for the reference '%s' at %L", sym->name,
+ 			     &e->where);
+ 		}
+ 	      sym->ts = isym->ts;
+ 	    }
+ 
  	  continue;
  	}
  
Index: gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90	(revision 0)
***************
*** 0 ****
--- 1,18 ----
+ ! { dg-do run }
+ ! Tests the fix for PR27900, in which an ICE would be caused because
+ ! the actual argument LEN had no type.
+ !
+ ! Contributed by Klaus Ramstöck <klra67@freenet.de>
+ !
+       subroutine sub (proc, chr)
+       external proc
+       integer proc
+       character*(*) chr
+       if (proc (chr) .ne. 6) call abort ()
+       end subroutine sub
+ 
+       implicit none
+       integer i
+       i = len ("123")
+       call sub (len, "abcdef")
+       end

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]