[PATCH] Fix inconsistent CFG out of DOM1

[Eric Botcazou <ebotcazou at adacore dot com>]

Hi,

The attached testcase triggers a CFG verification failure after DOM1:

eric@linux:~/build/gcc/native32> gcc -S -gnata -O2 -fno-inline p.adb
p.adb: In function 'P.Interface_Ancestor_Tags':
p.adb:14: error: BB 31 can not throw but has EH edges
+===========================GNAT BUG DETECTED==============================+
| 4.4.0 20080515 (experimental) [trunk revision 135325] (i586-suse-linux-gnu) 
GCC error:|
| verify_flow_info failed                                                  |
| Error detected around p.adb:14        

BB31 is a forwarder block made by thread_through_loop_header ouf of BB15 and 
we have in the DOM1 log:

Optimizing block #15

Optimizing statement p__interface_ancestor_tags__B_2__TTtableSP1___U.7_47 = 
iface_table_6->nb_ifaces;
  Replaced redundant expr 'iface_table_6->nb_ifaces' with 
'p__interface_ancestor_tags__B_2__TTtableSP1___U.7_42'
  Flagged to clear EH edges.


The problem is that, while BB31 inherits everything from BB15, it doesn't 
inherit the "flagged to clear EH edges" property, hence the failure.

The proposed fix is to include the newly created blocks in the set of blocks 
needing EH cleanup after DOM.  Tested on i586-suse-linux, OK for mainline?


2008-05-18  Eric Botcazou  <ebotcazou@adacore.com>

	* tree-ssa-dom.c (tree_ssa_dominator_optimize): If some blocks need
	EH cleanup at the end of the pass, also include the blocks created by
	jump threading in this set.


2008-05-18  Eric Botcazou  <ebotcazou@adacore.com>

        * gnat.dg/loop_optimization2.ad[sb]: New test.


-- 
Eric Botcazou

Index: tree-ssa-dom.c
===================================================================
--- tree-ssa-dom.c	(revision 135302)
+++ tree-ssa-dom.c	(working copy)
@@ -242,6 +242,7 @@ static unsigned int
 tree_ssa_dominator_optimize (void)
 {
   struct dom_walk_data walk_data;
+  int new_basic_block;
   unsigned int i;
 
   memset (&opt_stats, 0, sizeof (opt_stats));
@@ -310,6 +311,7 @@ tree_ssa_dominator_optimize (void)
   free_all_edge_infos ();
 
   /* Thread jumps, creating duplicate blocks as needed.  */
+  new_basic_block = last_basic_block;
   cfg_altered |= thread_through_all_blocks (first_pass_instance);
 
   if (cfg_altered)
@@ -319,6 +321,10 @@ tree_ssa_dominator_optimize (void)
      such edges from the CFG as needed.  */
   if (!bitmap_empty_p (need_eh_cleanup))
     {
+      /* Jump threading may have created forwarder blocks from blocks
+	 needing EH cleanup; these new blocks need the same cleanup.  */
+      for (; new_basic_block < last_basic_block; new_basic_block++)
+	bitmap_set_bit (need_eh_cleanup, new_basic_block);
       tree_purge_all_dead_eh_edges (need_eh_cleanup);
       bitmap_zero (need_eh_cleanup);
     }

with System;

package P is

   type Prim_Ptr is access procedure;
   type Address_Array is array (Positive range <>) of Prim_Ptr;

   subtype Dispatch_Table is Address_Array (1 .. 1);

   type Tag is access all Dispatch_Table;

   type Tag_Array is array (Positive range <>) of Tag;

   function Interface_Ancestor_Tags (T : Tag) return Tag_Array;

   type Interface_Data_Element is record
      Iface_Tag : Tag;
   end record;

   type Interfaces_Array is array (Natural range <>) of Interface_Data_Element;

   type Interface_Data (Nb_Ifaces : Positive) is record
      Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces);
   end record;

   type Interface_Data_Ptr is access all Interface_Data;

   type Type_Specific_Data (Idepth : Natural) is record
      Interfaces_Table : Interface_Data_Ptr;
   end record;

   type Type_Specific_Data_Ptr is access all Type_Specific_Data;
   pragma No_Strict_Aliasing (Type_Specific_Data_Ptr);

   subtype Predef_Prims_Table is Address_Array (1 .. 16);
   type Predef_Prims_Table_Ptr is access Predef_Prims_Table;

   type Addr_Ptr is access System.Address;
   pragma No_Strict_Aliasing (Addr_Ptr);

end P;

with Ada.Unchecked_Conversion;

package body P is

   function To_Addr_Ptr is
      new Ada.Unchecked_Conversion (System.Address, Addr_Ptr);

   function To_Address is
     new Ada.Unchecked_Conversion (Tag, System.Address);

   function To_Type_Specific_Data_Ptr is
     new Ada.Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);

   function Interface_Ancestor_Tags (T : Tag) return Tag_Array is
      TSD_Ptr : constant Addr_Ptr := To_Addr_Ptr (To_Address (T));
      TSD : constant Type_Specific_Data_Ptr :=
                      To_Type_Specific_Data_Ptr (TSD_Ptr.all);
      Iface_Table : constant Interface_Data_Ptr := TSD.Interfaces_Table;
   begin
      if Iface_Table = null then
         declare
            Table : Tag_Array (1 .. 0);
         begin
            return Table;
         end;
      else
         declare
            Table : Tag_Array (1 .. Iface_Table.Nb_Ifaces);
         begin
            for J in 1 .. Iface_Table.Nb_Ifaces loop
               Table (J) := Iface_Table.Ifaces_Table (J).Iface_Tag;
            end loop;
            return Table;
         end;
      end if;
   end Interface_Ancestor_Tags;

end P;