[Ada] Fix null dereference in loop at -O or above

[Eric Botcazou <ebotcazou at adacore dot com>]

This fixes a crash at run time caused by a dereference of the null pointer.
The problem is that we put both TREE_READONLY and TREE_THIS_NOTRAP on the 
INDIRECT_REF built to access the bounds of fat pointer types.  While this 
fine if it is later instantiated for an unconstrained array, this isn't if it 
is later instantiated for a pointer to unconstrained array, as the pointer 
can be null and LIM will hoist everything out of loops, removing any guard 
before the dereference in the process.  So the conservative fix is not to put 
TREE_THIS_NOTRAP at all.

Tested on i586-suse-linux, applied on the mainline.


2010-10-25  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Do not set
	TREE_THIS_NOTRAP on the INDIRECT_REF node built for the template.


2010-10-25  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/loop_optimization8.adb: New test.
	* gnat.dg/loop_optimization8_pkg1.ad[sb]: New helper.
	* gnat.dg/loop_optimization8_pkg2.ad[sb]: Likewise.


-- 
Eric Botcazou

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 165914)
+++ gcc-interface/decl.c	(working copy)
@@ -1942,7 +1942,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	gnu_template_reference
 	  = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
 	TREE_READONLY (gnu_template_reference) = 1;
-	TREE_THIS_NOTRAP (gnu_template_reference) = 1;
 
 	/* Now create the GCC type for each index and add the fields for that
 	   index to the template.  */

-- { dg-do run }
-- { dg-options "-O -gnatn" }

with Loop_Optimization8_Pkg1;

procedure Loop_Optimization8 is

  Data : Loop_Optimization8_Pkg1.T;

  procedure Check_1 (N : in Natural) is
  begin
     if N /= 0 then
       for I in 1 .. Data.Last loop
         declare
           F : constant Natural := Data.Elements (I);
         begin
           if F = N then
              raise Program_Error;
           end if;
         end;
       end loop;
     end if;
  end;

  procedure Check is new Loop_Optimization8_Pkg1.Iter (Check_1);

begin
  Data := Loop_Optimization8_Pkg1.Empty;
  Check;
end;

with Ada.Finalization;

package Loop_Optimization8_Pkg1 is

  type Array_T is array (Positive range <>) of Natural;

  type Array_Access_T is access Array_T;

  type T is new Ada.Finalization.Controlled with record
    Last : Natural := 0;
    Elements : Array_Access_T;
  end record;

  Empty : T := (Ada.Finalization.Controlled with Last => 0, Elements => null);

  generic
    with procedure Action (Info : Natural);
  procedure Iter;

end Loop_Optimization8_Pkg1;

package body Loop_Optimization8_Pkg2 is

  function Length (Set : T) return Natural is
  begin
    return Set.Length;
  end Length;

  function Index (Set : T; Position : Natural) return Integer is
  begin
    return Set.Elements (Position);
  end Index;

end Loop_Optimization8_Pkg2;

with Loop_Optimization8_Pkg2;

package body Loop_Optimization8_Pkg1 is

  Data : Loop_Optimization8_Pkg2.T
    := new Loop_Optimization8_Pkg2.Obj_T'(Length =>1, Elements => (1 => 1));

  procedure Iter is
  begin
    for I in 1 .. Loop_Optimization8_Pkg2.Length (Data) loop
      Action (Loop_Optimization8_Pkg2.Index (Data, I));
    end loop;
  end;

end Loop_Optimization8_Pkg1;

package Loop_Optimization8_Pkg2 is

  type Array_T is array (Natural range <>) of Integer;

  type Obj_T (Length : Natural) is
    record
      Elements : Array_T (1 .. Length);
    end record;

  type T is access Obj_T;

  function Length (Set : T) return Natural;
  function Index (Set : T; Position : Natural) return Integer;
  pragma Inline (Length, Index);

end Loop_Optimization8_Pkg2;