Re: [patch, fortran] PR34495 - accepts invalid init-expr with TRANSFER

[Daniel Franke <franke dot daniel at gmail dot com>]

On Tuesday 18 December 2007 15:01:16 Tobias Burnus wrote:
> Daniel Franke wrote:
> > On Tuesday 18 December 2007 11:39:14 Daniel Franke wrote:
> >> 2007-12-18  Daniel Franke  <franke.daniel@gmail.com>
> >>
> >> 	PR fortran/34495
> >> 	* transfer_simplify_2.f90: Fixed invalid initialization expressions.
> >> 	* transfer_simplify_7.f90: New test.
>
> Nice patch, but it gives now an ICE for the following invalid program:
>
>   implicit none
>   dimension :: i1(5)
>   integer :: i1 = transfer([1,2,3,4,5], i1)
>   end

Good point.

Attached, updated, patch adds a check for explicit arrays in 
check_init_expr(). This should be save as otherwise the gcc_unreachable() 
would have triggered before now. Further, the above testcase (and related 
ones) are now included in transfer_simplify_7.f90.

Currently regtesting. Assuming no further problems, ok for trunk?


Regards
	Daniel

Index: simplify.c
===================================================================
--- simplify.c	(revision 131020)
+++ simplify.c	(working copy)
@@ -4088,6 +4088,7 @@ gfc_simplify_transfer (gfc_expr *source,
   unsigned char *buffer;
 
   if (!gfc_is_constant_expr (source)
+	|| (gfc_init_expr && !gfc_is_constant_expr (mold))
 	|| !gfc_is_constant_expr (size))
     return NULL;
 
Index: expr.c
===================================================================
--- expr.c	(revision 131020)
+++ expr.c	(working copy)
@@ -2200,7 +2200,11 @@ check_init_expr (gfc_expr *e)
       if (gfc_check_iter_variable (e) == SUCCESS)
 	break;
 
-      if (e->symtree->n.sym->attr.flavor == FL_PARAMETER)
+      /* A PARAMETER shall not be used to define itself, i.e.
+	   REAL, PARAMETER :: x = transfer(0, x)
+	 is invalid.  */
+      if (e->symtree->n.sym->attr.flavor == FL_PARAMETER
+	  && e->symtree->n.sym->value)
 	{
 	  t = simplify_parameter_variable (e, 0);
 	  break;
@@ -2233,6 +2237,12 @@ check_init_expr (gfc_expr *e)
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
+	      case AS_EXPLICIT:
+		gfc_error ("Non-constant array '%s' at %L is not permitted "
+			   "in an initialization expression",
+			   e->symtree->n.sym->name, &e->where);
+		break;
+
 	      default:
 		gcc_unreachable();
 	  }
Index: ../testsuite/gfortran.dg/transfer_simplify_2.f90
===================================================================
--- ../testsuite/gfortran.dg/transfer_simplify_2.f90	(revision 131020)
+++ ../testsuite/gfortran.dg/transfer_simplify_2.f90	(working copy)
@@ -71,7 +71,7 @@ contains
 
   subroutine integer8_to_real4
     integer               ::  k
-    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), i1)
+    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
     integer(8)            ::  i2(2) = i1
     real(4), parameter    ::  r1(4) = transfer (i1, (/(1.0_4,k=1,4)/))
     real(4)               ::  r2(4)
@@ -82,7 +82,7 @@ contains
 
   subroutine integer8_to_complex4
     integer               ::  k
-    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), i1)
+    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
     integer(8)            ::  i2(2) = i1
     complex(4), parameter ::  z1(2) = transfer (i1, (/((1.0_4,2.0_4),k=1,2)/))
     complex(4)            ::  z2(2)
Index: ../testsuite/gfortran.dg/transfer_simplify_7.f90
===================================================================
--- ../testsuite/gfortran.dg/transfer_simplify_7.f90	(revision 0)
+++ ../testsuite/gfortran.dg/transfer_simplify_7.f90	(revision 0)
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! PR fortran/34495 - accepts invalid init-expr with TRANSFER
+
+! 'b' is implicitly typed
+real :: a = transfer(1234, b)              ! { dg-error "does not reduce to a constant" }
+
+! 'c' is used on lhs and rhs
+real :: c = transfer(1234, c)              ! { dg-error "does not reduce to a constant" }
+
+! 'bp' is implicitly typed
+real, parameter :: ap = transfer(1234, bp) ! { dg-error "does not reduce to a constant" }
+
+! 'yp' is used on lhs and rhs
+real, parameter :: cp = transfer(1234, cp) ! { dg-error "does not reduce to a constant" }
+
+
+! same with arrays
+real, dimension(2) :: a2 = transfer([1, 2], b2)  ! { dg-error "does not reduce to a constant" }
+
+real, dimension(2) :: a2 = transfer([1, 2], b2)  ! { dg-error "does not reduce to a constant" }
+
+dimension :: bp(2)
+real, parameter, dimension(2) :: ap2 = transfer([1, 2], bp2)  ! { dg-error "does not reduce to a constant" }
+
+real, parameter, dimension(2) :: cp2 = transfer([1, 2], cp2)  ! { dg-error "Non-constant array" }
+
+
+! same with matrices
+real, dimension(2,2) :: a3 = transfer([1, 2, 3, 4], b3)  ! { dg-error "does not reduce to a constant" }
+
+real, dimension(2,2) :: a3 = transfer([1, 2, 3, 4], b3)  ! { dg-error "does not reduce to a constant" }
+
+dimension :: bp3(2,2)
+real, parameter, dimension(2,2) :: ap3 = transfer([1, 2, 3, 4], bp3)  ! { dg-error "Non-constant array" }
+
+real, parameter, dimension(2,2) :: cp3 = transfer([1, 2, 3, 4], cp3)  ! { dg-error "Non-constant array" }
+
+end