diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 23 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/exp_disp.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_dist.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_aux.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/sem_aux.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_cat.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 2 |
13 files changed, 85 insertions, 38 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 72cd47578e1..bd160a807e3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2013-10-14 Robert Dewar <dewar@adacore.com> + + * freeze.adb (Freeze_Record): Don't give warning about packed + and foreign convention. + +2013-10-14 Ed Schonberg <schonberg@adacore.com> + + * sem_aux.adb, sem_aux.ads (Package_Specification): New function, to + replace the less efficient idiom Specification. + (Unit_Declaration_Node (Pack_Id)), which handles library units and + child units. + * sem_ch3.adb, sem_ch10.adb, sem_prag.adb, sem_ch12.adb, sem_ch6.adb, + exp_disp.adb, sem_cat.adb, exp_dist.adb: Use Package_Specification. + +2013-10-14 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_attr.adb (Expand_Update_Attribute): Update the call to + Process_Range_Update. + (Process_Range_Update): Add new formal parameter Typ and associated + comment on usage. Add local constant Index_Typ. Add a type conversion + as part of the indexed component to ensure that the loop variable + corresponds to the index type. + 2013-10-14 Tristan Gingold <gingold@adacore.com> * a-exexpr-gcc.adb: Adjust comment. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 1a6ad572146..e039fadfda0 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -6609,12 +6609,14 @@ package body Exp_Attr is procedure Process_Range_Update (Temp : Entity_Id; Comp : Node_Id; - Expr : Node_Id); + Expr : Node_Id; + Typ : Entity_Id); -- Generate the statements necessary to update a slice of the prefix. -- The code is inserted before the attribute N. Temp denotes the entity -- of the anonymous object created to reflect the changes in values. -- Comp is range of the slice to be updated. Expr is an expression - -- yielding the new value of Comp. + -- yielding the new value of Comp. Typ is the type of the prefix of + -- attribute Update. ----------------------------------------- -- Process_Component_Or_Element_Update -- @@ -6688,10 +6690,12 @@ package body Exp_Attr is procedure Process_Range_Update (Temp : Entity_Id; Comp : Node_Id; - Expr : Node_Id) + Expr : Node_Id; + Typ : Entity_Id) is - Loc : constant Source_Ptr := Sloc (Comp); - Index : Entity_Id; + Index_Typ : constant Entity_Id := Etype (First_Index (Typ)); + Loc : constant Source_Ptr := Sloc (Comp); + Index : Entity_Id; begin -- A range update appears as @@ -6703,7 +6707,7 @@ package body Exp_Attr is -- value of Expr: -- for Index in Low .. High loop - -- Temp (Index) := Expr; + -- Temp (<Index_Typ> (Index)) := Expr; -- end loop; Index := Make_Temporary (Loc, 'I'); @@ -6722,7 +6726,8 @@ package body Exp_Attr is Name => Make_Indexed_Component (Loc, Prefix => New_Reference_To (Temp, Loc), - Expressions => New_List (New_Reference_To (Index, Loc))), + Expressions => New_List ( + Convert_To (Index_Typ, New_Reference_To (Index, Loc)))), Expression => Relocate_Node (Expr))), End_Label => Empty)); @@ -6730,10 +6735,10 @@ package body Exp_Attr is -- Local variables - Aggr : constant Node_Id := First (Expressions (N)); + Aggr : constant Node_Id := First (Expressions (N)); Loc : constant Source_Ptr := Sloc (N); - Pref : constant Node_Id := Prefix (N); - Typ : constant Entity_Id := Etype (Pref); + Pref : constant Node_Id := Prefix (N); + Typ : constant Entity_Id := Etype (Pref); Assoc : Node_Id; Comp : Node_Id; Expr : Node_Id; @@ -6763,7 +6768,7 @@ package body Exp_Attr is Expr := Expression (Assoc); while Present (Comp) loop if Nkind (Comp) = N_Range then - Process_Range_Update (Temp, Comp, Expr); + Process_Range_Update (Temp, Comp, Expr, Typ); else Process_Component_Or_Element_Update (Temp, Comp, Expr, Typ); end if; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 7490e9df7bf..c2cbc25c20c 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -7645,7 +7645,7 @@ package body Exp_Disp is end if; return List_Containing (Parent (Typ)) = - Visible_Declarations (Specification (Unit_Declaration_Node (Scop))); + Visible_Declarations (Package_Specification (Scop)); end Original_View_In_Visible_Part; ------------------ @@ -8446,8 +8446,7 @@ package body Exp_Disp is and then In_Private_Part (Current_Scope) and then List_Containing (Parent (Prim)) = - Private_Declarations - (Specification (Unit_Declaration_Node (Current_Scope))) + Private_Declarations (Package_Specification (Current_Scope)) and then Original_View_In_Visible_Part (Typ) then -- We exclude Input and Output stream operations because diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 364330339fe..d03644cae5c 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -2874,8 +2874,7 @@ package body Exp_Dist is if RCI_Locator = Empty then RCI_Locator_Decl := - RCI_Package_Locator - (Loc, Specification (Unit_Declaration_Node (RCI_Package))); + RCI_Package_Locator (Loc, Package_Specification (RCI_Package)); Prepend_To (Current_Sem_Unit_Declarations, RCI_Locator_Decl); Analyze (RCI_Locator_Decl); RCI_Locator := Defining_Unit_Name (RCI_Locator_Decl); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index d51a73df2a2..d07944ae05f 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2741,6 +2741,11 @@ package body Freeze is if Has_Foreign_Convention (Etype (Comp)) and then Has_Pragma_Pack (Rec) + + -- Don't warn for aliased components, since override + -- cannot happen in that case. + + and then not Is_Aliased (Comp) then declare CN : constant Name_Id := diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 3c5d2af59ba..5a4c4384320 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1151,6 +1151,27 @@ package body Sem_Aux is and then Has_Discriminants (Typ)); end Object_Type_Has_Constrained_Partial_View; + --------------------------- + -- Package_Specification -- + --------------------------- + + function Package_Specification (Pack_Id : Entity_Id) return Node_Id is + N : Node_Id; + + begin + N := Parent (Pack_Id); + + while Nkind (N) /= N_Package_Specification loop + N := Parent (N); + + if No (N) then + raise Program_Error; + end if; + end loop; + + return N; + end Package_Specification; + --------------- -- Tree_Read -- --------------- diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index e7086cc0ecc..d493059c42f 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -348,4 +348,8 @@ package Sem_Aux is -- it returns the subprogram, task or protected body node for it. The unit -- may be a child unit with any number of ancestors. + function Package_Specification (Pack_Id : Entity_Id) return Node_Id; + -- Given an entity for a package or generic package, return corresponding + -- package specification. Simplifies handling of child units, and better + -- than the old idiom: Specification (Unit_Declaration_Node (Pack_Id). end Sem_Aux; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index e4615393dd2..79201c4edf0 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -561,8 +561,7 @@ package body Sem_Cat is and then Is_Package_Or_Generic_Package (Unit_Entity) and then Unit_Kind /= N_Package_Body and then List_Containing (N) = - Visible_Declarations - (Specification (Unit_Declaration_Node (Unit_Entity))) + Visible_Declarations (Package_Specification (Unit_Entity)) and then not In_Package_Body (Unit_Entity) and then not In_Instance; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index ee2ab6300cd..1c9fd26bbb9 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -4028,7 +4028,7 @@ package body Sem_Ch10 is Is_Private_Descendant (P_Name) or else Private_Present (Parent (Lib_Unit))); - P_Spec := Specification (Unit_Declaration_Node (P_Name)); + P_Spec := Package_Specification (P_Name); Push_Scope (P_Name); -- Save current visibility of unit diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d5c5ce7c595..2ae6418baf7 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -5664,8 +5664,7 @@ package body Sem_Ch12 is (Related_Instance (Instance)))); else Gen_Id := - Generic_Parent - (Specification (Unit_Declaration_Node (Instance))); + Generic_Parent (Package_Specification (Instance)); end if; Parent_Scope := Scope (Gen_Id); @@ -8365,7 +8364,7 @@ package body Sem_Ch12 is -- of its generic parent. if Is_Generic_Instance (Par) then - Gen := Generic_Parent (Specification (Unit_Declaration_Node (Par))); + Gen := Generic_Parent (Package_Specification (Par)); Gen_E := First_Entity (Gen); end if; @@ -8449,8 +8448,7 @@ package body Sem_Ch12 is ------------------ procedure Install_Spec (Par : Entity_Id) is - Spec : constant Node_Id := - Specification (Unit_Declaration_Node (Par)); + Spec : constant Node_Id := Package_Specification (Par); begin -- If this parent of the child instance is a top-level unit, @@ -8519,8 +8517,7 @@ package body Sem_Ch12 is First_Par := Inst_Par; - Gen_Par := - Generic_Parent (Specification (Unit_Declaration_Node (Inst_Par))); + Gen_Par := Generic_Parent (Package_Specification (Inst_Par)); First_Gen := Gen_Par; @@ -8538,9 +8535,7 @@ package body Sem_Ch12 is Inst_Par := Renamed_Entity (Inst_Par); end if; - Gen_Par := - Generic_Parent - (Specification (Unit_Declaration_Node (Inst_Par))); + Gen_Par := Generic_Parent (Package_Specification (Inst_Par)); if Present (Gen_Par) then Prepend_Elmt (Inst_Par, Ancestors); @@ -9009,7 +9004,7 @@ package body Sem_Ch12 is end if; if Nkind (Parent (Actual_Pack)) = N_Defining_Program_Unit_Name then - Parent_Spec := Specification (Unit_Declaration_Node (Actual_Pack)); + Parent_Spec := Package_Specification (Actual_Pack); else Parent_Spec := Parent (Actual_Pack); end if; @@ -12571,8 +12566,7 @@ package body Sem_Ch12 is elsif S = Current_Scope and then Is_Generic_Instance (S) then declare Par : constant Entity_Id := - Generic_Parent - (Specification (Unit_Declaration_Node (S))); + Generic_Parent (Package_Specification (S)); begin if Present (Par) and then P = Scope (Par) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index f7cb18ce3d5..8074775dfd0 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -10919,8 +10919,7 @@ package body Sem_Ch3 is elsif Ekind (Current_Scope) = E_Package and then List_Containing (Parent (Prev)) /= - Visible_Declarations - (Specification (Unit_Declaration_Node (Current_Scope))) + Visible_Declarations (Package_Specification (Current_Scope)) then Error_Msg_N ("deferred constant must be declared in visible part", diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 7d47436e7a8..fec9ef5cea2 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -10318,8 +10318,7 @@ package body Sem_Ch6 is and then In_Private_Part (Current_Scope) then Priv_Decls := - Private_Declarations - (Specification (Unit_Declaration_Node (Current_Scope))); + Private_Declarations (Package_Specification (Current_Scope)); return In_Package_Body (Current_Scope) or else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index bd00a3c7ed1..f8ee02dd173 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -21725,7 +21725,7 @@ package body Sem_Prag is -- Local variables - Pack_Spec : constant Node_Id := Parent (Spec_Id); + Pack_Spec : constant Node_Id := Package_Specification (Spec_Id); -- Start of processing for Collect_Hidden_States |