From 3f92c93b3cb05c6bf529d6bd4163b4d0e4beec57 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 9 Jul 2009 12:29:09 +0200 Subject: [PATCH] [multiple changes] 2009-07-09 Ed Schonberg * 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 * 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 * 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 | 26 ++++++++++++++ gcc/ada/checks.adb | 4 +++ gcc/ada/exp_ch11.adb | 81 ++++++++++++++++++++++++++++++++++++++++++-- gcc/ada/exp_ch4.adb | 26 -------------- gcc/ada/sem_prag.adb | 5 ++- gcc/ada/sem_util.adb | 5 +++ 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 + + * 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 + + * 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 + + * 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 * 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. -- 2.30.2