re PR fortran/26393 (ICE with function returning variable lenght array)

2006-03-01  Paul Thomas  <pault@gcc.gnu.org>

	* iresolve.c (gfc_resolve_dot_product):  Remove any difference in
	treatment of logical types.
	* trans-intrinsic.c (gfc_conv_intrinsic_dot_product):  New function. 

	PR fortran/26393
	* trans-decl.c (gfc_get_symbol_decl): Extend condition that symbols
	must be referenced to include unreferenced symbols in an interface
	body. 

	PR fortran/20938
	* trans-array.c (gfc_conv_resolve_dependencies): Add call to
	gfc_are_equivalenced_arrays.
	* symbol.c (gfc_free_equiv_infos, gfc_free_equiv_lists): New
	functions. (gfc_free_namespace): Call them.
	* trans-common.c (copy_equiv_list_to_ns): New function.
	(add_equivalences): Call it.
	* gfortran.h: Add equiv_lists to gfc_namespace and define
	gfc_equiv_list and gfc_equiv_info.
	* dependency.c (gfc_are_equivalenced_arrays): New function.
	(gfc_check_dependency): Call it.
	* dependency.h: Prototype for gfc_are_equivalenced_arrays.

2006-03-01  Paul Thomas  <pault@gcc.gnu.org>

	* gfortran.dg/logical_dot_product.f90: New test. 

	PR fortran/26393
	* gfortran.dg/used_interface_ref.f90: New test.

	PR fortran/20938
	* gfortran.dg/dependency_2.f90: New test.
	* gfortran.fortran-torture/execute/where17.f90: New test.
	* gfortran.fortran-torture/execute/where18.f90: New test.
	* gfortran.fortran-torture/execute/where19.f90: New test.
	* gfortran.fortran-torture/execute/where20.f90: New test.

From-SVN: r111616

19 files changed, 467 insertions, 20 deletions

diff --git a/MAINTAINERS b/MAINTAINERS
index f88e9e4..f2f74e5 100644
--- a/MAINTAINERS
+++ b/MAINTAINERS
@@ -120,6 +120,8 @@ fortran 95		François-Xavier Coudert	coudert@clipper.ens.fr
 fortran 95              Bud Davis               jmdavis@link.com
 fortran 95		Steve Kargl		sgk@troutmask.apl.washington.edu
 fortran 95              Erik Edelmann           erik.edelmann@iki.fi
+fortran 95		Paul Thomas		pault@gcc.gnu.org
+fortran 95		Tobias Schlüter		tobias.schlueter@physik.uni-muenchen.de
 c++			Jason Merrill		jason@redhat.com
 c++                     Mark Mitchell		mark@codesourcery.com
 c++			Nathan Sidwell		nathan@codesourcery.com
@@ -327,7 +329,6 @@ Ira Ruben					ira@apple.com
 Douglas Rupp					rupp@gnat.com
 Matthew Sachs					msachs@apple.com
 Alex Samuel					samuel@codesourcery.com
-Tobias Schlüter					tobias.schlueter@physik.uni-muenchen.de
 Svein Seldal                                    svein@dev.seldal.com
 Thiemo Seufer					ths@networkno.de
 Franz Sirl					franz.sirl-kernel@lauterbach.com
@@ -336,7 +337,6 @@ Richard Stallman				rms@gnu.org
 Graham Stott					graham.stott@btinternet.com
 Mike Stump					mrs@apple.com
 Jeff Sturm					jsturm@gcc.gnu.org
-Paul Thomas					pault@gcc.gnu.org
 Kresten Krab Thorup				krab@gcc.gnu.org
 Caroline Tice					ctice@apple.com
 Michael Tiemann					tiemann@redhat.com
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d9b2abe..d434281 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,27 @@
+2006-03-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	* iresolve.c (gfc_resolve_dot_product):  Remove any difference in
+	treatment of logical types.
+	* trans-intrinsic.c (gfc_conv_intrinsic_dot_product):  New function. 
+
+	PR fortran/26393
+	* trans-decl.c (gfc_get_symbol_decl): Extend condition that symbols
+	must be referenced to include unreferenced symbols in an interface
+	body. 
+
+	PR fortran/20938
+	* trans-array.c (gfc_conv_resolve_dependencies): Add call to
+	gfc_are_equivalenced_arrays.
+	* symbol.c (gfc_free_equiv_infos, gfc_free_equiv_lists): New
+	functions. (gfc_free_namespace): Call them.
+	* trans-common.c (copy_equiv_list_to_ns): New function.
+	(add_equivalences): Call it.
+	* gfortran.h: Add equiv_lists to gfc_namespace and define
+	gfc_equiv_list and gfc_equiv_info.
+	* dependency.c (gfc_are_equivalenced_arrays): New function.
+	(gfc_check_dependency): Call it.
+	* dependency.h: Prototype for gfc_are_equivalenced_arrays.
+
 2006-03-01  Roger Sayle  <roger@eyesopen.com>
 
 	* dependency.c (gfc_is_same_range): Compare the stride, lower and
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 96da3c31e4..f764873 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -359,6 +359,51 @@ gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
 }
 
 
+/* Return 1 if e1 and e2 are equivalenced arrays, either
+   directly or indirectly; ie. equivalence (a,b) for a and b
+   or equivalence (a,c),(b,c).  This function uses the equiv_
+   lists, generated in trans-common(add_equivalences), that are
+   guaranteed to pick up indirect equivalences.  A rudimentary
+   use is made of the offset to ensure that cases where the
+   source elements are moved down to the destination are not
+   identified as dependencies.  */
+
+int
+gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
+{
+  gfc_equiv_list *l;
+  gfc_equiv_info *s, *fl1, *fl2;
+
+  gcc_assert (e1->expr_type == EXPR_VARIABLE
+		&& e2->expr_type == EXPR_VARIABLE);
+
+  if (!e1->symtree->n.sym->attr.in_equivalence
+	|| !e2->symtree->n.sym->attr.in_equivalence
+	|| !e1->rank
+	|| !e2->rank)
+    return 0;
+
+  /* Go through the equiv_lists and return 1 if the variables
+     e1 and e2 are members of the same group and satisfy the
+     requirement on their relative offsets.  */
+  for (l = gfc_current_ns->equiv_lists; l; l = l->next)
+    {
+      fl1 = NULL;
+      fl2 = NULL;
+      for (s = l->equiv; s; s = s->next)
+	{
+	  if (s->sym == e1->symtree->n.sym)
+	    fl1 = s;
+	  if (s->sym == e2->symtree->n.sym)
+	    fl2 = s;
+	  if (fl1 && fl2 && (fl1->offset > fl2->offset))
+	    return 1;
+	}
+    }
+return 0;
+}
+
+
 /* Return true if the statement body redefines the condition.  Returns
    true if expr2 depends on expr1.  expr1 should be a single term
    suitable for the lhs of an assignment.  The IDENTICAL flag indicates
@@ -405,6 +450,10 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
 	    return 1;
 	}
 
+      /* Return 1 if expr1 and expr2 are equivalenced arrays.  */
+      if (gfc_are_equivalenced_arrays (expr1, expr2))
+	return 1;
+
       if (expr1->symtree->n.sym != expr2->symtree->n.sym)
 	return 0;
 
diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
index 9862958..3851ca2 100644
--- a/gcc/fortran/dependency.h
+++ b/gcc/fortran/dependency.h
@@ -30,3 +30,4 @@ int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
 int gfc_expr_is_one (gfc_expr *, int);
 
 int gfc_dep_resolver(gfc_ref *, gfc_ref *);
+int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 17e9777..99b9865 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -950,6 +950,10 @@ typedef struct gfc_namespace
 
   /* Points to the equivalences set up in this namespace.  */
   struct gfc_equiv *equiv;
+
+  /* Points to the equivalence groups produced by trans_common.  */
+  struct gfc_equiv_list *equiv_lists;
+
   gfc_interface *operator[GFC_INTRINSIC_OPS];
 
   /* Points to the parent namespace, i.e. the namespace of a module or
@@ -1343,6 +1347,20 @@ gfc_equiv;
 
 #define gfc_get_equiv() gfc_getmem(sizeof(gfc_equiv))
 
+/* Holds a single equivalence member after processing.  */
+typedef struct gfc_equiv_info
+{
+  gfc_symbol *sym;
+  HOST_WIDE_INT offset;
+  struct gfc_equiv_info *next;
+} gfc_equiv_info;
+
+/* Holds equivalence groups, after they have been processed.  */
+typedef struct gfc_equiv_list
+{
+  gfc_equiv_info *equiv;
+  struct gfc_equiv_list *next;
+} gfc_equiv_list;
 
 /* gfc_case stores the selector list of a case statement.  The *low
    and *high pointers can point to the same expression in the case of
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index e154a34..f961c77 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -549,21 +549,13 @@ gfc_resolve_dot_product (gfc_expr * f, gfc_expr * a, gfc_expr * b)
 {
   gfc_expr temp;
 
-  if (a->ts.type == BT_LOGICAL && b->ts.type == BT_LOGICAL)
-    {
-      f->ts.type = BT_LOGICAL;
-      f->ts.kind = gfc_default_logical_kind;
-    }
-  else
-    {
-      temp.expr_type = EXPR_OP;
-      gfc_clear_ts (&temp.ts);
-      temp.value.op.operator = INTRINSIC_NONE;
-      temp.value.op.op1 = a;
-      temp.value.op.op2 = b;
-      gfc_type_convert_binary (&temp);
-      f->ts = temp.ts;
-    }
+  temp.expr_type = EXPR_OP;
+  gfc_clear_ts (&temp.ts);
+  temp.value.op.operator = INTRINSIC_NONE;
+  temp.value.op.op1 = a;
+  temp.value.op.op2 = b;
+  gfc_type_convert_binary (&temp);
+  f->ts = temp.ts;
 
   f->value.function.name =
     gfc_get_string (PREFIX("dot_product_%c%d"), gfc_type_letter (f->ts.type),
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 45c7d25..285c276 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2424,6 +2424,31 @@ gfc_free_dt_list (gfc_dt_list * dt)
 }
 
 
+/* Free the gfc_equiv_info's.  */
+
+static void
+gfc_free_equiv_infos (gfc_equiv_info * s)
+{
+  if (s == NULL)
+    return;
+  gfc_free_equiv_infos (s->next);
+  gfc_free (s);
+}
+
+
+/* Free the gfc_equiv_lists.  */
+
+static void
+gfc_free_equiv_lists (gfc_equiv_list * l)
+{
+  if (l == NULL)
+    return;
+  gfc_free_equiv_lists (l->next);
+  gfc_free_equiv_infos (l->equiv);
+  gfc_free (l);
+}
+
+
 /* Free a namespace structure and everything below it.  Interface
    lists associated with intrinsic operators are not freed.  These are
    taken care of when a specific name is freed.  */
@@ -2459,6 +2484,7 @@ gfc_free_namespace (gfc_namespace * ns)
   free_st_labels (ns->st_labels);
 
   gfc_free_equiv (ns->equiv);
+  gfc_free_equiv_lists (ns->equiv_lists);
 
   gfc_free_dt_list (ns->derived_types);
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5e8238b..5e4405e 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2581,7 +2581,8 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
       if (ss->type != GFC_SS_SECTION)
 	continue;
 
-      if (gfc_could_be_alias (dest, ss))
+      if (gfc_could_be_alias (dest, ss)
+	    || gfc_are_equivalenced_arrays (dest->expr, ss->expr))
 	{
 	  nDepend = 1;
 	  break;
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 5d72a50..3b34b334 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -122,6 +122,7 @@ typedef struct segment_info
 static segment_info * current_segment;
 static gfc_namespace *gfc_common_ns = NULL;
 
+
 /* Make a segment_info based on a symbol.  */
 
 static segment_info *
@@ -144,6 +145,34 @@ get_segment_info (gfc_symbol * sym, HOST_WIDE_INT offset)
   return s;
 }
 
+
+/* Add a copy of a segment list to the namespace.  This is specifically for
+   equivalence segments, so that dependency checking can be done on
+   equivalence group members.  */
+
+static void
+copy_equiv_list_to_ns (segment_info *c)
+{
+  segment_info *f;
+  gfc_equiv_info *s;
+  gfc_equiv_list *l;
+
+  l = (gfc_equiv_list *) gfc_getmem (sizeof (gfc_equiv_list));
+
+  l->next = c->sym->ns->equiv_lists;
+  c->sym->ns->equiv_lists = l;
+
+  for (f = c; f; f = f->next)
+    {
+      s = (gfc_equiv_info *) gfc_getmem (sizeof (gfc_equiv_info));
+      s->next = l->equiv;
+      l->equiv = s;
+      s->sym = f->sym;
+      s->offset = f->offset;
+    }
+}
+
+
 /* Add combine segment V and segment LIST.  */
 
 static segment_info *
@@ -787,6 +816,9 @@ add_equivalences (bool *saw_equiv)
 	    }
 	}
     }
+
+  /* Add a copy of this segment list to the namespace.  */
+  copy_equiv_list_to_ns (current_segment);
 }
 
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 65f99c1..47911ff 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -846,7 +846,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   tree length = NULL_TREE;
   int byref;
 
-  gcc_assert (sym->attr.referenced);
+  gcc_assert (sym->attr.referenced
+               || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY);
 
   if (sym->ns && sym->ns->proc_name->attr.function)
     byref = gfc_return_by_reference (sym->ns->proc_name);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index f58a596..39ac939 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1561,6 +1561,104 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, int op)
   se->expr = resvar;
 }
 
+
+/* Inline implementation of the dot_product intrinsic. This function
+   is based on gfc_conv_intrinsic_arith (the previous function).  */
+static void
+gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
+{
+  tree resvar;
+  tree type;
+  stmtblock_t body;
+  stmtblock_t block;
+  tree tmp;
+  gfc_loopinfo loop;
+  gfc_actual_arglist *actual;
+  gfc_ss *arrayss1, *arrayss2;
+  gfc_se arrayse1, arrayse2;
+  gfc_expr *arrayexpr1, *arrayexpr2;
+
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  /* Initialize the result.  */
+  resvar = gfc_create_var (type, "val");
+  if (expr->ts.type == BT_LOGICAL)
+    tmp = convert (type, integer_zero_node);
+  else
+    tmp = gfc_build_const (type, integer_zero_node);
+
+  gfc_add_modify_expr (&se->pre, resvar, tmp);
+
+  /* Walk argument #1.  */
+  actual = expr->value.function.actual;
+  arrayexpr1 = actual->expr;
+  arrayss1 = gfc_walk_expr (arrayexpr1);
+  gcc_assert (arrayss1 != gfc_ss_terminator);
+
+  /* Walk argument #2.  */
+  actual = actual->next;
+  arrayexpr2 = actual->expr;
+  arrayss2 = gfc_walk_expr (arrayexpr2);
+  gcc_assert (arrayss2 != gfc_ss_terminator);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, arrayss1);
+  gfc_add_ss_to_loop (&loop, arrayss2);
+
+  /* Initialize the loop.  */
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop);
+
+  gfc_mark_ss_chain_used (arrayss1, 1);
+  gfc_mark_ss_chain_used (arrayss2, 1);
+
+  /* Generate the loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+  gfc_init_block (&block);
+
+  /* Make the tree expression for [conjg(]array1[)].  */
+  gfc_init_se (&arrayse1, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse1, &loop);
+  arrayse1.ss = arrayss1;
+  gfc_conv_expr_val (&arrayse1, arrayexpr1);
+  if (expr->ts.type == BT_COMPLEX)
+    arrayse1.expr = build1 (CONJ_EXPR, type, arrayse1.expr);
+  gfc_add_block_to_block (&block, &arrayse1.pre);
+
+  /* Make the tree expression for array2.  */
+  gfc_init_se (&arrayse2, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse2, &loop);
+  arrayse2.ss = arrayss2;
+  gfc_conv_expr_val (&arrayse2, arrayexpr2);
+  gfc_add_block_to_block (&block, &arrayse2.pre);
+
+  /* Do the actual product and sum.  */
+  if (expr->ts.type == BT_LOGICAL)
+    {
+      tmp = build2 (TRUTH_AND_EXPR, type, arrayse1.expr, arrayse2.expr);
+      tmp = build2 (TRUTH_OR_EXPR, type, resvar, tmp);
+    }
+  else
+    {
+      tmp = build2 (MULT_EXPR, type, arrayse1.expr, arrayse2.expr);
+      tmp = build2 (PLUS_EXPR, type, resvar, tmp);
+    }
+  gfc_add_modify_expr (&block, resvar, tmp);
+
+  /* Finish up the loop block and the loop.  */
+  tmp = gfc_finish_block (&block);
+  gfc_add_expr_to_block (&body, tmp);
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+  gfc_add_block_to_block (&se->pre, &loop.pre);
+  gfc_add_block_to_block (&se->pre, &loop.post);
+  gfc_cleanup_loop (&loop);
+
+  se->expr = resvar;
+}
+
+
 static void
 gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
 {
@@ -3135,6 +3233,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_dim (se, expr);
       break;
 
+    case GFC_ISYM_DOT_PRODUCT:
+      gfc_conv_intrinsic_dot_product (se, expr);
+      break;
+
     case GFC_ISYM_DPROD:
       gfc_conv_intrinsic_dprod (se, expr);
       break;
@@ -3304,7 +3406,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_CHDIR:
-    case GFC_ISYM_DOT_PRODUCT:
     case GFC_ISYM_ETIME:
     case GFC_ISYM_FGET:
     case GFC_ISYM_FGETC:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index eb29008..26c178b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,17 @@
+2006-03-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	* gfortran.dg/logical_dot_product.f90: New test. 
+
+	PR fortran/26393
+	* gfortran.dg/used_interface_ref.f90: New test.
+
+	PR fortran/20938
+	* gfortran.dg/dependency_2.f90: New test.
+	* gfortran.fortran-torture/execute/where17.f90: New test.
+	* gfortran.fortran-torture/execute/where18.f90: New test.
+	* gfortran.fortran-torture/execute/where19.f90: New test.
+	* gfortran.fortran-torture/execute/where20.f90: New test.
+
 2006-03-01  Daniel Berlin  <dberlin@dberlin.org>
 
 	* g++.dg/tree-ssa/pr26443.C: New test case.
diff --git a/gcc/testsuite/gfortran.dg/dependency_2.f90 b/gcc/testsuite/gfortran.dg/dependency_2.f90
new file mode 100644
index 0000000..1cbdec7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Tests the fix for PR20938 in which dependencies between equivalenced 
+! arrays were not detected.
+! 
+real, dimension (3) :: a = (/1., 2., 3./), b, c
+equivalence (a(2), b), (a(1), c)
+b = a;
+if (any(b .ne. (/1., 2., 3./))) call abort ()
+b = c
+if (any(b .ne. (/1., 1., 2./))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/logical_dot_product.f90 b/gcc/testsuite/gfortran.dg/logical_dot_product.f90
new file mode 100644
index 0000000..e35595c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_dot_product.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Checks the LOGICAL version of dot_product
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+   logical :: l1(4) = (/.TRUE.,.FALSE.,.TRUE.,.FALSE./)
+   logical :: l2(4) = (/.FALSE.,.TRUE.,.FALSE.,.TRUE./)
+   if (dot_product (l1, l2)) call abort ()
+   l2 = .TRUE.
+   if (.not.dot_product (l1, l2)) call abort ()
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/used_interface_ref.f90 b/gcc/testsuite/gfortran.dg/used_interface_ref.f90
new file mode 100644
index 0000000..d4a9c96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_interface_ref.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! Tests the fix for PR26393, in which an ICE would occur in trans-decl.c
+! (gfc_get_symbol_decl) because anzKomponenten is not referenced in the
+! interface for solveCConvert. The solution was to assert that the symbol
+! is either referenced or in an interface body.
+!
+! Based on the testcase in the PR.
+!
+  MODULE MODULE_CONC
+    INTEGER, SAVE :: anzKomponenten = 2
+  END MODULE MODULE_CONC
+
+  MODULE MODULE_THERMOCALC
+    INTERFACE
+      FUNCTION solveCConvert ()
+        USE MODULE_CONC, ONLY: anzKomponenten
+        REAL :: solveCConvert(1:anzKomponenten)
+        END FUNCTION solveCConvert
+    END INTERFACE
+  END MODULE MODULE_THERMOCALC
+
+  SUBROUTINE outDiffKoeff
+    USE MODULE_CONC
+    USE MODULE_THERMOCALC
+    REAL :: buffer_conc(1:anzKomponenten)
+    buffer_conc = solveCConvert ()
+    if (any(buffer_conc .ne. (/(real(i), i = 1, anzKomponenten)/))) &
+          call abort ()
+  END SUBROUTINE outDiffKoeff
+
+  program missing_ref
+    USE MODULE_CONC
+    call outDiffKoeff
+! Now set anzKomponenten to a value that would cause a segfault if
+! buffer_conc and solveCConvert did not have the correct allocation
+! of memory.
+    anzKomponenten = 5000
+    call outDiffKoeff
+  end program missing_ref
+ 
+  FUNCTION solveCConvert ()
+    USE MODULE_CONC, ONLY: anzKomponenten
+    REAL :: solveCConvert(1:anzKomponenten)
+    solveCConvert = (/(real(i), i = 1, anzKomponenten)/)
+  END FUNCTION solveCConvert
+   
+
+
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where17.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where17.f90
new file mode 100644
index 0000000..b4323ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/where17.f90
@@ -0,0 +1,15 @@
+! Check to ensure only the first true clause in WHERE is
+! executed.
+program where_17
+   integer :: a(3)
+
+   a = (/1, 2, 3/)
+   where (a .eq. 1)
+     a = 2
+   elsewhere (a .le. 2)
+     a = 3
+   elsewhere (a .le. 3)
+     a = 4
+   endwhere
+   if (any (a .ne. (/2, 3, 4/))) call abort
+end program
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where18.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where18.f90
new file mode 100644
index 0000000..4036464
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/where18.f90
@@ -0,0 +1,26 @@
+! Check to ensure mask is calculated first in WHERE
+! statements.
+program where_18
+   integer :: a(4)
+   integer :: b(3)
+   integer :: c(3)
+   equivalence (a(1), b(1)), (a(2), c(1))
+
+   a = (/1, 1, 1, 1/)
+   where (b .eq. 1)
+     c = 2
+   elsewhere (b .eq. 2)
+     c = 3
+   endwhere
+   if (any (a .ne. (/1, 2, 2, 2/))) &
+     call abort
+
+   a = (/1, 1, 1, 1/)
+   where (c .eq. 1)
+     b = 2
+   elsewhere (b .eq. 2)
+     b = 3
+   endwhere
+   if (any (a .ne. (/2, 2, 2, 1/))) &
+     call abort
+end program
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where19.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where19.f90
new file mode 100644
index 0000000..3c41b89
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/where19.f90
@@ -0,0 +1,23 @@
+! Check to ensure result is calculated from unmodified
+! version of the right-hand-side in WHERE statements.
+program where_19
+   integer :: a(4)
+   integer :: b(3)
+   integer :: c(3)
+   equivalence (a(1), b(1)), (a(2), c(1))
+
+   a = (/1, 2, 3, 4/)
+   where (b .gt. 1)
+     c = b
+   endwhere
+   if (any (a .ne. (/1, 2, 2, 3/))) &
+     call abort ()
+
+   a = (/1, 2, 3, 4/)
+   where (c .gt. 1)
+     b = c
+   endwhere
+   if (any (a .ne. (/2, 3, 4, 4/))) &
+     call abort ()
+end program
+
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where20.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where20.f90
new file mode 100644
index 0000000..b045650
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/where20.f90
@@ -0,0 +1,54 @@
+! Test the dependency checking in simple where. This
+! did not work and was fixed as part of the patch for
+! pr24519.
+!
+program where_20
+   integer :: a(4)
+   integer :: b(3)
+   integer :: c(3)
+   integer :: d(3) = (/1, 2, 3/)
+   equivalence (a(1), b(1)), (a(2), c(1))
+
+! This classic case worked before the patch.
+   a = (/1, 2, 3, 4/)
+   where (b .gt. 1) a(2:4) = a(1:3)
+   if (any(a .ne. (/1,2,2,3/))) call abort ()
+
+! This is the original manifestation of the problem
+! and is repeated in where_19.f90.
+   a = (/1, 2, 3, 4/)
+   where (b .gt. 1)
+     c = b
+   endwhere
+   if (any(a .ne. (/1,2,2,3/))) call abort ()
+
+! Mask to.destination dependency.
+   a = (/1, 2, 3, 4/)
+   where (b .gt. 1)
+     c = d
+   endwhere
+   if (any(a .ne. (/1,2,2,3/))) call abort ()
+
+! Source to.destination dependency.
+   a = (/1, 2, 3, 4/)
+   where (d .gt. 1)
+     c = b
+   endwhere
+   if (any(a .ne. (/1,2,2,3/))) call abort ()
+
+! Check the simple where.
+   a = (/1, 2, 3, 4/)
+   where (b .gt. 1) c = b
+   if (any(a .ne. (/1,2,2,3/))) call abort ()
+
+! This was OK before the patch.
+   a = (/1, 2, 3, 4/)
+   where (b .gt. 1)
+     where (d .gt. 1)
+       c = b
+     end where
+   endwhere
+   if (any(a .ne. (/1,2,2,3/))) call abort ()
+
+end program
+