+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
-- --
-- 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- --
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.
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);
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
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:
OSDN Git Service
