summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2009-07-09 12:29:09 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2009-07-09 12:29:09 +0200
commit3f92c93b3cb05c6bf529d6bd4163b4d0e4beec57 (patch)
tree9ef2c3b88ec0004f8860549feec8bccde0e38af0 /gcc
parentf6cf5b85eaeb6eecadf7010c1b99e809023a4d6d (diff)
downloadgcc-3f92c93b3cb05c6bf529d6bd4163b4d0e4beec57.tar.gz
[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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog26
-rw-r--r--gcc/ada/checks.adb4
-rw-r--r--gcc/ada/exp_ch11.adb81
-rw-r--r--gcc/ada/exp_ch4.adb26
-rw-r--r--gcc/ada/sem_prag.adb5
-rw-r--r--gcc/ada/sem_util.adb5
6 files changed, 116 insertions, 31 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 98c4161724c..e63554a1748 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index fe6ac149f1d..bf689b42548 100644
--- a/gcc/ada/checks.adb
+++ b/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;
---------------------
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 51d2f69a1b7..21f878b579a 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/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
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d25ff36d845..22179e0b588 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/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:
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index ea43c9135c4..885d1b885db 100644
--- a/gcc/ada/sem_prag.adb
+++ b/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,
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 05aadcbd995..c2706007a70 100644
--- a/gcc/ada/sem_util.adb
+++ b/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.