* tree-cfg.c (call_can_make_abnormal_goto): New predicate.

	(stmt_can_make_abnormal_goto): Use it.
	(is_ctrl_altering_stmt): Likewise.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@186047 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index d043b8f..0ec4ecd 100644 (file)
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,9 @@
+2012-03-31  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * tree-cfg.c (call_can_make_abnormal_goto): New predicate.
+       (stmt_can_make_abnormal_goto): Use it.
+       (is_ctrl_altering_stmt): Likewise.
+
 2012-03-30  Naveen H.S  <naveen.S@kpitcummins.com>
            Kaz Kojima  <kkojima@gcc.gnu.org>
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 921f2fa..e2fa4a6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2012-03-31  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/controlled6.adb: New test.
+       * gnat.dg/controlled6_pkg.ads: New helper.
+       * gnat.dg/controlled6_pkg-iterators.ad[sb]: Likewise.
+
 2012-03-30  Richard Henderson <rth@redhat.com>
 
        PR debug/52727

diff --git a/gcc/testsuite/gnat.dg/controlled6.adb b/gcc/testsuite/gnat.dg/controlled6.adb
new file mode 100644 (file)
index 0000000..88640de
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/controlled6.adb
@@ -0,0 +1,24 @@
+-- { dg-do compile }
+-- { dg-options "-O -gnatn" }
+
+with Ada.Text_IO; use Ada.Text_IO;
+with Controlled6_Pkg;
+with Controlled6_Pkg.Iterators;
+
+procedure Controlled6 is
+
+   type String_Access is access String;
+
+   package My_Q is new Controlled6_Pkg (String_Access);
+   package My_Iterators is new My_Q.Iterators (0);
+   use My_Iterators;
+
+   Iterator : Iterator_Type := Find;
+
+begin
+   loop
+      exit when Is_Null (Iterator);
+      Put (Current (Iterator).all & ' ');
+      Find_Next (Iterator);
+   end loop;
+end;

diff --git a/gcc/testsuite/gnat.dg/controlled6_pkg-iterators.adb b/gcc/testsuite/gnat.dg/controlled6_pkg-iterators.adb
new file mode 100644 (file)
index 0000000..201a75c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/controlled6_pkg-iterators.adb
@@ -0,0 +1,21 @@
+package body Controlled6_Pkg.Iterators is
+
+   function Find return Iterator_Type is
+      Iterator : Iterator_Type;
+   begin
+      return Iterator;
+   end Find;
+
+   function Current (Iterator : in Iterator_Type) return T is begin
+      return Iterator.Current.Item;
+   end Current;
+
+   procedure Find_Next (Iterator : in out Iterator_Type) is begin
+      Iterator.Current := null;
+   end Find_Next;
+
+   function Is_Null (Iterator : in Iterator_Type) return Boolean is begin
+      return Iterator.Current = null;
+   end Is_Null;
+
+end Controlled6_Pkg.Iterators;

diff --git a/gcc/testsuite/gnat.dg/controlled6_pkg-iterators.ads b/gcc/testsuite/gnat.dg/controlled6_pkg-iterators.ads
new file mode 100644 (file)
index 0000000..89330f6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/controlled6_pkg-iterators.ads
@@ -0,0 +1,22 @@
+with Ada.Finalization;
+
+generic
+
+   I : Integer;
+
+package Controlled6_Pkg.Iterators is
+
+   type Iterator_Type is new Ada.Finalization.Controlled with record
+      Current : Node_Access_Type;
+   end record;
+
+   function Find return Iterator_Type;
+
+   function Current (Iterator : in Iterator_Type) return T;
+   pragma Inline (Current);
+
+   procedure Find_Next (Iterator : in out Iterator_Type);
+
+   function Is_Null (Iterator : in Iterator_Type) return Boolean;
+
+end Controlled6_Pkg.Iterators;

diff --git a/gcc/testsuite/gnat.dg/controlled6_pkg.ads b/gcc/testsuite/gnat.dg/controlled6_pkg.ads
new file mode 100644 (file)
index 0000000..2f1052b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/controlled6_pkg.ads
@@ -0,0 +1,15 @@
+with Ada.Finalization;
+
+generic
+
+   type T is private;
+
+package Controlled6_Pkg is
+
+   type Node_Type is record
+      Item : T;
+   end record;
+
+   type Node_Access_Type is access Node_Type;
+
+end Controlled6_Pkg;

diff --git a/gcc/tree-cfg.c b/gcc/tree-cfg.c
index eb7b62a..1f59c03 100644 (file)
--- a/gcc/tree-cfg.c
+++ b/gcc/tree-cfg.c
@@ -2273,6 +2273,43 @@ gimple_cfg2vcg (FILE *file)
                             Miscellaneous helpers
 ---------------------------------------------------------------------------*/
 
+/* Return true if T, a GIMPLE_CALL, can make an abnormal transfer of control
+   flow.  Transfers of control flow associated with EH are excluded.  */
+
+static bool
+call_can_make_abnormal_goto (gimple t)
+{
+  /* If the function has no non-local labels, then a call cannot make an
+     abnormal transfer of control.  */
+  if (!cfun->has_nonlocal_label)
+   return false;
+
+  /* Likewise if the call has no side effects.  */
+  if (!gimple_has_side_effects (t))
+    return false;
+
+  /* Likewise if the called function is leaf.  */
+  if (gimple_call_flags (t) & ECF_LEAF)
+    return false;
+
+  return true;
+}
+
+
+/* Return true if T can make an abnormal transfer of control flow.
+   Transfers of control flow associated with EH are excluded.  */
+
+bool
+stmt_can_make_abnormal_goto (gimple t)
+{
+  if (computed_goto_p (t))
+    return true;
+  if (is_gimple_call (t))
+    return call_can_make_abnormal_goto (t);
+  return false;
+}
+
+
 /* Return true if T represents a stmt that always transfers control.  */
 
 bool
@@ -2306,10 +2343,8 @@ is_ctrl_altering_stmt (gimple t)
       {
        int flags = gimple_call_flags (t);
 
-       /* A non-pure/const call alters flow control if the current
-          function has nonlocal labels.  */
-       if (!(flags & (ECF_CONST | ECF_PURE | ECF_LEAF))
-           && cfun->has_nonlocal_label)
+       /* A call alters control flow if it can make an abnormal goto.  */
+       if (call_can_make_abnormal_goto (t))
          return true;
 
        /* A call also alters control flow if it does not return.  */
@@ -2367,21 +2402,6 @@ simple_goto_p (gimple t)
 }
 
 
-/* Return true if T can make an abnormal transfer of control flow.
-   Transfers of control flow associated with EH are excluded.  */
-
-bool
-stmt_can_make_abnormal_goto (gimple t)
-{
-  if (computed_goto_p (t))
-    return true;
-  if (is_gimple_call (t))
-    return (gimple_has_side_effects (t) && cfun->has_nonlocal_label
-           && !(gimple_call_flags (t) & ECF_LEAF));
-  return false;
-}
-
-
 /* Return true if STMT should start a new basic block.  PREV_STMT is
    the statement preceding STMT.  It is used when STMT is a label or a
    case label.  Labels should only start a new basic block if their