[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
This commit is contained in:
parent
f6cf5b85ea
commit
3f92c93b3c
@ -1,3 +1,29 @@
|
||||
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
|
||||
|
@ -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;
|
||||
|
||||
---------------------
|
||||
|
@ -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
|
||||
|
@ -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:
|
||||
|
||||
|
@ -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,
|
||||
|
@ -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.
|
||||
|
Loading…
Reference in New Issue
Block a user