diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-04-08 06:50:51 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-04-08 06:50:51 +0000 |
commit | 57993a5368c6b04d4b89553618030a8c6dd222b5 (patch) | |
tree | 9188d82c46a135582ea73731887923f5d1dd3edb /gcc/ada/exp_pakd.adb | |
parent | 192ababb2e2bb688d93bb0854e3728a55afeed79 (diff) | |
download | ppe42-gcc-57993a5368c6b04d4b89553618030a8c6dd222b5.tar.gz ppe42-gcc-57993a5368c6b04d4b89553618030a8c6dd222b5.zip |
2008-04-08 Hristian Kirtchev <kirtchev@adacore.com>
Ed Schonberg <schonberg@adacore.com>
Robert Dewar <dewar@adacore.com>
Gary Dismukes <dismukes@adacore.com>
* exp_ch9.ads, exp_ch9.adb (Build_Protected_Entry,
Build_Unprotected_Subprogram_Body): Generate debug info for
declarations related to the handling of private data in task and
protected types.
(Debug_Private_Data_Declarations): New subprogram.
(Install_Private_Data_Declarations): Remove all debug info flagging.
This is now done by Debug_Private_Data_Declarations at the correct
stage of expansion.
(Build_Simple_Entry_Call): If the task name is a function call, expand
the prefix into an object declaration, and make the surrounding block a
task master.
(Build_Master_Entity): An internal block is a master if it wraps a call.
Code reformatting, update comments. Code clean up.
(Make_Task_Create_Call): Use 'Unrestricted_Access instead of 'Address.
(Replicate_Entry_Formals): If the formal is an access parameter or
anonymous access to subprogram, copy the original tree to create new
entities for the formals of the subprogram.
(Expand_N_Task_Type_Declaration): Create a Relative_Deadline variable
for tasks to store the value passed using pragma Relative_Deadline.
(Make_Task_Create_Call): Add the Relative_Deadline argument to the
run-time call to create a task.
(Build_Wrapper_Spec): If the controlling argument of the interface
operation is an access parameter with a non-null indicator, use the
non-null indicator on the wrapper.
* sem_ch9.adb (Analyze_Protected_Type): Only retrieve the full view when
present, which it may not be in the case where the type entity is an
incomplete view brought in by a limited with.
(Analyze_Task_Type): Only retrieve the full view when present, which it
may not be in the case where the type entity is an incomplete view
brought in by a limited with.
(Analyze_Protected_Definition): Set Is_Frozen on all itypes generated for
private components of a protected type, to prevent the generation of
freeze nodes for which there is no proper scope of elaboration.
* exp_util.ads, exp_util.adb (Remove_Side_Effects): If the expression is
a function call that returns a task, expand into a declaration to invoke
the build_in_place machinery.
(Find_Protection_Object): New routine.
(Remove_Side_Effects): Also make a copy of the value
for attributes whose result is of an elementary type.
(Silly_Boolean_Array_Not_Test): New procedure
(Silly_Boolean_Array_Xor_Test): New procedure
(Is_Volatile_Reference): New function
(Remove_Side_Effects): Use Is_Volatile_Reference
(Possible_Bit_Aligned_Component): Handle slice case properly
* exp_pakd.adb (Expand_Packed_Not): Move silly true/true or false/false
case test to Exp_Util
(Expand_Packed_Xor): Move silly true/true case test to Exp_Util
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134030 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_pakd.adb')
-rw-r--r-- | gcc/ada/exp_pakd.adb | 78 |
1 files changed, 8 insertions, 70 deletions
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 21a78ac80a4..8f191be3a36 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -1092,7 +1092,7 @@ package body Exp_Pakd is -- discriminants, so we treat it as a default/per-object expression. Set_Parent (Len_Expr, Typ); - Analyze_Per_Use_Expression (Len_Expr, Standard_Long_Long_Integer); + Preanalyze_Spec_Expression (Len_Expr, Standard_Long_Long_Integer); -- Use a modular type if possible. We can do this if we have -- static bounds, and the length is small enough, and the length @@ -1774,47 +1774,11 @@ package body Exp_Pakd is Ltyp := Etype (L); Rtyp := Etype (R); - -- First an odd and silly test. We explicitly check for the XOR - -- case where the component type is True .. True, since this will - -- raise constraint error. A special check is required since CE - -- will not be required other wise (cf Expand_Packed_Not). - - -- No such check is required for AND and OR, since for both these - -- cases False op False = False, and True op True = True. + -- Deeal with silly case of XOR where the subcomponent has a range + -- True .. True where an exception must be raised. if Nkind (N) = N_Op_Xor then - declare - CT : constant Entity_Id := Component_Type (Rtyp); - BT : constant Entity_Id := Base_Type (CT); - - begin - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_And (Loc, - Left_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (CT, Loc), - Attribute_Name => Name_First), - - Right_Opnd => - Convert_To (BT, - New_Occurrence_Of (Standard_True, Loc))), - - Right_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (CT, Loc), - Attribute_Name => Name_Last), - - Right_Opnd => - Convert_To (BT, - New_Occurrence_Of (Standard_True, Loc)))), - Reason => CE_Range_Check_Failed)); - end; + Silly_Boolean_Array_Xor_Test (N, Rtyp); end if; -- Now that that silliness is taken care of, get packed array type @@ -2186,37 +2150,11 @@ package body Exp_Pakd is Convert_To_Actual_Subtype (Opnd); Rtyp := Etype (Opnd); - -- First an odd and silly test. We explicitly check for the case - -- where the 'First of the component type is equal to the 'Last of - -- this component type, and if this is the case, we make sure that - -- constraint error is raised. The reason is that the NOT is bound - -- to cause CE in this case, and we will not otherwise catch it. + -- Deal with silly False..False and True..True subtype case - -- Believe it or not, this was reported as a bug. Note that nearly - -- always, the test will evaluate statically to False, so the code - -- will be statically removed, and no extra overhead caused. + Silly_Boolean_Array_Not_Test (N, Rtyp); - declare - CT : constant Entity_Id := Component_Type (Rtyp); - - begin - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_Eq (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (CT, Loc), - Attribute_Name => Name_First), - - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (CT, Loc), - Attribute_Name => Name_Last)), - Reason => CE_Range_Check_Failed)); - end; - - -- Now that that silliness is taken care of, get packed array type + -- Now that the silliness is taken care of, get packed array type Convert_To_PAT_Type (Opnd); PAT := Etype (Opnd); |