[Ada] Propagate the TYPE_REF_CAN_ALIAS_ALL flag

[Eric Botcazou <ebotcazou at adacore dot com>]

When Gigi is simplifying <ADDR_EXPR<INDIRECT_REF>>, it may not propagate the 
TYPE_REF_CAN_ALIAS_ALL flag.  Since the simplification is to return the 
original pointer, the flag needs to be propagated.

I've attached a small example demonstrating this with an address clause.

Bootstrapped/regtested on i586-suse-linux, applied on the mainline.


2007-09-22  Eric Botcazou  <ebotcazou@adacore.com>

	* utils2.c (build_unary_op) <ADDR_EXPR> [INDIRECT_REF]: Propagate
	the TYPE_REF_CAN_ALIAS_ALL flag to the result.


-- 
Eric Botcazou

Index: utils2.c
===================================================================
--- utils2.c	(revision 128602)
+++ utils2.c	(working copy)
@@ -1078,6 +1078,25 @@ build_unary_op (enum tree_code op_code, 
 	     GCC wants pointer types for function addresses.  */
 	  if (!result_type)
 	    result_type = build_pointer_type (type);
+
+	  /* If the underlying object can alias everything, propagate the
+	     property since we are effectively retrieving the object.  */
+	  if (POINTER_TYPE_P (TREE_TYPE (result))
+	      && TYPE_REF_CAN_ALIAS_ALL (TREE_TYPE (result)))
+	    {
+	      if (TREE_CODE (result_type) == POINTER_TYPE
+		  && !TYPE_REF_CAN_ALIAS_ALL (result_type))
+		result_type
+		  = build_pointer_type_for_mode (TREE_TYPE (result_type),
+						 TYPE_MODE (result_type),
+						 true);
+	      else if (TREE_CODE (result_type) == REFERENCE_TYPE
+		       && !TYPE_REF_CAN_ALIAS_ALL (result_type))
+	        result_type
+		  = build_reference_type_for_mode (TREE_TYPE (result_type),
+						   TYPE_MODE (result_type),
+						   true);
+	    }
 	  break;
 
 	case NULL_EXPR:

package q is

   type byte is mod 256;
   Temp_buffer : array (0..8) of byte:= (others => 0);

   subtype Id is Short_integer;

   generic
      Dummy : Integer := 0;
   package Bit_Map_Generic is

      type List is private;
      function "xor" (L, R : List) return List;

   private
      type Offset_T is range 0 .. Id'Last;
      type Counter_T is new short_integer;
      for Counter_T'Size use 16;

      type Bit_List is array (Id range <>) of Boolean;
      pragma Pack (Bit_List);

      type List_Counter_T (Is_Defined : Boolean := True) is
         record
            Dummy : Boolean := False;
            case Is_Defined is
               when True =>
                  Counter : Counter_T := 0;
               when False =>
                  null;
            end case;
         end record;
      for List_Counter_T use
         record
            Is_Defined at 0 range 0 .. 7;
            Dummy at 1 range 0 .. 7;
            Counter at 2 range 0 .. 15;
         end record;

      type List is
         record
            Offset : Offset_T := Offset_T (1) - 1;
            Counter : List_Counter_T;
            Bits : Bit_List (1 .. 6);
         end record;
      for List use
         record
            Offset at 0 range 0 .. 15;
            Counter at 2 range 0 .. 31;
         end record;

      type Iterator is
         record
            No_More_Id : Boolean := True;
            Current_Id : Id;
            The_List : List;
         end record;

   end Bit_Map_Generic;

end q;

package body q is

   package body Bit_Map_Generic is

      function "xor" (L, R : List) return List is
         Temp : List;
         for Temp'address use Temp_buffer'address;
      begin
         Temp.Bits := L.Bits xor R.Bits;
         Temp.Counter.Counter := 0;
         return Temp;
      end;

   end Bit_Map_Generic;

end q;

with q; use q;

procedure p is

    package Role_Map is new Bit_Map_Generic;

    type Role_List is new Role_Map.List;
    Roles_1 : Role_List;
    Roles_2 : Role_List;
    Roles_3 : Role_List;

begin
   Temp_Buffer(2) := (0);
   Roles_1 := Roles_2 xor Roles_3;
end p;