[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:
Arnaud Charlet 2009-07-09 12:29:09 +02:00
parent f6cf5b85ea
commit 3f92c93b3c
6 changed files with 116 additions and 31 deletions

View File

@ -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

View File

@ -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;
---------------------

View File

@ -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

View File

@ -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:

View File

@ -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,

View File

@ -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.