diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 13 |
10 files changed, 124 insertions, 53 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9195cb0..816aab3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,37 @@ 2013-10-10 Robert Dewar <dewar@adacore.com> + * gnat_rm.texi: Minor fix. + +2013-10-10 Robert Dewar <dewar@adacore.com> + + * sem_ch13.adb (Analyze_Attribute_Definition_Clause, case + Address): Remove the Comes_From_Source test for the overlap + warning. + +2013-10-10 Robert Dewar <dewar@adacore.com> + + * sem_util.adb: Minor code reorganization (use Nkind_In). + * sem_warn.adb: Minor code reorganization (optimization in + Check_Unset_Reference). + * exp_ch9.adb, exp_ch4.adb, sinfo.ads: Minor reformatting. + +2013-10-10 Ed Schonberg <schonberg@adacore.com> + + * sem_ch7.adb (Install_Parent_Private_Declarations): When + instantiating a child unit, do not install private declaration of + a non-generic ancestor of the generic that is also an ancestor + of the current unit: its private part will be installed when + private part of ancestor itself is analyzed. + +2013-10-10 Thomas Quinot <quinot@adacore.com> + + * freeze.adb (Check_Component_Storage_Order): Retrieve component + aliased status from type entities directly instead of going back + to original component definition. + * sem_ch7.adb: Minor reformatting. + +2013-10-10 Robert Dewar <dewar@adacore.com> + * sem_ch13.adb (Analyze_Aspect_Specifications): For Address attribute, consider it to be set in source, because of aliasing considerations. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 234e206..175f61d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4959,11 +4959,10 @@ package body Exp_Ch4 is Append_To (Actions, Make_Full_Type_Declaration (Loc, Defining_Identifier => Pnn, - Type_Definition => + Type_Definition => Make_Access_To_Object_Definition (Loc, - All_Present => True, - Subtype_Indication => - New_Reference_To (Typ, Loc)))); + All_Present => True, + Subtype_Indication => New_Reference_To (Typ, Loc)))); Ttyp := Pnn; end if; @@ -4972,7 +4971,8 @@ package body Exp_Ch4 is -- Create declaration for target of expression, and indicate that it -- does not require initialization. - Decl := Make_Object_Declaration (Loc, + Decl := + Make_Object_Declaration (Loc, Defining_Identifier => Tnn, Object_Definition => New_Occurrence_Of (Ttyp, Loc)); Set_No_Initialization (Decl); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 6f43792..738564c 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -9010,26 +9010,26 @@ package body Exp_Ch9 is then Protection_Subtype := Make_Subtype_Indication (Loc, - Subtype_Mark => - New_Reference_To - (RTE (RE_Static_Interrupt_Protection), Loc), - Constraint => - Make_Index_Or_Discriminant_Constraint (Loc, - Constraints => New_List ( - Entry_Count_Expr, - Make_Integer_Literal (Loc, Num_Attach_Handler)))); + Subtype_Mark => + New_Reference_To + (RTE (RE_Static_Interrupt_Protection), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Entry_Count_Expr, + Make_Integer_Literal (Loc, Num_Attach_Handler)))); elsif Has_Interrupt_Handler (Prot_Typ) and then not Restriction_Active (No_Dynamic_Attachment) then Protection_Subtype := Make_Subtype_Indication (Loc, - Subtype_Mark => - New_Reference_To - (RTE (RE_Dynamic_Interrupt_Protection), Loc), - Constraint => - Make_Index_Or_Discriminant_Constraint (Loc, - Constraints => New_List (Entry_Count_Expr))); + Subtype_Mark => + New_Reference_To + (RTE (RE_Dynamic_Interrupt_Protection), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List (Entry_Count_Expr))); else case Corresponding_Runtime_Package (Prot_Typ) is @@ -13644,12 +13644,14 @@ package body Exp_Ch9 is -- Protected types with interrupt handlers (when not using a -- restricted profile) are also considered equivalent to protected - -- types with entries. The types which are used - -- (Static_Interrupt_Protection and Dynamic_Interrupt_Protection) - -- are derived from Protection_Entries. + -- types with entries. + + -- The types which are used (Static_Interrupt_Protection and + -- Dynamic_Interrupt_Protection) are derived from Protection_Entries. declare Pkg_Id : constant RTU_Id := Corresponding_Runtime_Package (Ptyp); + Called_Subp : RE_Id; begin @@ -13695,8 +13697,8 @@ package body Exp_Ch9 is Append_To (Args, Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (P_Arr, Loc), - Attribute_Name => Name_Unrestricted_Access)); + Prefix => New_Reference_To (P_Arr, Loc), + Attribute_Name => Name_Unrestricted_Access)); if Pkg_Id = System_Tasking_Protected_Objects_Entries then @@ -13713,6 +13715,7 @@ package body Exp_Ch9 is end if; elsif Pkg_Id = System_Tasking_Protected_Objects_Single_Entry then + -- This is the case where we have a protected object with -- interfaces and no entries, and the single entry restriction -- is in effect. We pass a null pointer for the entry @@ -13721,6 +13724,7 @@ package body Exp_Ch9 is Append_To (Args, Make_Null (Loc)); elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then + -- This is the case where we have a protected object with no -- entries and: -- - either interrupt handlers with non restricted profile, diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 58098be..c161338 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1068,7 +1068,6 @@ package body Freeze is Comp : Entity_Id) is Comp_Type : Entity_Id; - Comp_Def : Node_Id; Err_Node : Node_Id; ADC : Node_Id; @@ -1076,6 +1075,8 @@ package body Freeze is -- Set True for the record case, when Comp starts on a byte boundary -- (in which case it is allowed to have different storage order). + Component_Aliased : Boolean; + begin -- Record case @@ -1084,15 +1085,15 @@ package body Freeze is Comp_Type := Etype (Comp); if Is_Tag (Comp) then - Comp_Def := Empty; Comp_Byte_Aligned := True; + Component_Aliased := False; else - Comp_Def := Component_Definition (Parent (Comp)); Comp_Byte_Aligned := Present (Component_Clause (Comp)) and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0; + Component_Aliased := Is_Aliased (Comp); end if; -- Array case @@ -1100,10 +1101,9 @@ package body Freeze is else Err_Node := Encl_Type; Comp_Type := Component_Type (Encl_Type); - Comp_Def := Component_Definition - (Type_Definition (Declaration_Node (Encl_Type))); Comp_Byte_Aligned := False; + Component_Aliased := Has_Aliased_Components (Encl_Type); end if; -- Note: the Reverse_Storage_Order flag is set on the base type, but @@ -1139,7 +1139,7 @@ package body Freeze is & "storage order as enclosing composite", Err_Node); end if; - elsif Present (Comp_Def) and then Aliased_Present (Comp_Def) then + elsif Component_Aliased then Error_Msg_N ("aliased component not permitted for type with " & "explicit Scalar_Storage_Order", Err_Node); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 3c46f64..defcdcb 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -8781,7 +8781,7 @@ The @code{Update} attribute creates a copy of an array or record value with one or more modified components. The syntax is: @smallexample @c ada -PREFIX'Update (AGGREGATE); +PREFIX'Update (AGGREGATE) @end smallexample @noindent diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index f9e23f7..3a6b839 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3485,18 +3485,21 @@ package body Sem_Ch13 is -- then we make an entry in the table for checking the size -- and alignment of the overlaying variable. We defer this -- check till after code generation to take full advantage - -- of the annotation done by the back end. This entry is - -- only made if the address clause comes from source or - -- from an aspect clause (which is still from source). + -- of the annotation done by the back end. -- If the entity has a generic type, the check will be -- performed in the instance if the actual type justifies -- it, and we do not insert the clause in the table to -- prevent spurious warnings. + -- Note: we used to test Comes_From_Source and only give + -- this warning for source entities, but we have removed + -- this test. It really seems bogus to generate overlays + -- that would trigger this warning in generated code. + -- Furthermore, by removing the test, we handle the + -- aspect case properly. + if Address_Clause_Overlay_Warnings - and then (Comes_From_Source (N) - or else From_Aspect_Specification (N)) and then Present (O_Ent) and then Is_Object (O_Ent) then diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index e06b6b9..b33a15e 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -1167,17 +1167,31 @@ package body Sem_Ch7 is -- then finish off by looping through the nongeneric parents -- and installing their private declarations. + -- If one of the non-generic parents is itself on the scope + -- stack, do not install its private declarations: they are + -- installed in due time when the private part of that parent + -- is analyzed. + else while Present (Inst_Par) and then Inst_Par /= Standard_Standard and then (not In_Open_Scopes (Inst_Par) or else not In_Private_Part (Inst_Par)) loop - Install_Private_Declarations (Inst_Par); - Set_Use (Private_Declarations - (Specification - (Unit_Declaration_Node (Inst_Par)))); - Inst_Par := Scope (Inst_Par); + if Nkind (Inst_Node) = N_Formal_Package_Declaration + or else + not Is_Ancestor_Package + (Inst_Par, Cunit_Entity (Current_Sem_Unit)) + then + Install_Private_Declarations (Inst_Par); + Set_Use (Private_Declarations + (Specification + (Unit_Declaration_Node (Inst_Par)))); + Inst_Par := Scope (Inst_Par); + + else + exit; + end if; end loop; exit; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index db09d05..284b0f3 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12217,8 +12217,8 @@ package body Sem_Util is end if; if Nkind (P) = N_Selected_Component - and then Present ( - Entry_Formal (Entity (Selector_Name (P)))) + and then + Present (Entry_Formal (Entity (Selector_Name (P)))) then -- Case of a reference to an entry formal @@ -12242,15 +12242,15 @@ package body Sem_Util is end if; end; - elsif Nkind (Exp) = N_Type_Conversion - or else Nkind (Exp) = N_Unchecked_Type_Conversion + elsif Nkind_In (Exp, N_Type_Conversion, + N_Unchecked_Type_Conversion) then Exp := Expression (Exp); goto Continue; - elsif Nkind (Exp) = N_Slice - or else Nkind (Exp) = N_Indexed_Component - or else Nkind (Exp) = N_Selected_Component + elsif Nkind_In (Exp, N_Slice, + N_Indexed_Component, + N_Selected_Component) then Exp := Prefix (Exp); goto Continue; @@ -12309,7 +12309,9 @@ package body Sem_Util is -- source. This excludes, for example, calls to a dispatching -- assignment operation when the left-hand side is tagged. - if Modification_Comes_From_Source or else SPARK_Mode then + -- Why is SPARK mode different here ??? + + if Modification_Comes_From_Source or SPARK_Mode then Generate_Reference (Ent, Exp, 'm'); -- If the target of the assignment is the bound variable diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 68c3ca8..8315e65 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1674,6 +1674,15 @@ package body Sem_Warn is return; end if; + -- Nothing to do for numeric or string literal. Do this test early to + -- save time in a common case (it does not matter that we do not include + -- character literal here, since that will be caught later on in the + -- when others branch of the case statement). + + if Nkind (N) in N_Numeric_Or_String_Literal then + return; + end if; + -- Ignore reference unless it comes from source. Almost always if we -- have a reference from generated code, it is bogus (e.g. calls to init -- procs to set default discriminant values). @@ -1707,7 +1716,7 @@ package body Sem_Warn is and then (No (Unset_Reference (E)) or else Earlier_In_Extended_Unit - (Sloc (N), Sloc (Unset_Reference (E)))) + (Sloc (N), Sloc (Unset_Reference (E)))) and then not Has_Pragma_Unmodified_Check_Spec (E) and then not Warnings_Off_Check_Spec (E) then diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 112f8fc..9d966bf 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -7822,13 +7822,18 @@ package Sinfo is N_Raise_Program_Error, N_Raise_Storage_Error, + -- N_Subexpr, N_Has_Etype, N_Numeric_Or_String_Literal + + N_Integer_Literal, + N_Real_Literal, + N_String_Literal, + -- N_Subexpr, N_Has_Etype N_Explicit_Dereference, N_Expression_With_Actions, N_If_Expression, N_Indexed_Component, - N_Integer_Literal, N_Null, N_Qualified_Expression, N_Quantified_Expression, @@ -7838,11 +7843,9 @@ package Sinfo is N_Extension_Aggregate, N_Raise_Expression, N_Range, - N_Real_Literal, N_Reference, N_Selected_Component, N_Slice, - N_String_Literal, N_Subprogram_Info, N_Type_Conversion, N_Unchecked_Expression, @@ -8173,6 +8176,10 @@ package Sinfo is N_In .. N_Not_In; + subtype N_Numeric_Or_String_Literal is Node_Kind range + N_Integer_Literal .. + N_String_Literal; + subtype N_Op is Node_Kind range N_Op_Add .. N_Op_Plus; |