[multiple changes]

2009-07-09  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Precondition): Do not analyze the
	condition, to prevent generation of visible code during expansion,
	when Check is not enabled.

2009-07-09  Gary Dismukes  <dismukes@adacore.com>

	* checks.adb (Install_Static_Check): Call Possible_Local_Raise so that
	the check gets registered for any available local handler
	(Set_Local_Raise).

	* sem_util.adb: Add with and use of Exp_Ch11.
	(Apply_Compile_Time_Constraint_Error): Call Possible_Local_Raise so
	that the check gets registered for any available local handler.

	* exp_ch4.adb (Expand_N_Slice): Remove call to Enable_Range_Check
	on slice ranges.

2009-07-09  Steve Baird  <baird@adacore.com>

	* exp_ch11.adb (Force_Static_Allocation_Of_Referenced_Objects): New
	function.
	(Expand_N_Exception_Declaration): Fix handling of exceptions
	declared in a subprogram.

From-SVN: r149413

gcc/ada/ChangeLog

+2009-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma, case Precondition): Do not analyze the
+	condition, to prevent generation of visible code during expansion,
+	when Check is not enabled.
+
+2009-07-09  Gary Dismukes  <dismukes@adacore.com>
+
+	* checks.adb (Install_Static_Check): Call Possible_Local_Raise so that
+	the check gets registered for any available local handler
+	(Set_Local_Raise).
+
+	* sem_util.adb: Add with and use of Exp_Ch11.
+	(Apply_Compile_Time_Constraint_Error): Call Possible_Local_Raise so
+	that the check gets registered for any available local handler.
+
+	* exp_ch4.adb (Expand_N_Slice): Remove call to Enable_Range_Check
+	on slice ranges.
+
+2009-07-09  Steve Baird  <baird@adacore.com>
+
+	* exp_ch11.adb (Force_Static_Allocation_Of_Referenced_Objects): New
+	function.
+	(Expand_N_Exception_Declaration): Fix handling of exceptions
+	declared in a subprogram.
+
 2009-07-09  Emmanuel Briot  <briot@adacore.com>
 
 	* prj-nmsc.adb (Find_Sources): Avoid error messages from gprbuild from

gcc/ada/checks.adb

@@ -5458,6 +5458,10 @@ package body Checks is
       Set_Etype (R_Cno, Typ);
       Set_Raises_Constraint_Error (R_Cno);
       Set_Is_Static_Expression (R_Cno, Stat);
+
+      --  Now deal with possible local raise handling
+
+      Possible_Local_Raise (R_Cno, Standard_Constraint_Error);
    end Install_Static_Check;
 
    ---------------------

gcc/ada/exp_ch11.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1178,6 +1178,79 @@ package body Exp_Ch11 is
       Exname      : constant Node_Id :=
                       Make_Defining_Identifier (Loc, Name_Exname);
 
+      procedure Force_Static_Allocation_Of_Referenced_Objects
+        (Aggregate : Node_Id);
+      --  A specialized solution to one particular case of an ugly problem
+      --
+      --  The given aggregate includes an Unchecked_Conversion as one of the
+      --  component values. The call to Analyze_And_Resolve below ends up
+      --  calling Exp_Ch4.Expand_N_Unchecked_Type_Conversion, which may decide
+      --  to introduce a (constant) temporary and then obtain the component
+      --  value by evaluating the temporary.
+      --
+      --  In the case of an exception declared within a subprogram (or any
+      --  other dynamic scope), this is a bad transformation. The exception
+      --  object is marked as being Statically_Allocated but the temporary is
+      --  not. If the initial value of a Statically_Allocated declaration
+      --  references a dynamically allocated object, this prevents static
+      --  initialization of the object.
+      --
+      --  We cope with this here by marking the temporary Statically_Allocated.
+      --  It might seem cleaner to generalize this utility and then use it to
+      --  enforce a rule that the entities referenced in the declaration of any
+      --  "hoisted" (i.e., Is_Statically_Allocated and not Is_Library_Level)
+      --  entity must also be either Library_Level or hoisted. It turns out
+      --  that this would be incompatible with the current treatment of an
+      --  object which is local to a subprogram, subject to an Export pragma,
+      --  not subject to an address clause, and whose declaration contains
+      --  references to other local (non-hoisted) objects (e.g., in the initial
+      --  value expression).
+
+      ---------------------------------------------------
+      -- Force_Static_Allocation_Of_Referenced_Objects --
+      ---------------------------------------------------
+
+      procedure Force_Static_Allocation_Of_Referenced_Objects
+        (Aggregate : Node_Id)
+      is
+         function Fixup_Node (N : Node_Id) return Traverse_Result;
+         --  If the given node references a dynamically allocated object, then
+         --  correct the declaration of the object.
+
+         ----------------
+         -- Fixup_Node --
+         ----------------
+
+         function Fixup_Node (N : Node_Id) return Traverse_Result is
+         begin
+            if Nkind (N) in N_Has_Entity
+              and then Present (Entity (N))
+              and then not Is_Library_Level_Entity (Entity (N))
+
+              --  Note: the following test is not needed but it seems cleaner
+              --  to do this test (this would be more important if procedure
+              --  Force_Static_Allocation_Of_Referenced_Objects recursively
+              --  traversed the declaration of an entity after marking it as
+              --  statically allocated).
+
+              and then not Is_Statically_Allocated (Entity (N))
+            then
+               Set_Is_Statically_Allocated (Entity (N));
+            end if;
+
+            return OK;
+         end Fixup_Node;
+
+         procedure Fixup_Tree is new Traverse_Proc (Fixup_Node);
+
+      --  Start of processing for Force_Static_Allocation_Of_Referenced_Objects
+
+      begin
+         Fixup_Tree (Aggregate);
+      end Force_Static_Allocation_Of_Referenced_Objects;
+
+   --  Start of processing for Expand_N_Exception_Declaration
+
    begin
       --  There is no expansion needed when compiling for the JVM since the
       --  JVM has a built-in exception mechanism. See 4jexcept.ads for details.
@@ -1193,7 +1266,9 @@ package body Exp_Ch11 is
           Defining_Identifier => Exname,
           Constant_Present    => True,
           Object_Definition   => New_Occurrence_Of (Standard_String, Loc),
-          Expression => Make_String_Literal (Loc, Full_Qualified_Name (Id))));
+          Expression          =>
+            Make_String_Literal (Loc,
+              Strval => Full_Qualified_Name (Id))));
 
       Set_Is_Statically_Allocated (Exname);
 
@@ -1238,6 +1313,8 @@ package body Exp_Ch11 is
       Set_Expression (N, Make_Aggregate (Loc, Expressions => L));
       Analyze_And_Resolve (Expression (N), Etype (Id));
 
+      Force_Static_Allocation_Of_Referenced_Objects (Expression (N));
+
       --  Register_Exception (except'Unchecked_Access);
 
       if not No_Exception_Handlers_Set

gcc/ada/exp_ch4.adb

@@ -7448,32 +7448,6 @@ package body Exp_Ch4 is
          Make_Build_In_Place_Call_In_Anonymous_Context (Pfx);
       end if;
 
-      --  Range checks are potentially also needed for cases involving a slice
-      --  indexed by a subtype indication, but Do_Range_Check can currently
-      --  only be set for expressions ???
-
-      if not Index_Checks_Suppressed (Ptp)
-        and then (not Is_Entity_Name (Pfx)
-                   or else not Index_Checks_Suppressed (Entity (Pfx)))
-        and then Nkind (Discrete_Range (N)) /= N_Subtype_Indication
-
-         --  Do not enable range check to nodes associated with the frontend
-         --  expansion of the dispatch table. We first check if Ada.Tags is
-         --  already loaded to avoid the addition of an undesired dependence
-         --  on such run-time unit.
-
-        and then
-          (not Tagged_Type_Expansion
-            or else not
-             (RTU_Loaded (Ada_Tags)
-               and then Nkind (Prefix (N)) = N_Selected_Component
-               and then Present (Entity (Selector_Name (Prefix (N))))
-               and then Entity (Selector_Name (Prefix (N))) =
-                                  RTE_Record_Component (RE_Prims_Ptr)))
-      then
-         Enable_Range_Check (Discrete_Range (N));
-      end if;
-
       --  The remaining case to be handled is packed slices. We can leave
       --  packed slices as they are in the following situations:
 

gcc/ada/sem_prag.adb

@@ -9697,7 +9697,8 @@ package body Sem_Prag is
             --  If in spec, nothing more to do. If in body, then we convert the
             --  pragma to pragma Check (Precondition, cond [, msg]). Note we do
             --  this whether or not precondition checks are enabled. That works
-            --  fine since pragma Check will do this check.
+            --  fine since pragma Check will do this check, and will also
+            --  analyze the condition itself in the proper context.
 
             if In_Body then
                if Arg_Count = 2 then
@@ -9705,8 +9706,6 @@ package body Sem_Prag is
                   Analyze_And_Resolve (Get_Pragma_Arg (Arg2), Standard_String);
                end if;
 
-               Analyze_And_Resolve (Get_Pragma_Arg (Arg1), Standard_Boolean);
-
                Rewrite (N,
                  Make_Pragma (Loc,
                    Chars => Name_Check,

gcc/ada/sem_util.adb

@@ -29,6 +29,7 @@ with Checks;   use Checks;
 with Debug;    use Debug;
 with Errout;   use Errout;
 with Elists;   use Elists;
+with Exp_Ch11; use Exp_Ch11;
 with Exp_Disp; use Exp_Disp;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
@@ -268,6 +269,10 @@ package body Sem_Util is
       Set_Etype (N, Rtyp);
       Set_Raises_Constraint_Error (N);
 
+      --  Now deal with possible local raise handling
+
+      Possible_Local_Raise (N, Standard_Constraint_Error);
+
       --  If the original expression was marked as static, the result is
       --  still marked as static, but the Raises_Constraint_Error flag is
       --  always set so that further static evaluation is not attempted.