diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-10-24 09:24:35 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-10-24 09:24:35 +0000 |
commit | 962950088da94ff758ba6d5d2dae162da592fc79 (patch) | |
tree | 1dc5fccd16a43a4b60f37dbb9057544ac4505cce /gcc | |
parent | 84c0d8e8d58c14a8d5d95335a591bc4b3c03ef97 (diff) | |
download | gcc-962950088da94ff758ba6d5d2dae162da592fc79.tar.gz |
2011-10-24 Vasiliy Fofanov <fofanov@adacore.com>
* gnat_ugn.texi: Document explicit use of XDECGNAT library.
2011-10-24 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch3.adb (Build_Assignment): Add local constant N_Loc and
update its uses.
(Build_Discriminant_Assignments): Add local variable D_Loc and update
its uses.
(Build_Init_Statements): Add local variables Comp_Loc, Decl_Loc and
Var_Loc and update their uses.
(Build_Record_Init_Proc): Code reformatting.
(Increment_Counter): Add formal parameter Loc.
(Make_Counter): Add formal parameter Loc.
2011-10-24 Eric Botcazou <ebotcazou@adacore.com>
* sem_disp.adb (Covers_Some_Interface): Fix typo.
2011-10-24 Matthew Heaney <heaney@adacore.com>
* a-cuprqu.adb, a-cbprqu.adb (Dequeue_Only_High_Priority):
Predicate had wrong sense.
2011-10-24 Yannick Moy <moy@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications/Aspect_Test_Case):
Translate arguments in positional notation into pragma argument
association arguments for the generated pragma.
2011-10-24 Arnaud Charlet <charlet@adacore.com>
* exp_ch5.adb: Fix minor typo.
2011-10-24 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Is_Visible_Component): Refine predicate for
the case of a component reference in an instance body, when the
enclosing type is private.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180369 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 41 | ||||
-rw-r--r-- | gcc/ada/a-cbprqu.adb | 25 | ||||
-rw-r--r-- | gcc/ada/a-cuprqu.adb | 23 | ||||
-rw-r--r-- | gcc/ada/exp_ch3.adb | 122 | ||||
-rw-r--r-- | gcc/ada/exp_ch5.adb | 2 | ||||
-rw-r--r-- | gcc/ada/gnat_ugn.texi | 7 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 36 | ||||
-rw-r--r-- | gcc/ada/sem_disp.adb | 2 |
9 files changed, 194 insertions, 69 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 297470c39fd..6eec150a7e2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,44 @@ +2011-10-24 Vasiliy Fofanov <fofanov@adacore.com> + + * gnat_ugn.texi: Document explicit use of XDECGNAT library. + +2011-10-24 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch3.adb (Build_Assignment): Add local constant N_Loc and + update its uses. + (Build_Discriminant_Assignments): Add local variable D_Loc and update + its uses. + (Build_Init_Statements): Add local variables Comp_Loc, Decl_Loc and + Var_Loc and update their uses. + (Build_Record_Init_Proc): Code reformatting. + (Increment_Counter): Add formal parameter Loc. + (Make_Counter): Add formal parameter Loc. + +2011-10-24 Eric Botcazou <ebotcazou@adacore.com> + + * sem_disp.adb (Covers_Some_Interface): Fix typo. + +2011-10-24 Matthew Heaney <heaney@adacore.com> + + * a-cuprqu.adb, a-cbprqu.adb (Dequeue_Only_High_Priority): + Predicate had wrong sense. + +2011-10-24 Yannick Moy <moy@adacore.com> + + * sem_ch13.adb (Analyze_Aspect_Specifications/Aspect_Test_Case): + Translate arguments in positional notation into pragma argument + association arguments for the generated pragma. + +2011-10-24 Arnaud Charlet <charlet@adacore.com> + + * exp_ch5.adb: Fix minor typo. + +2011-10-24 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Is_Visible_Component): Refine predicate for + the case of a component reference in an instance body, when the + enclosing type is private. + 2011-10-24 Sergey Rybin <rybin@adacore.com frybin> * gnat_ugn.texi: For gnatelim, move the note about using the GNAT diff --git a/gcc/ada/a-cbprqu.adb b/gcc/ada/a-cbprqu.adb index cb96167be41..ce2fd69fae7 100644 --- a/gcc/ada/a-cbprqu.adb +++ b/gcc/ada/a-cbprqu.adb @@ -51,8 +51,31 @@ package body Ada.Containers.Bounded_Priority_Queues is Success : out Boolean) is begin + -- This operation dequeues a high priority item if it exists in the + -- queue. By "high priority" we mean an item whose priority is equal + -- or greater than the value At_Least. The generic formal operation + -- Before has the meaning "has higher priority than". To dequeue an + -- item (meaning that we return True as our Success value), we need + -- as our predicate the equivalent of "has equal or higher priority + -- than", but we cannot say that directly, so we require some logical + -- gymnastics to make it so. + + -- If E is the element at the head of the queue, and symbol ">" + -- refers to the "is higher priority than" function Before, then we + -- derive our predicate as follows: + + -- original: P(E) >= At_Least + -- same as: not (P(E) < At_Least) + -- same as: not (At_Least > P(E)) + -- same as: not Before (At_Least, P(E)) + + -- But that predicate needs to be true in order to successfully + -- dequeue an item. If it's false, it means no item is dequeued, and + -- we return False as the Success value. + if List.Length = 0 - or else not Before (At_Least, Get_Priority (List.First_Element)) + or else Before (At_Least, + Get_Priority (List.Container.First_Element)) then Success := False; return; diff --git a/gcc/ada/a-cuprqu.adb b/gcc/ada/a-cuprqu.adb index 385aa5ce7d2..4f6966dc136 100644 --- a/gcc/ada/a-cuprqu.adb +++ b/gcc/ada/a-cuprqu.adb @@ -72,8 +72,29 @@ package body Ada.Containers.Unbounded_Priority_Queues is Success : out Boolean) is begin + -- This operation dequeues a high priority item if it exists in the + -- queue. By "high priority" we mean an item whose priority is equal + -- or greater than the value At_Least. The generic formal operation + -- Before has the meaning "has higher priority than". To dequeue an + -- item (meaning that we return True as our Success value), we need + -- as our predicate the equivalent of "has equal or higher priority + -- than", but we cannot say that directly, so we require some logical + -- gymnastics to make it so. + + -- If E is the element at the head of the queue, and symbol ">" + -- refers to the "is higher priority than" function Before, then we + -- derive our predicate as follows: + -- original: P(E) >= At_Least + -- same as: not (P(E) < At_Least) + -- same as: not (At_Least > P(E)) + -- same as: not Before (At_Least, P(E)) + + -- But that predicate needs to be true in order to successfully + -- dequeue an item. If it's false, it means no item is dequeued, and + -- we return False as the Success value. + if List.Length = 0 - or else not Before (At_Least, Get_Priority (List.First.Element)) + or else Before (At_Least, Get_Priority (List.First.Element)) then Success := False; return; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 5f413e31bd3..15547232491 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1538,13 +1538,13 @@ package body Exp_Ch3 is ---------------------------- procedure Build_Record_Init_Proc (N : Node_Id; Rec_Ent : Entity_Id) is - Decls : constant List_Id := New_List; - Discr_Map : constant Elist_Id := New_Elmt_List; - Counter : Int := 0; - Loc : Source_Ptr := Sloc (N); - Proc_Id : Entity_Id; - Rec_Type : Entity_Id; - Set_Tag : Entity_Id := Empty; + Decls : constant List_Id := New_List; + Discr_Map : constant Elist_Id := New_Elmt_List; + Loc : constant Source_Ptr := Sloc (Rec_Ent); + Counter : Int := 0; + Proc_Id : Entity_Id; + Rec_Type : Entity_Id; + Set_Tag : Entity_Id := Empty; function Build_Assignment (Id : Entity_Id; N : Node_Id) return List_Id; -- Build an assignment statement which assigns the default expression @@ -1621,18 +1621,18 @@ package body Exp_Ch3 is ---------------------- function Build_Assignment (Id : Entity_Id; N : Node_Id) return List_Id is - Typ : constant Entity_Id := Underlying_Type (Etype (Id)); - Exp : Node_Id := N; - Kind : Node_Kind := Nkind (N); - Lhs : Node_Id; - Res : List_Id; + N_Loc : constant Source_Ptr := Sloc (N); + Typ : constant Entity_Id := Underlying_Type (Etype (Id)); + Exp : Node_Id := N; + Kind : Node_Kind := Nkind (N); + Lhs : Node_Id; + Res : List_Id; begin - Loc := Sloc (N); Lhs := - Make_Selected_Component (Loc, + Make_Selected_Component (N_Loc, Prefix => Make_Identifier (Loc, Name_uInit), - Selector_Name => New_Occurrence_Of (Id, Loc)); + Selector_Name => New_Occurrence_Of (Id, N_Loc)); Set_Assignment_OK (Lhs); -- Case of an access attribute applied to the current instance. @@ -1653,9 +1653,9 @@ package body Exp_Ch3 is and then Entity (Prefix (N)) = Rec_Type then Exp := - Make_Attribute_Reference (Loc, + Make_Attribute_Reference (N_Loc, Prefix => - Make_Identifier (Loc, Name_uInit), + Make_Identifier (N_Loc, Name_uInit), Attribute_Name => Name_Unrestricted_Access); end if; @@ -1681,13 +1681,13 @@ package body Exp_Ch3 is and then Tagged_Type_Expansion then Append_To (Res, - Make_Assignment_Statement (Loc, + Make_Assignment_Statement (N_Loc, Name => - Make_Selected_Component (Loc, + Make_Selected_Component (N_Loc, Prefix => New_Copy_Tree (Lhs, New_Scope => Proc_Id), Selector_Name => - New_Reference_To (First_Tag_Component (Typ), Loc)), + New_Reference_To (First_Tag_Component (Typ), N_Loc)), Expression => Unchecked_Convert_To (RTE (RE_Tag), @@ -1695,7 +1695,7 @@ package body Exp_Ch3 is (Node (First_Elmt (Access_Disp_Table (Underlying_Type (Typ)))), - Loc)))); + N_Loc)))); end if; -- Adjust the component if controlled except if it is an aggregate @@ -1729,6 +1729,7 @@ package body Exp_Ch3 is procedure Build_Discriminant_Assignments (Statement_List : List_Id) is Is_Tagged : constant Boolean := Is_Tagged_Type (Rec_Type); D : Entity_Id; + D_Loc : Source_Ptr; begin if Has_Discriminants (Rec_Type) @@ -1748,10 +1749,10 @@ package body Exp_Ch3 is null; else - Loc := Sloc (D); + D_Loc := Sloc (D); Append_List_To (Statement_List, Build_Assignment (D, - New_Reference_To (Discriminal (D), Loc))); + New_Reference_To (Discriminal (D), D_Loc))); end if; Next_Discriminant (D); @@ -2458,6 +2459,7 @@ package body Exp_Ch3 is function Build_Init_Statements (Comp_List : Node_Id) return List_Id is Checks : constant List_Id := New_List; Actions : List_Id := No_List; + Comp_Loc : Source_Ptr; Counter_Id : Entity_Id := Empty; Decl : Node_Id; Has_POC : Boolean; @@ -2466,11 +2468,11 @@ package body Exp_Ch3 is Stmts : List_Id; Typ : Entity_Id; - procedure Increment_Counter; + procedure Increment_Counter (Loc : Source_Ptr); -- Generate an "increment by one" statement for the current counter -- and append it to the list Stmts. - procedure Make_Counter; + procedure Make_Counter (Loc : Source_Ptr); -- Create a new counter for the current component list. The routine -- creates a new defining Id, adds an object declaration and sets -- the Id generator for the next variant. @@ -2479,7 +2481,7 @@ package body Exp_Ch3 is -- Increment_Counter -- ----------------------- - procedure Increment_Counter is + procedure Increment_Counter (Loc : Source_Ptr) is begin -- Generate: -- Counter := Counter + 1; @@ -2497,7 +2499,7 @@ package body Exp_Ch3 is -- Make_Counter -- ------------------ - procedure Make_Counter is + procedure Make_Counter (Loc : Source_Ptr) is begin -- Increment the Id generator @@ -2582,11 +2584,11 @@ package body Exp_Ch3 is Decl := First_Non_Pragma (Component_Items (Comp_List)); while Present (Decl) loop - Loc := Sloc (Decl); + Comp_Loc := Sloc (Decl); Build_Record_Checks (Subtype_Indication (Component_Definition (Decl)), Checks); - Id := Defining_Identifier (Decl); + Id := Defining_Identifier (Decl); Typ := Etype (Id); -- Leave any processing of per-object constrained component for @@ -2606,12 +2608,13 @@ package body Exp_Ch3 is if Is_CPP_Constructor_Call (Expression (Decl)) then Actions := Build_Initialization_Call - (Loc, + (Comp_Loc, Id_Ref => - Make_Selected_Component (Loc, + Make_Selected_Component (Comp_Loc, Prefix => - Make_Identifier (Loc, Name_uInit), - Selector_Name => New_Occurrence_Of (Id, Loc)), + Make_Identifier (Comp_Loc, Name_uInit), + Selector_Name => + New_Occurrence_Of (Id, Comp_Loc)), Typ => Typ, In_Init_Proc => True, Enclos_Type => Rec_Type, @@ -2628,10 +2631,11 @@ package body Exp_Ch3 is then Actions := Build_Initialization_Call - (Loc, - Make_Selected_Component (Loc, - Prefix => Make_Identifier (Loc, Name_uInit), - Selector_Name => New_Occurrence_Of (Id, Loc)), + (Comp_Loc, + Make_Selected_Component (Comp_Loc, + Prefix => + Make_Identifier (Comp_Loc, Name_uInit), + Selector_Name => New_Occurrence_Of (Id, Comp_Loc)), Typ, In_Init_Proc => True, Enclos_Type => Rec_Type, @@ -2665,10 +2669,10 @@ package body Exp_Ch3 is and then Needs_Finalization (Typ) then if No (Counter_Id) then - Make_Counter; + Make_Counter (Comp_Loc); end if; - Increment_Counter; + Increment_Counter (Comp_Loc); end if; end if; end if; @@ -2724,6 +2728,7 @@ package body Exp_Ch3 is Corresponding_Concurrent_Type (Rec_Type); Task_Decl : constant Node_Id := Parent (Task_Type); Task_Def : constant Node_Id := Task_Definition (Task_Decl); + Decl_Loc : Source_Ptr; Ent : Entity_Id; Vis_Decl : Node_Id; @@ -2731,7 +2736,7 @@ package body Exp_Ch3 is if Present (Task_Def) then Vis_Decl := First (Visible_Declarations (Task_Def)); while Present (Vis_Decl) loop - Loc := Sloc (Vis_Decl); + Decl_Loc := Sloc (Vis_Decl); if Nkind (Vis_Decl) = N_Attribute_Definition_Clause then if Get_Attribute_Id (Chars (Vis_Decl)) = @@ -2741,18 +2746,19 @@ package body Exp_Ch3 is if Ekind (Ent) = E_Entry then Append_To (Stmts, - Make_Procedure_Call_Statement (Loc, + Make_Procedure_Call_Statement (Decl_Loc, Name => New_Reference_To (RTE ( - RE_Bind_Interrupt_To_Entry), Loc), + RE_Bind_Interrupt_To_Entry), Decl_Loc), Parameter_Associations => New_List ( - Make_Selected_Component (Loc, + Make_Selected_Component (Decl_Loc, Prefix => - Make_Identifier (Loc, Name_uInit), + Make_Identifier (Decl_Loc, Name_uInit), Selector_Name => - Make_Identifier (Loc, Name_uTask_Id)), + Make_Identifier + (Decl_Loc, Name_uTask_Id)), Entry_Index_Expression - (Loc, Ent, Empty, Task_Type), + (Decl_Loc, Ent, Empty, Task_Type), Expression (Vis_Decl)))); end if; end if; @@ -2789,7 +2795,7 @@ package body Exp_Ch3 is if Has_POC then Decl := First_Non_Pragma (Component_Items (Comp_List)); while Present (Decl) loop - Loc := Sloc (Decl); + Comp_Loc := Sloc (Decl); Id := Defining_Identifier (Decl); Typ := Etype (Id); @@ -2798,10 +2804,11 @@ package body Exp_Ch3 is then if Has_Non_Null_Base_Init_Proc (Typ) then Append_List_To (Stmts, - Build_Initialization_Call (Loc, - Make_Selected_Component (Loc, - Prefix => Make_Identifier (Loc, Name_uInit), - Selector_Name => New_Occurrence_Of (Id, Loc)), + Build_Initialization_Call (Comp_Loc, + Make_Selected_Component (Comp_Loc, + Prefix => + Make_Identifier (Comp_Loc, Name_uInit), + Selector_Name => New_Occurrence_Of (Id, Comp_Loc)), Typ, In_Init_Proc => True, Enclos_Type => Rec_Type, @@ -2814,10 +2821,10 @@ package body Exp_Ch3 is if Needs_Finalization (Typ) then if No (Counter_Id) then - Make_Counter; + Make_Counter (Comp_Loc); end if; - Increment_Counter; + Increment_Counter (Comp_Loc); end if; elsif Component_Needs_Simple_Initialization (Typ) then @@ -2836,15 +2843,16 @@ package body Exp_Ch3 is if Present (Variant_Part (Comp_List)) then declare Variant_Alts : constant List_Id := New_List; + Var_Loc : Source_Ptr; Variant : Node_Id; begin Variant := First_Non_Pragma (Variants (Variant_Part (Comp_List))); while Present (Variant) loop - Loc := Sloc (Variant); + Var_Loc := Sloc (Variant); Append_To (Variant_Alts, - Make_Case_Statement_Alternative (Loc, + Make_Case_Statement_Alternative (Var_Loc, Discrete_Choices => New_Copy_List (Discrete_Choices (Variant)), Statements => @@ -2857,10 +2865,10 @@ package body Exp_Ch3 is -- formal parameter of the initialization procedure. Append_To (Stmts, - Make_Case_Statement (Loc, + Make_Case_Statement (Var_Loc, Expression => New_Reference_To (Discriminal ( - Entity (Name (Variant_Part (Comp_List)))), Loc), + Entity (Name (Variant_Part (Comp_List)))), Var_Loc), Alternatives => Variant_Alts)); end; end if; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 8d487727009..971d0ad65d2 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3460,7 +3460,7 @@ package body Exp_Ch5 is End_Label => End_Label (N))); -- The loop parameter's entity must be removed from the loop - -- scope's entity list, since itw will now be located in the + -- scope's entity list, since it will now be located in the -- new block scope. Any other entities already associated with -- the loop scope, such as the loop parameter's subtype, will -- remain there. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 377eb75bd1a..abf8093a8ed 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21143,6 +21143,13 @@ On OpenVMS Alpha, HP Ada provides the following strongly-typed bindings: GNAT provides implementations of these HP bindings in the @code{DECLIB} directory, on both the Alpha and I64 OpenVMS platforms. +The X components of DECLIB compatibility package are located in a separate +library, called XDECGNAT, which is not linked with by default; this library +must be explicitly linked with any application that makes use of any X facilities, +with a command similar to + +@code{GNAT MAKE USE_X /LINK /LIBRARY=XDECGNAT} + The X/Motif bindings used to build @code{DECLIB} are whatever versions are in the HP Ada @file{ADA$PREDEFINED} directory with extension @file{.ADC}. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 5790b9a85a0..d30ba09635d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1403,7 +1403,10 @@ package body Sem_Ch13 is Comp_Expr := First (Expressions (Expr)); while Present (Comp_Expr) loop - Append (Relocate_Node (Comp_Expr), Args); + Append + (Make_Pragma_Argument_Association (Sloc (Comp_Expr), + Expression => Relocate_Node (Comp_Expr)), + Args); Next (Comp_Expr); end loop; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 98169b276d1..98a032f425d 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -16178,13 +16178,6 @@ package body Sem_Ch3 is elsif not Comes_From_Source (Original_Comp) then return True; - -- If we are in the body of an instantiation, the component is visible - -- even when the parent type (possibly defined in an enclosing unit or - -- in a parent unit) might not. - - elsif In_Instance_Body then - return True; - -- Discriminants are always visible elsif Ekind (Original_Comp) = E_Discriminant @@ -16192,6 +16185,35 @@ package body Sem_Ch3 is then return True; + -- If we are in the body of an instantiation, the component is visible + -- if the parent type is non-private, or in an enclosing scope. The + -- scope stack is not present when analyzing an instance body, so we + -- must inspect the chain of scopes explicitly. + + elsif In_Instance_Body then + if not Is_Private_Type (Scope (C)) then + return True; + + else + declare + S : Entity_Id; + + begin + S := Current_Scope; + while Present (S) + and then S /= Standard_Standard + loop + if S = Type_Scope then + return True; + end if; + + S := Scope (S); + end loop; + + return False; + end; + end if; + -- If the component has been declared in an ancestor which is currently -- a private type, then it is not visible. The same applies if the -- component's containing type is not in an open scope and the original diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 2d80676791c..c4dd8ede6ba 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -160,7 +160,7 @@ package body Sem_Disp is while Present (Elmt) loop Iface_Prim := Node (Elmt); - if Chars (E) = Chars (Prim) + if Chars (Iface) = Chars (Prim) and then Is_Interface_Conformant (Tagged_Type, Iface_Prim, Prim) then |