re PR middle-end/64246 (ICE building libada for Windows due to NULL loop header)

2014-12-15  Richard Biener  <rguenther@suse.de>

	PR middle-end/64246
	* cfgloop.c (mark_loop_for_removal): Make safe against multiple
	invocations on the same loop.

	* gnat.dg/opt46.adb: New testcase.
	* gnat.dg/opt46.ads: Likewise.
	* gnat.dg/opt46_pkg.adb: Likewise.
	* gnat.dg/opt46_pkg.ads: Likewise.

From-SVN: r218746

gcc/ChangeLog

@@ -1,3 +1,9 @@
+2014-12-15  Richard Biener  <rguenther@suse.de>
+
+	PR middle-end/64246
+	* cfgloop.c (mark_loop_for_removal): Make safe against multiple
+	invocations on the same loop.
+
 2014-12-15  Marek Polacek  <polacek@redhat.com>
 
 	PR middle-end/64292

gcc/cfgloop.c

@@ -1928,9 +1928,10 @@ bb_loop_depth (const_basic_block bb)
 void
 mark_loop_for_removal (loop_p loop)
 {
+  if (loop->header == NULL)
+    return;
   loop->former_header = loop->header;
   loop->header = NULL;
   loop->latch = NULL;
   loops_state_set (LOOPS_NEED_FIXUP);
 }
-

gcc/testsuite/ChangeLog

@@ -1,3 +1,11 @@
+2014-12-15  Richard Biener  <rguenther@suse.de>
+
+	PR middle-end/64246
+	* gnat.dg/opt46.adb: New testcase.
+	* gnat.dg/opt46.ads: Likewise.
+	* gnat.dg/opt46_pkg.adb: Likewise.
+	* gnat.dg/opt46_pkg.ads: Likewise.
+
 2014-12-15  Jakub Jelinek  <jakub@redhat.com>
 
 	PR target/64210

gcc/testsuite/gnat.dg/opt46.adb

@@ -0,0 +1,45 @@
+-- { dg-do compile }
+-- { dg-options "-O" }
+
+with Ada.Unchecked_Deallocation;
+
+with Opt46_Pkg;
+
+package body Opt46 is
+
+   type Pattern is abstract tagged null record;
+
+   type Pattern_Access is access Pattern'Class;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Pattern'Class, Pattern_Access);
+
+   type Action is abstract tagged null record;
+
+   type Action_Access is access Action'Class;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Action'Class, Action_Access);
+
+   type Pattern_Action is record
+      Pattern : Pattern_Access;
+      Action  : Action_Access;
+   end record;
+
+   package Pattern_Action_Table is new Opt46_Pkg (Pattern_Action, Natural, 1);
+
+   type Session_Data is record
+      Filters : Pattern_Action_Table.Instance;
+   end record;
+
+   procedure Close (Session : Session_Type) is
+      Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
+   begin
+      for F in 1 .. Pattern_Action_Table.Last (Filters) loop
+         Free (Filters.Table (F).Pattern);
+         Free (Filters.Table (F).Action);
+      end loop;
+
+   end Close;
+
+end Opt46;

gcc/testsuite/gnat.dg/opt46.ads

@@ -0,0 +1,16 @@
+package Opt46 is
+
+   type Session_Type is limited private;
+
+   procedure Close (Session : Session_Type);
+
+private
+
+   type Session_Data;
+   type Session_Data_Access is access Session_Data;
+
+   type Session_Type is record
+      Data : Session_Data_Access;
+   end record;
+
+end Opt46;

gcc/testsuite/gnat.dg/opt46_pkg.adb

@@ -0,0 +1,8 @@
+package body Opt46_Pkg is
+
+   function Last (T : Instance) return Table_Index_Type is
+   begin
+      return Table_Index_Type (T.P.Last_Val);
+   end Last;
+
+end Opt46_Pkg;

gcc/testsuite/gnat.dg/opt46_pkg.ads

@@ -0,0 +1,31 @@
+generic
+   type Table_Component_Type is private;
+   type Table_Index_Type     is range <>;
+
+   Table_Low_Bound : Table_Index_Type;
+
+package Opt46_Pkg is
+
+   type Table_Type is
+     array (Table_Index_Type range <>) of Table_Component_Type;
+   subtype Big_Table_Type is
+     Table_Type (Table_Low_Bound .. Table_Index_Type'Last);
+
+   type Table_Ptr is access all Big_Table_Type;
+
+   type Table_Private is private;
+
+   type Instance is record
+      Table : aliased Table_Ptr := null;
+      P : Table_Private;
+   end record;
+
+   function Last (T : Instance) return Table_Index_Type;
+
+private
+
+   type Table_Private is record
+      Last_Val : Integer;
+   end record;
+
+end Opt46_Pkg;