[multiple changes]
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. From-SVN: r203349
This commit is contained in:
Arnaud Charlet
parent
27a8f15020
commit
11d59a8683
10 changed files with 124 additions and 53 deletions
|
|
@ -1,3 +1,35 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue