re PR fortran/34495 (accepts invalid initialization expressions withTRANSFER)

gcc/fortran:
2007-12-19  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/34495
        * expr.c (check_init_expr): Check whether variables with flavor
        FL_PARAMETER do have a value assigned. Added error messages where
        appropriate.
        * simplify.c (gfc_simplify_transfer): Added check if the MOLD
        argument is a constant if working with initialization
        expressions.

gcc/testsuite:
2007-12-19  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/34495
        * gfortran.dg/transfer_simplify_2.f90: Fixed invalid initialization
	expressions.
        * gfortran.dg/transfer_simplify_7.f90: New test.

From-SVN: r131047

gcc/fortran/ChangeLog

+2007-12-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34495
+	* expr.c (check_init_expr): Check whether variables with flavor
+	FL_PARAMETER do have a value assigned. Added error messages where
+	appropriate.
+	* simplify.c (gfc_simplify_transfer): Added check if the MOLD
+	argument is a constant if working with initialization
+	expressions.
+
 2007-12-17  Tobias Burnus  <burnus@net-b.de>
 
 	* intrinsic.c (add_functions): Undo change; mark float and

gcc/fortran/expr.c

@@ -2202,7 +2202,18 @@ check_init_expr (gfc_expr *e)
 
       if (e->symtree->n.sym->attr.flavor == FL_PARAMETER)
 	{
-	  t = simplify_parameter_variable (e, 0);
+	  /* A PARAMETER shall not be used to define itself, i.e.
+		REAL, PARAMETER :: x = transfer(0, x)
+	     is invalid.  */
+	  if (!e->symtree->n.sym->value)
+	    {
+	      gfc_error("PARAMETER '%s' is used at %L before its definition "
+			"is complete", e->symtree->n.sym->name, &e->where);
+	      t = FAILURE;
+	    }
+	  else
+	    t = simplify_parameter_variable (e, 0);
+
 	  break;
 	}
 
@@ -2233,6 +2244,12 @@ check_init_expr (gfc_expr *e)
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
+	      case AS_EXPLICIT:
+		gfc_error ("Array '%s' at %L is a variable, which does "
+			   "not reduce to a constant expression",
+			   e->symtree->n.sym->name, &e->where);
+		break;
+
 	      default:
 		gcc_unreachable();
 	  }

gcc/fortran/simplify.c

@@ -4088,6 +4088,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
   unsigned char *buffer;
 
   if (!gfc_is_constant_expr (source)
+	|| (gfc_init_expr && !gfc_is_constant_expr (mold))
 	|| !gfc_is_constant_expr (size))
     return NULL;
 

gcc/testsuite/ChangeLog

+2007-12-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34495
+	* gfortran.dg/transfer_simplify_2.f90: Fixed invalid initialization
+	expressions.
+	* gfortran.dg/transfer_simplify_7.f90: New test.
+
 2007-12-18  Janis Johnson  <janis187@us.ibm.com>
 
 	* gcc.dg/pr32912-3.c: Compile with -w.

gcc/testsuite/gfortran.dg/transfer_simplify_2.f90

@@ -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)

gcc/testsuite/gfortran.dg/transfer_simplify_7.f90

+! { 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 "before its definition is complete" }
+
+
+! 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 "before its definition is complete" }
+
+
+! 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 "does not reduce to a constant" }
+
+real, parameter, dimension(2,2) :: cp3 = transfer([1, 2, 3, 4], cp3)  ! { dg-error "before its definition is complete" }
+
+end