* fold-const.c (contains_label_1): Fix comments.
(contains_label_p): Do not walk trees multiple time.
From-SVN: r149037
+2009-06-28 Eric Botcazou <ebotcazou@adacore.com>
+
+ * fold-const.c (contains_label_1): Fix comments.
+ (contains_label_p): Do not walk trees multiple time.
+
2009-06-28 Paolo Bonzini <bonzini@gnu.org>
* config/i386/i386.h (enum ix86_fpcmp_strategy): New.
} /* switch (code) */
}
-/* Callback for walk_tree, looking for LABEL_EXPR.
- Returns tree TP if it is LABEL_EXPR. Otherwise it returns NULL_TREE.
- Do not check the sub-tree of GOTO_EXPR. */
+/* Callback for walk_tree, looking for LABEL_EXPR. Return *TP if it is
+ a LABEL_EXPR; otherwise return NULL_TREE. Do not check the subtrees
+ of GOTO_EXPR. */
static tree
-contains_label_1 (tree *tp,
- int *walk_subtrees,
- void *data ATTRIBUTE_UNUSED)
+contains_label_1 (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
{
switch (TREE_CODE (*tp))
{
case LABEL_EXPR:
return *tp;
+
case GOTO_EXPR:
*walk_subtrees = 0;
- /* no break */
+
+ /* ... fall through ... */
+
default:
return NULL_TREE;
}
}
-/* Checks whether the sub-tree ST contains a label LABEL_EXPR which is
- accessible from outside the sub-tree. Returns NULL_TREE if no
- addressable label is found. */
+/* Return whether the sub-tree ST contains a label which is accessible from
+ outside the sub-tree. */
static bool
contains_label_p (tree st)
{
- return (walk_tree (&st, contains_label_1 , NULL, NULL) != NULL_TREE);
+ return
+ (walk_tree_without_duplicates (&st, contains_label_1 , NULL) != NULL_TREE);
}
/* Fold a ternary expression of code CODE and type TYPE with operands
+2009-06-28 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/overflow_sum2.adb: New test
+ * gnat.dg/namet.ads: New helper.
+
+ * gnat.dg/test_overflow_sum.adb: Rename to overflow_sum.adb.
+
2009-06-28 Tobias Burnus <burnus@net-b.de>
PR fortran/34112
--- /dev/null
+package Namet is
+
+ Hash_Num : constant Integer := 2**12;
+
+ subtype Hash_Index_Type is Integer range 0 .. Hash_Num - 1;
+
+ Name_Buffer : String (1 .. 16*1024);
+
+ Name_Len : Natural;
+
+end Namet;
-- { dg-do run }
-- { dg-options "-gnato" }
-procedure test_overflow_sum is
- pragma Unsuppress (Overflow_Check);
+procedure Overflow_Sum is
+
function sum (a, b, c, d, e, f, g, h, i, j, k, l, m,
n, o, p, q, r, s, t, u, v, w, x, y, z : Integer)
return Integer
exception
when Constraint_Error => null;
end;
-end test_overflow_sum;
+end;
--- /dev/null
+-- { dg-do compile }
+-- { dg-options "-gnato" }
+
+with Namet; use Namet;
+
+function Overflow_Sum2 return Hash_Index_Type is
+
+ Even_Name_Len : Integer;
+
+begin
+
+ if Name_Len > 12 then
+ Even_Name_Len := (Name_Len) / 2 * 2;
+
+ return ((((((((((((
+ Character'Pos (Name_Buffer (01))) * 2 +
+ Character'Pos (Name_Buffer (Even_Name_Len - 10))) * 2 +
+ Character'Pos (Name_Buffer (03))) * 2 +
+ Character'Pos (Name_Buffer (Even_Name_Len - 08))) * 2 +
+ Character'Pos (Name_Buffer (05))) * 2 +
+ Character'Pos (Name_Buffer (Even_Name_Len - 06))) * 2 +
+ Character'Pos (Name_Buffer (07))) * 2 +
+ Character'Pos (Name_Buffer (Even_Name_Len - 04))) * 2 +
+ Character'Pos (Name_Buffer (09))) * 2 +
+ Character'Pos (Name_Buffer (Even_Name_Len - 02))) * 2 +
+ Character'Pos (Name_Buffer (11))) * 2 +
+ Character'Pos (Name_Buffer (Even_Name_Len))) mod Hash_Num;
+ end if;
+
+ return 0;
+
+end;