[Patch, fortran] - PR28237 and PR23420 / ICEs on bad code due to integer functions in format tag

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

By an odd coincidence, I encountered this bug on the evening that 
PR28237 was posted.  The only integer that a format tag is permitted is 
an assigned scalar variable. If an integer function is used, the 
existing checks miss this and an ICE occurs in trans-io.c.

The checking of format tags is done in io.c (resolve_tag).  This mirrors 
the logic in trans-io.c quite well, except that the condition to block 
this bad code is missing.

The patch is sufficiently obvious that I was tempted to commit it, as 
being just that.  However, I decided to submit it for your amusement and 
will commit tomorrow morning, unless I hear any objections.

Regtests on FC5/Athlon. OK for trunk and 4.1?

Paul

PS WRITE suffers from the problem too and the testcase checks that it is 
also fixed there.

2006-07-06  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/28237
   PR fortran/23420
   * io.c (resolve_tag): Any integer that is not an assigned
   variable is an error.

2006-07-06  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/28237
   PR fortran/23420
   * gfortran.dg/print_fmt_5.f90: New test.


Index: gcc/fortran/io.c
===================================================================
*** gcc/fortran/io.c	(revision 115221)
--- gcc/fortran/io.c	(working copy)
*************** resolve_tag (const io_tag * tag, gfc_exp
*** 1063,1068 ****
--- 1063,1075 ----
  		  return FAILURE;
  		}
  	    }
+ 	  else if (e->ts.type == BT_INTEGER)
+ 	    {
+ 	      gfc_error ("scalar '%s' FORMAT tag at %L is not an ASSIGNED "
+ 			 "variable", gfc_basic_typename (e->ts.type), &e->where);
+ 	      return FAILURE;
+ 	    }
+ 
  	  return SUCCESS;
  	}
        else
Index: gcc/testsuite/gfortran.dg/print_fmt_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/print_fmt_5.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/print_fmt_5.f90	(revision 0)
***************
*** 0 ****
--- 1,45 ----
+ ! { dg-do compile }
+ ! print_fmt_5.f90
+ ! Test of fix for PR28237 and the last bit of PR23420.  See
+ ! below for the description of the problem.
+ !
+ program r
+   character(12) :: for = '(i5)', left = '(i', right = ')'
+   integer :: i, j
+   integer :: h(4) &
+     = (/1h(, 1hi, 1h5, 1h)/)! { dg-warning "HOLLERITH|Hollerith" }
+   namelist /mynml/ i
+   i = fact ()
+ !
+ ! All these are "legal" things to do; note however the warnings
+ ! for extensions or obsolete features!
+ !
+   print *, fact()
+   print 100, fact()
+   print '(i5)', fact()
+   print mynml      ! { dg-warning "is an extension" }
+   do i = 1, 5
+     print trim(left)//char(iachar('0') + i)//trim(right), i
+   end do
+   assign 100 to i  ! { dg-warning "ASSIGN statement" }
+   print i, fact()  ! { dg-warning "ASSIGNED variable" }
+   print h, fact () ! { dg-warning "Non-character in FORMAT" }
+ !
+ ! These are not and caused a segfault in trans-io:560
+ !
+ ! PR28237
+   print fact()     ! { dg-error "not an ASSIGNED variable" }
+ ! original PR23420
+   print precision(1.2_8) ! { dg-error "type default CHARACTER" }
+ ! PR23420 points 4 and 5
+   print j + j      ! { dg-error "not an ASSIGNED variable" }
+ ! An extension of the above, encountered in writing the fix
+   write (*, fact())! { dg-error "not an ASSIGNED variable" }
+  100 format (i5)
+ contains
+   function fact()
+     integer :: fact
+     fact = 1
+   end function fact
+ end
+