re PR fortran/62106 (Adding a scalar variable to an array constructor gives wrong result)

2014-08-14  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/62106
	* gfortran.h (symbol_attribute):  Add fe_temp flag.
	* frontend-passes.c (is_fe_temp):  New function.
	(create_var):  Don't add a temporary for an already
	created variable or for a constant.
	(combine_ARRAY_constructor):  Remove special handling
	for constants.

2014-08-14  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/62106
	* gfortran.dg/array_constructor_49.f90:  New test.

From-SVN: r213980

gcc/fortran/ChangeLog

+2014-08-14  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/62106
+	* gfortran.h (symbol_attribute):  Add fe_temp flag.
+	* frontend-passes.c (is_fe_temp):  New function.
+	(create_var):  Don't add a temporary for an already
+	created variable or for a constant.
+	(combine_ARRAY_constructor):  Remove special handling
+	for constants.
+
 2014-08-14  Tobias Burnus  <burnus@net-b.de>
 
 	* gfortran.texi (caf_register_t): Add CAF_REGTYPE_CRITICAL.

gcc/fortran/frontend-passes.c

@@ -430,11 +430,26 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
   return 0;
 }
 
+/* Auxiliary function to check if an expression is a temporary created by
+   create var.  */
+
+static bool
+is_fe_temp (gfc_expr *e)
+{
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
+
+  return e->symtree->n.sym->attr.fe_temp;
+}
+
+
 /* Returns a new expression (a variable) to be used in place of the old one,
    with an assignment statement before the current statement to set
    the value of the variable. Creates a new BLOCK for the statement if
    that hasn't already been done and puts the statement, plus the
-   newly created variables, in that block.  */
+   newly created variables, in that block.  Special cases:  If the
+   expression is constant or a temporary which has already
+   been created, just copy it.  */
 
 static gfc_expr*
 create_var (gfc_expr * e)
@@ -448,6 +463,9 @@ create_var (gfc_expr * e)
   gfc_namespace *ns;
   int i;
 
+  if (e->expr_type == EXPR_CONSTANT || is_fe_temp (e))
+    return gfc_copy_expr (e);
+
   /* If the block hasn't already been created, do so.  */
   if (inserted_block == NULL)
     {
@@ -522,6 +540,7 @@ create_var (gfc_expr * e)
   symbol->attr.flavor = FL_VARIABLE;
   symbol->attr.referenced = 1;
   symbol->attr.dimension = e->rank > 0;
+  symbol->attr.fe_temp = 1;
   gfc_commit_symbol (symbol);
 
   result = gfc_get_expr ();
@@ -1082,10 +1101,7 @@ combine_array_constructor (gfc_expr *e)
   if (op2->ts.type == BT_CHARACTER)
     return false;
 
-  if (op2->expr_type == EXPR_CONSTANT)
-    scalar = gfc_copy_expr (op2);
-  else
-    scalar = create_var (gfc_copy_expr (op2));
+  scalar = create_var (gfc_copy_expr (op2));
 
   oldbase = op1->value.constructor;
   newbase = NULL;

gcc/fortran/gfortran.h

@@ -739,7 +739,7 @@ typedef struct
     optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
     dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
     implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
-    contiguous:1;
+    contiguous:1, fe_temp: 1;
 
   /* For CLASS containers, the pointer attribute is sometimes set internally
      even though it was not directly specified.  In this case, keep the

gcc/testsuite/ChangeLog

+2014-08-14  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/62106
+	* gfortran.dg/array_constructor_49.f90:  New test.
+
 2014-08-14  Paolo Carlini  <paolo.carlini@oracle.com>
 
 	PR c++/54377
@@ -115,7 +120,7 @@
 
 	PR tree-optimization/62073
 	* gcc.dg/vect/pr62073.c: New test.
-	
+
 2014-08-11  Richard Biener  <rguenther@suse.de>
 
 	PR tree-optimization/62070

gcc/testsuite/gfortran.dg/array_constructor_49.f90

+! { dg-do run }
+! { dg-options "-ffrontend-optimize -fdump-tree-original" }
+! PR 62106 - this used to give wrong results because
+! of a bogus extra temporary variable.
+! Original test case by Martien Hulsen
+program t
+  integer :: ndim=2, ndfp=4, i
+  character (len=8) :: line
+  write (unit=line,fmt='(4I2)'), (/ ( i, i = 1, ndfp ) /) + ndim
+  if (line /= ' 3 4 5 6') call abort
+end program t
+! { dg-final { scan-tree-dump-times "__var" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }