postreload-gcse.c (bb_has_well_behaved_predecessors): Tweak criterion used for abnormal egdes.

	* postreload-gcse.c (bb_has_well_behaved_predecessors): Tweak criterion
	used for abnormal egdes.

From-SVN: r239858

6 files changed, 165 insertions, 1 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index f9f9169..6d1cabe 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,8 @@
+2016-08-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* postreload-gcse.c (bb_has_well_behaved_predecessors): Tweak criterion
+	used for abnormal egdes.
+
 2016-08-30  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/72866
diff --git a/gcc/postreload-gcse.c b/gcc/postreload-gcse.c
index 566e875..da04fb7 100644
--- a/gcc/postreload-gcse.c
+++ b/gcc/postreload-gcse.c
@@ -962,7 +962,9 @@ bb_has_well_behaved_predecessors (basic_block bb)
 
   FOR_EACH_EDGE (pred, ei, bb->preds)
     {
-      if ((pred->flags & EDGE_ABNORMAL) && EDGE_CRITICAL_P (pred))
+      /* commit_one_edge_insertion refuses to insert on abnormal edges even if
+	 the source has only one successor so EDGE_CRITICAL_P is too weak.  */
+      if ((pred->flags & EDGE_ABNORMAL) && !single_pred_p (pred->dest))
 	return false;
 
       if ((pred->flags & EDGE_ABNORMAL_CALL) && cfun->has_nonlocal_label)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 613753e9..ffd4491 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-08-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/opt57.ad[sb]: New test.
+	* gnat.dg/opt57_pkg.ads: New helper.
+
 2016-08-30  Richard Biener  <rguenther@suse.de>
 
 	PR tree-optimization/69047
diff --git a/gcc/testsuite/gnat.dg/opt57.adb b/gcc/testsuite/gnat.dg/opt57.adb
new file mode 100644
index 0000000..f532f09
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt57.adb
@@ -0,0 +1,89 @@
+package body Opt57 is
+
+   type Phase_Enum is (None_Phase, FE_Init_Phase, FE_Phase);
+
+   type Message_State is (No_Messages, Some_Messages);
+
+   type Module_List_Array is array (Phase_Enum, Message_State) of List;
+
+   type Private_Module_Factory is limited record
+      Module_Lists : Module_List_Array;
+   end record;
+
+   type Element_Array is array (Positive range <>) of Module_Factory_Ptr;
+
+   type Hash_Table is array (Positive range <>) of aliased Module_Factory_Ptr;
+
+   type Heap_Data_Rec (Table_Last : Positive) is limited record
+      Number_Of_Elements : Positive;
+      Table              : Hash_Table (1 .. Table_Last);
+   end record;
+
+   type Heap_Data_Ptr is access Heap_Data_Rec;
+
+   type Table is limited record
+      Data : Heap_Data_Ptr;
+   end record;
+
+   function All_Elements (M : Table) return Element_Array is
+      Result : Element_Array (1 .. Natural (M.Data.Number_Of_Elements));
+      Last   : Natural := 0;
+   begin
+      for H in M.Data.Table'Range loop
+         Last := Last + 1;
+         Result (Last) := M.Data.Table(H);
+      end loop;
+      return Result;
+   end;
+
+   The_Factories : Table;
+
+   subtype Language_Array is Element_Array;
+   type Language_Array_Ptr is access Language_Array;
+   All_Languages : Language_Array_Ptr := null;
+
+   procedure Init is
+   begin
+      if All_Languages = null then
+         All_Languages := new Language_Array'(All_Elements (The_Factories));
+      end if;
+   end;
+
+   function Is_Empty (L : List) return Boolean is
+   begin
+      return Link_Constant (L.Next) = L'Unchecked_Access;
+   end;
+
+   function First (L : List) return Linkable_Ptr is
+   begin
+      return Links_Type (L.Next.all).Container.all'Access;
+   end;
+
+   procedure Update is
+      Check_New_Dependences : Boolean := False;
+   begin
+      loop
+         for Lang_Index in All_Languages'Range loop
+            for Has_Messages in Message_State loop
+               declare
+                  L : List renames
+                    All_Languages (Lang_Index).Priv.Module_Lists
+                      (FE_Init_Phase, Has_Messages);
+               begin
+                  while not Is_Empty (L) loop
+                     declare
+                        Module_In_Init_State : constant Module_Ptr :=
+                          Module_Ptr (First (L));
+                        Pin_Dependence : Pinned (Module_In_Init_State);
+                     begin
+                        Check_New_Dependences := True;
+                     end;
+                  end loop;
+               end;
+            end loop;
+         end loop;
+         exit when not Check_New_Dependences;
+      end loop;
+   end;
+
+end Opt57;
diff --git a/gcc/testsuite/gnat.dg/opt57.ads b/gcc/testsuite/gnat.dg/opt57.ads
new file mode 100644
index 0000000..1bee799
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt57.ads
@@ -0,0 +1,50 @@
+-- { dg-do compile }
+-- { dg-options "-O3" }
+
+with Ada.Finalization; use Ada.Finalization;
+with Opt57_Pkg; use Opt57_Pkg;
+
+package Opt57 is
+
+   procedure Update;
+
+   procedure Init;
+
+   type Module_Factory is abstract new Limited_Controlled with private;
+
+   type Root_Module_Rec (Language : access Module_Factory'Class)
+   is abstract new GC_Pool with null record;
+
+   type List is tagged limited private;
+   type Linkable is abstract new Root_Module_Rec with private;
+   type Linkable_Ptr is access all Linkable'Class;
+
+private
+
+   type Link is access all List'Class;
+   type Link_Constant is access constant List'Class;
+   type List is tagged limited record
+      Next : Link;
+   end record;
+
+   type Links_Type (Container : access Linkable) is new List with null record;
+
+   type Linkable is abstract new Root_Module_Rec with record
+      On_List : Link_Constant;
+      Links   : aliased Links_Type (Linkable'Access);
+   end record;
+
+   type Module_Rec (Language : access Module_Factory'Class)
+   is abstract new Linkable (Language) with null record;
+   type Module_Ptr is access all Module_Rec'Class;
+
+   type Private_Module_Factory;
+   type Private_Module_Factory_Ptr is access Private_Module_Factory;
+
+   type Module_Factory is abstract new Limited_Controlled with record
+      Priv : Private_Module_Factory_Ptr;
+   end record;
+
+   type Module_Factory_Ptr is access all Module_Factory'Class;
+
+end Opt57;
diff --git a/gcc/testsuite/gnat.dg/opt57_pkg.ads b/gcc/testsuite/gnat.dg/opt57_pkg.ads
new file mode 100644
index 0000000..9d2a9b6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt57_pkg.ads
@@ -0,0 +1,13 @@
+with System.Storage_Pools; use System.Storage_Pools;
+
+with Ada.Finalization; use Ada.Finalization;
+
+package Opt57_Pkg is
+
+   type GC_Pool is abstract new Root_Storage_Pool with null record;
+
+   type Pinned (Pool : access GC_Pool'Class) is new Controlled with null record;
+
+   procedure Finalize (X : in out Pinned);
+
+end Opt57_Pkg;