mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-04 14:31:29 +08:00
[multiple changes]
2014-01-21 Robert Dewar <dewar@adacore.com> * checks.adb, sem_util.ads, sem_ch4.adb: Minor reformatting. 2014-01-21 Pascal Obry <obry@adacore.com> * projects.texi: Minor typo fix. 2014-01-21 Thomas Quinot <quinot@adacore.com> * freeze.adb (Check_Component_Storage_Order): If a record type has an explicit Scalar_Storage_Order attribute definition clause, reject any component that itself is of a composite type and does not have one. 2014-01-21 Ed Schonberg <schonberg@adacore.com> * sem_ch10.adb (Generate_Parent_Reference): Make public so it can be used to generate proper cross-reference information for the parent units of proper bodies. 2014-01-21 Thomas Quinot <quinot@adacore.com> * gcc-interface/decl.c (gnat_to_gnu_entity): For a modular type that represents a bit packed array type, propagate the reverse storage order flag to the generated wrapper record. * exp_pakd.adb (Expand_Packed_Element_Set, Expand_Packed_Element_Reference): No byte swapping required in the front-end for the case of a reverse storage order array, as this is now handled uniformly in the back-end. However we still need to swap back an extracted element if it is itself a nested composite with reverse storage order. From-SVN: r206890
This commit is contained in:
Arnaud Charlet
parent
497716fecf
commit
637a41a5d7
@ -1,3 +1,34 @@
|
||||
2014-01-21 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* checks.adb, sem_util.ads, sem_ch4.adb: Minor reformatting.
|
||||
* gcc-interface/Makefile.in: clean up target pairs.
|
||||
|
||||
2014-01-21 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* projects.texi: Minor typo fix.
|
||||
|
||||
2014-01-21 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* freeze.adb (Check_Component_Storage_Order): If a record type
|
||||
has an explicit Scalar_Storage_Order attribute definition clause,
|
||||
reject any component that itself is of a composite type and does
|
||||
not have one.
|
||||
|
||||
2014-01-21 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch10.adb (Generate_Parent_Reference): Make public so it
|
||||
can be used to generate proper cross-reference information for
|
||||
the parent units of proper bodies.
|
||||
|
||||
2014-01-21 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* exp_pakd.adb (Expand_Packed_Element_Set,
|
||||
Expand_Packed_Element_Reference): No byte swapping required in
|
||||
the front-end for the case of a reverse storage order array,
|
||||
as this is now handled uniformly in the back-end. However we
|
||||
still need to swap back an extracted element if it is itself a
|
||||
nested composite with reverse storage order.
|
||||
|
||||
2014-01-21 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_prag.adb (Analyze_External_Property): Add processing for "others".
|
||||
|
||||
@ -86,6 +86,9 @@ package body Checks is
|
||||
-- the ability to emit constraint error warning for static expressions
|
||||
-- even when we are not generating code.
|
||||
|
||||
-- The above is modified in gnatprove mode to ensure that proper check
|
||||
-- flags are always placed, even if expansion is off.
|
||||
|
||||
-------------------------------------
|
||||
-- Suppression of Redundant Checks --
|
||||
-------------------------------------
|
||||
@ -3540,17 +3543,16 @@ package body Checks is
|
||||
else
|
||||
Dref :=
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix =>
|
||||
Prefix =>
|
||||
Duplicate_Subexpr_No_Checks (N, Name_Req => True),
|
||||
Selector_Name =>
|
||||
Make_Identifier (Loc, Chars (Disc_Ent)));
|
||||
Selector_Name => Make_Identifier (Loc, Chars (Disc_Ent)));
|
||||
|
||||
Set_Is_In_Discriminant_Check (Dref);
|
||||
end if;
|
||||
|
||||
Evolve_Or_Else (Cond,
|
||||
Make_Op_Ne (Loc,
|
||||
Left_Opnd => Dref,
|
||||
Left_Opnd => Dref,
|
||||
Right_Opnd => Dval));
|
||||
|
||||
Next_Elmt (Disc);
|
||||
@ -3584,10 +3586,9 @@ package body Checks is
|
||||
function Left_Expression (Op : Node_Id) return Node_Id is
|
||||
LE : Node_Id := Left_Opnd (Op);
|
||||
begin
|
||||
while Nkind_In (LE,
|
||||
N_Qualified_Expression,
|
||||
N_Type_Conversion,
|
||||
N_Expression_With_Actions)
|
||||
while Nkind_In (LE, N_Qualified_Expression,
|
||||
N_Type_Conversion,
|
||||
N_Expression_With_Actions)
|
||||
loop
|
||||
LE := Expression (LE);
|
||||
end loop;
|
||||
@ -3650,7 +3651,7 @@ package body Checks is
|
||||
exit when (N = Right_Opnd (P)
|
||||
or else
|
||||
(Is_List_Member (N)
|
||||
and then List_Containing (N) = Actions (P)))
|
||||
and then List_Containing (N) = Actions (P)))
|
||||
and then Nkind (Left_Expression (P)) = N_Op_Ne;
|
||||
end if;
|
||||
|
||||
@ -3669,9 +3670,7 @@ package body Checks is
|
||||
|
||||
-- Left operand of test must match original variable
|
||||
|
||||
if Nkind (L) not in N_Has_Entity
|
||||
or else Entity (L) /= Entity (Nod)
|
||||
then
|
||||
if Nkind (L) not in N_Has_Entity or else Entity (L) /= Entity (Nod) then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
@ -3961,6 +3960,7 @@ package body Checks is
|
||||
|
||||
else
|
||||
Num_Saved_Checks := Saved_Checks_Stack (Saved_Checks_TOS);
|
||||
|
||||
if Debug_Flag_CC then
|
||||
w ("Conditional_Statements_End: Num_Saved_Checks = ",
|
||||
Num_Saved_Checks);
|
||||
@ -4287,7 +4287,6 @@ package body Checks is
|
||||
then
|
||||
Lor := Lo_Left / Lo_Right;
|
||||
Hir := Hi_Left / Lo_Right;
|
||||
|
||||
else
|
||||
OK1 := False;
|
||||
end if;
|
||||
@ -4782,8 +4781,8 @@ package body Checks is
|
||||
end if;
|
||||
|
||||
-- If we get an exception, then something went wrong, probably because of
|
||||
-- an error in the structure of the tree due to an incorrect program. Or it
|
||||
-- may be a bug in the optimization circuit. In either case the safest
|
||||
-- an error in the structure of the tree due to an incorrect program. Or
|
||||
-- it may be a bug in the optimization circuit. In either case the safest
|
||||
-- thing is simply to set the check flag unconditionally.
|
||||
|
||||
exception
|
||||
@ -4832,9 +4831,7 @@ package body Checks is
|
||||
|
||||
-- No check if range checks suppressed for type of node
|
||||
|
||||
if Present (Etype (N))
|
||||
and then Range_Checks_Suppressed (Etype (N))
|
||||
then
|
||||
if Present (Etype (N)) and then Range_Checks_Suppressed (Etype (N)) then
|
||||
return;
|
||||
|
||||
-- No check if node is an entity name, and range checks are suppressed
|
||||
@ -4842,7 +4839,7 @@ package body Checks is
|
||||
|
||||
elsif Is_Entity_Name (N)
|
||||
and then (Range_Checks_Suppressed (Entity (N))
|
||||
or else Range_Checks_Suppressed (Etype (Entity (N))))
|
||||
or else Range_Checks_Suppressed (Etype (Entity (N))))
|
||||
then
|
||||
return;
|
||||
|
||||
@ -5180,9 +5177,8 @@ package body Checks is
|
||||
-- formal is not OUT). This test also filters out the
|
||||
-- generic case.
|
||||
|
||||
if Is_Non_Empty_List (L)
|
||||
and then Is_Subprogram (E)
|
||||
then
|
||||
if Is_Non_Empty_List (L) and then Is_Subprogram (E) then
|
||||
|
||||
-- This is the loop through parameters, looking for an
|
||||
-- OUT parameter for which we are the argument.
|
||||
|
||||
@ -5294,26 +5290,18 @@ package body Checks is
|
||||
-- Integer and character literals always have valid values, where
|
||||
-- appropriate these will be range checked in any case.
|
||||
|
||||
elsif Nkind (Expr) = N_Integer_Literal
|
||||
or else
|
||||
Nkind (Expr) = N_Character_Literal
|
||||
then
|
||||
elsif Nkind_In (Expr, N_Integer_Literal, N_Character_Literal) then
|
||||
return True;
|
||||
|
||||
-- Real literals are assumed to be valid in VM targets
|
||||
|
||||
elsif VM_Target /= No_VM
|
||||
and then Nkind (Expr) = N_Real_Literal
|
||||
then
|
||||
elsif VM_Target /= No_VM and then Nkind (Expr) = N_Real_Literal then
|
||||
return True;
|
||||
|
||||
-- If we have a type conversion or a qualification of a known valid
|
||||
-- value, then the result will always be valid.
|
||||
|
||||
elsif Nkind (Expr) = N_Type_Conversion
|
||||
or else
|
||||
Nkind (Expr) = N_Qualified_Expression
|
||||
then
|
||||
elsif Nkind_In (Expr, N_Type_Conversion, N_Qualified_Expression) then
|
||||
return Expr_Known_Valid (Expression (Expr));
|
||||
|
||||
-- The result of any operator is always considered valid, since we
|
||||
@ -5324,10 +5312,9 @@ package body Checks is
|
||||
elsif Nkind (Expr) in N_Op then
|
||||
if Is_Floating_Point_Type (Typ)
|
||||
and then Validity_Check_Floating_Point
|
||||
and then
|
||||
(Nkind (Parent (Expr)) = N_Assignment_Statement
|
||||
or else Nkind (Parent (Expr)) = N_Function_Call
|
||||
or else Nkind (Parent (Expr)) = N_Parameter_Association)
|
||||
and then (Nkind_In (Parent (Expr), N_Assignment_Statement,
|
||||
N_Function_Call,
|
||||
N_Parameter_Association))
|
||||
then
|
||||
return False;
|
||||
else
|
||||
@ -5468,7 +5455,6 @@ package body Checks is
|
||||
for J in reverse 1 .. Num_Saved_Checks loop
|
||||
declare
|
||||
SC : Saved_Check renames Saved_Checks (J);
|
||||
|
||||
begin
|
||||
if SC.Killed = False
|
||||
and then SC.Entity = Ent
|
||||
@ -5532,10 +5518,10 @@ package body Checks is
|
||||
|
||||
-- Force evaluation of the prefix, so that it does not get evaluated
|
||||
-- twice (once for the check, once for the actual reference). Such a
|
||||
-- double evaluation is always a potential source of inefficiency,
|
||||
-- and is functionally incorrect in the volatile case, or when the
|
||||
-- prefix may have side-effects. An entity or a component of an
|
||||
-- entity requires no evaluation.
|
||||
-- double evaluation is always a potential source of inefficiency, and
|
||||
-- is functionally incorrect in the volatile case, or when the prefix
|
||||
-- may have side-effects. A non-volatile entity or a component of a
|
||||
-- non-volatile entity requires no evaluation.
|
||||
|
||||
if Is_Entity_Name (Pref) then
|
||||
if Treat_As_Volatile (Entity (Pref)) then
|
||||
@ -5543,7 +5529,7 @@ package body Checks is
|
||||
end if;
|
||||
|
||||
elsif Treat_As_Volatile (Etype (Pref)) then
|
||||
Force_Evaluation (Pref, Name_Req => True);
|
||||
Force_Evaluation (Pref, Name_Req => True);
|
||||
|
||||
elsif Nkind (Pref) = N_Selected_Component
|
||||
and then Is_Entity_Name (Prefix (Pref))
|
||||
@ -5629,7 +5615,7 @@ package body Checks is
|
||||
Make_Raise_Constraint_Error (Loc,
|
||||
Condition =>
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (Discr_Fct, Loc),
|
||||
Name => New_Occurrence_Of (Discr_Fct, Loc),
|
||||
Parameter_Associations => Args),
|
||||
Reason => CE_Discriminant_Check_Failed));
|
||||
end Generate_Discriminant_Check;
|
||||
@ -5680,8 +5666,7 @@ package body Checks is
|
||||
-- for array object or type.
|
||||
|
||||
if not Is_Array_Type (Etype (A))
|
||||
or else (Present (A_Ent)
|
||||
and then Index_Checks_Suppressed (A_Ent))
|
||||
or else (Present (A_Ent) and then Index_Checks_Suppressed (A_Ent))
|
||||
or else Index_Checks_Suppressed (Etype (A))
|
||||
then
|
||||
return;
|
||||
@ -6088,7 +6073,7 @@ package body Checks is
|
||||
|
||||
else
|
||||
pragma Assert (not Is_Unsigned_Type (Source_Base_Type)
|
||||
and then Is_Unsigned_Type (Target_Base_Type));
|
||||
and then Is_Unsigned_Type (Target_Base_Type));
|
||||
|
||||
-- If the source is signed and the target is unsigned, then we
|
||||
-- know that the target is not shorter than the source (otherwise
|
||||
@ -6141,7 +6126,7 @@ package body Checks is
|
||||
Right_Opnd =>
|
||||
New_Occurrence_Of (Target_Type, Loc))),
|
||||
|
||||
Reason => Reason)),
|
||||
Reason => Reason)),
|
||||
Suppress => All_Checks);
|
||||
|
||||
-- Set the Etype explicitly, because Insert_Actions may have
|
||||
@ -6205,7 +6190,6 @@ package body Checks is
|
||||
while Present (Sc) loop
|
||||
if Sc = Standard_Standard then
|
||||
return Bound;
|
||||
|
||||
elsif Ekind (Sc) = E_Protected_Type then
|
||||
exit;
|
||||
end if;
|
||||
@ -6236,8 +6220,8 @@ package body Checks is
|
||||
Warn_Node : Node_Id := Empty) return Check_Result
|
||||
is
|
||||
begin
|
||||
return Selected_Range_Checks
|
||||
(Ck_Node, Target_Typ, Source_Typ, Warn_Node);
|
||||
return
|
||||
Selected_Range_Checks (Ck_Node, Target_Typ, Source_Typ, Warn_Node);
|
||||
end Get_Range_Checks;
|
||||
|
||||
------------------
|
||||
@ -6256,6 +6240,7 @@ package body Checks is
|
||||
|
||||
if Nkind (Ck_Node) = N_Allocator then
|
||||
return Cond;
|
||||
|
||||
else
|
||||
return
|
||||
Make_And_Then (Loc,
|
||||
@ -6475,7 +6460,7 @@ package body Checks is
|
||||
|
||||
if Is_Entity_Name (Exp)
|
||||
and then Nkind (Parent (Entity (Exp))) =
|
||||
N_Object_Renaming_Declaration
|
||||
N_Object_Renaming_Declaration
|
||||
then
|
||||
declare
|
||||
Old_Exp : constant Node_Id := Name (Parent (Entity (Exp)));
|
||||
@ -6602,9 +6587,9 @@ package body Checks is
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- If we are in a case expression, and not part of the
|
||||
-- expression, then we return False, since a particular
|
||||
-- dependent expression may not always be elaborated
|
||||
-- If within a case expression, and not part of the expression,
|
||||
-- then return False, since a particular dependent expression
|
||||
-- may not always be elaborated
|
||||
|
||||
if Nkind (P) = N_Case_Expression
|
||||
and then N /= Expression (P)
|
||||
@ -6612,9 +6597,8 @@ package body Checks is
|
||||
return False;
|
||||
end if;
|
||||
|
||||
-- While traversing the parent chain, we find that N
|
||||
-- belongs to a statement, thus it may never appear in
|
||||
-- a declarative region.
|
||||
-- While traversing the parent chain, if node N belongs to a
|
||||
-- statement, then it may never appear in a declarative region.
|
||||
|
||||
if Nkind (P) in N_Statement_Other_Than_Procedure_Call
|
||||
or else Nkind (P) = N_Procedure_Call_Statement
|
||||
@ -6696,9 +6680,11 @@ package body Checks is
|
||||
|
||||
if Known_Null (N) then
|
||||
|
||||
-- Avoid generating warning message inside init procs
|
||||
-- Avoid generating warning message inside init procs. In SPARK mode
|
||||
-- we can go ahead and call Apply_Compile_Time_Constraint_Error
|
||||
-- since it will be truned into an error in any case.
|
||||
|
||||
if not Inside_Init_Proc then
|
||||
if not Inside_Init_Proc or else SPARK_Mode = On then
|
||||
Apply_Compile_Time_Constraint_Error
|
||||
(N, "null value not allowed here??", CE_Access_Check_Failed);
|
||||
else
|
||||
@ -7163,7 +7149,7 @@ package body Checks is
|
||||
end if;
|
||||
|
||||
-- If we don't have a binary operator, all we have to do is to set
|
||||
-- the Hi/Lo range, so we are done
|
||||
-- the Hi/Lo range, so we are done.
|
||||
|
||||
return;
|
||||
|
||||
@ -7329,7 +7315,7 @@ package body Checks is
|
||||
|
||||
-- If we have an arithmetic operator we make recursive calls on the
|
||||
-- operands to get the ranges (and to properly process the subtree
|
||||
-- that lies below us!)
|
||||
-- that lies below us).
|
||||
|
||||
Minimize_Eliminate_Overflows
|
||||
(Right_Opnd (N), Rlo, Rhi, Top_Level => False);
|
||||
@ -8134,7 +8120,8 @@ package body Checks is
|
||||
begin
|
||||
if Present (N) then
|
||||
|
||||
-- For now, ignore attempt to place more than 2 checks ???
|
||||
-- For now, ignore attempt to place more than two checks ???
|
||||
-- This is really worrisome, are we really discarding checks ???
|
||||
|
||||
if Num_Checks = 2 then
|
||||
return;
|
||||
@ -9003,7 +8990,6 @@ package body Checks is
|
||||
then
|
||||
HB := T_HB;
|
||||
Known_HB := True;
|
||||
|
||||
else
|
||||
Known_HB := False;
|
||||
end if;
|
||||
@ -9158,9 +9144,7 @@ package body Checks is
|
||||
-- and replace the literal with a raise constraint error
|
||||
-- expression. As usual, skip this for access types
|
||||
|
||||
elsif Compile_Time_Known_Value (Ck_Node)
|
||||
and then not Do_Access
|
||||
then
|
||||
elsif Compile_Time_Known_Value (Ck_Node) and then not Do_Access then
|
||||
declare
|
||||
LB : constant Node_Id := Type_Low_Bound (T_Typ);
|
||||
UB : constant Node_Id := Type_High_Bound (T_Typ);
|
||||
@ -9442,9 +9426,9 @@ package body Checks is
|
||||
and then Checks_May_Be_Suppressed (E)
|
||||
then
|
||||
return Is_Check_Suppressed (E, Tag_Check);
|
||||
else
|
||||
return Scope_Suppress.Suppress (Tag_Check);
|
||||
end if;
|
||||
|
||||
return Scope_Suppress.Suppress (Tag_Check);
|
||||
end Tag_Checks_Suppressed;
|
||||
|
||||
--------------------------
|
||||
|
||||
@ -1378,12 +1378,6 @@ package body Exp_Pakd is
|
||||
-- contains the value. Otherwise Rhs_Val_Known is set False, and
|
||||
-- the Rhs_Val is undefined.
|
||||
|
||||
Require_Byte_Swapping : Boolean := False;
|
||||
-- True if byte swapping required, for the Reverse_Storage_Order case
|
||||
-- when the packed array is a free-standing object. (If it is part
|
||||
-- of a composite type, and therefore potentially not aligned on a byte
|
||||
-- boundary, the swapping is done by the back-end).
|
||||
|
||||
function Get_Shift return Node_Id;
|
||||
-- Function used to get the value of Shift, making sure that it
|
||||
-- gets duplicated if the function is called more than once.
|
||||
@ -1562,25 +1556,8 @@ package body Exp_Pakd is
|
||||
-- array type on Obj to get lost. So we save the type of Obj, and
|
||||
-- make sure it is reset properly.
|
||||
|
||||
declare
|
||||
T : constant Entity_Id := Etype (Obj);
|
||||
begin
|
||||
New_Lhs := Duplicate_Subexpr (Obj, Name_Req => True);
|
||||
New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
|
||||
Set_Etype (Obj, T);
|
||||
Set_Etype (New_Lhs, T);
|
||||
Set_Etype (New_Rhs, T);
|
||||
|
||||
if Reverse_Storage_Order (Base_Type (Atyp))
|
||||
and then Esize (T) > 8
|
||||
and then not In_Reverse_Storage_Order_Object (Obj)
|
||||
then
|
||||
Require_Byte_Swapping := True;
|
||||
New_Rhs := Byte_Swap (New_Rhs,
|
||||
Left_Justify => Bytes_Big_Endian,
|
||||
Right_Justify => not Bytes_Big_Endian);
|
||||
end if;
|
||||
end;
|
||||
New_Lhs := Duplicate_Subexpr (Obj, Name_Req => True);
|
||||
New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
|
||||
|
||||
-- First we deal with the "and"
|
||||
|
||||
@ -1703,13 +1680,6 @@ package body Exp_Pakd is
|
||||
Set_Etype (New_Rhs, Etype (Left_Opnd (New_Rhs)));
|
||||
end if;
|
||||
|
||||
-- If New_Rhs has been byte swapped, need to convert Or_Rhs
|
||||
-- to the return type of the byte swapping function now.
|
||||
|
||||
if Require_Byte_Swapping then
|
||||
Or_Rhs := Unchecked_Convert_To (Etype (New_Rhs), Or_Rhs);
|
||||
end if;
|
||||
|
||||
New_Rhs :=
|
||||
Make_Op_Or (Loc,
|
||||
Left_Opnd => New_Rhs,
|
||||
@ -1717,15 +1687,6 @@ package body Exp_Pakd is
|
||||
end;
|
||||
end if;
|
||||
|
||||
if Require_Byte_Swapping then
|
||||
Set_Etype (New_Rhs, Etype (Obj));
|
||||
New_Rhs :=
|
||||
Unchecked_Convert_To (Etype (Obj),
|
||||
Byte_Swap (New_Rhs,
|
||||
Left_Justify => not Bytes_Big_Endian,
|
||||
Right_Justify => Bytes_Big_Endian));
|
||||
end if;
|
||||
|
||||
-- Now do the rewrite
|
||||
|
||||
Rewrite (N,
|
||||
@ -2043,11 +2004,6 @@ package body Exp_Pakd is
|
||||
Lit : Node_Id;
|
||||
Arg : Node_Id;
|
||||
|
||||
Byte_Swapped : Boolean;
|
||||
-- Set true if bytes were swapped for the purpose of extracting the
|
||||
-- element, in which case we must swap back if the component type is
|
||||
-- a composite type with reverse scalar storage order.
|
||||
|
||||
begin
|
||||
-- If the node is an actual in a call, the prefix has not been fully
|
||||
-- expanded, to account for the additional expansion for in-out actuals
|
||||
@ -2106,23 +2062,6 @@ package body Exp_Pakd is
|
||||
Lit := Make_Integer_Literal (Loc, Cmask);
|
||||
Set_Print_In_Hex (Lit);
|
||||
|
||||
-- Byte swapping required for the Reverse_Storage_Order case, but
|
||||
-- only for a free-standing object (see note on Require_Byte_Swapping
|
||||
-- in Expand_Bit_Packed_Element_Set).
|
||||
|
||||
if Reverse_Storage_Order (Atyp)
|
||||
and then Esize (Atyp) > 8
|
||||
and then not In_Reverse_Storage_Order_Object (Obj)
|
||||
then
|
||||
Obj := Byte_Swap (Obj,
|
||||
Left_Justify => Bytes_Big_Endian,
|
||||
Right_Justify => not Bytes_Big_Endian);
|
||||
Byte_Swapped := True;
|
||||
|
||||
else
|
||||
Byte_Swapped := False;
|
||||
end if;
|
||||
|
||||
-- We generate a shift right to position the field, followed by a
|
||||
-- masking operation to extract the bit field, and we finally do an
|
||||
-- unchecked conversion to convert the result to the required target.
|
||||
@ -2137,12 +2076,16 @@ package body Exp_Pakd is
|
||||
Make_Op_And (Loc,
|
||||
Left_Opnd => Make_Shift_Right (Obj, Shift),
|
||||
Right_Opnd => Lit);
|
||||
|
||||
-- Swap back if necessary
|
||||
|
||||
Set_Etype (Arg, Ctyp);
|
||||
|
||||
if Byte_Swapped
|
||||
-- Component extraction is performed on a native endianness scalar
|
||||
-- value: if Atyp has reverse storage order, then it has been byte
|
||||
-- swapped, and if the component being extracted is itself of a
|
||||
-- composite type with reverse storage order, then we need to swap
|
||||
-- it back to its expected endianness after extraction.
|
||||
|
||||
if Reverse_Storage_Order (Atyp)
|
||||
and then Esize (Atyp) > 8
|
||||
and then (Is_Record_Type (Ctyp) or else Is_Array_Type (Ctyp))
|
||||
and then Reverse_Storage_Order (Ctyp)
|
||||
then
|
||||
|
||||
@ -1083,6 +1083,10 @@ 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).
|
||||
|
||||
Comp_SSO_Differs : Boolean;
|
||||
-- Set True when the component is a nested composite, and it does not
|
||||
-- have the same scalar storage order as Encl_Type.
|
||||
|
||||
Component_Aliased : Boolean;
|
||||
|
||||
begin
|
||||
@ -1136,28 +1140,42 @@ package body Freeze is
|
||||
-- attribute on Comp_Type if composite.
|
||||
|
||||
elsif Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then
|
||||
Comp_SSO_Differs :=
|
||||
Reverse_Storage_Order (Encl_Type)
|
||||
/=
|
||||
Reverse_Storage_Order (Comp_Type);
|
||||
|
||||
if Present (Comp) and then Chars (Comp) = Name_uParent then
|
||||
if Reverse_Storage_Order (Encl_Type)
|
||||
/=
|
||||
Reverse_Storage_Order (Comp_Type)
|
||||
then
|
||||
if Comp_SSO_Differs then
|
||||
Error_Msg_N
|
||||
("record extension must have same scalar storage order as "
|
||||
& "parent", Err_Node);
|
||||
end if;
|
||||
|
||||
elsif No (ADC) then
|
||||
elsif No (Comp_ADC) then
|
||||
Error_Msg_N ("nested composite must have explicit scalar "
|
||||
& "storage order", Err_Node);
|
||||
|
||||
elsif (Reverse_Storage_Order (Encl_Type)
|
||||
/=
|
||||
Reverse_Storage_Order (Comp_Type))
|
||||
and then not Comp_Byte_Aligned
|
||||
then
|
||||
Error_Msg_N
|
||||
("type of non-byte-aligned component must have same scalar "
|
||||
& "storage order as enclosing composite", Err_Node);
|
||||
elsif Comp_SSO_Differs then
|
||||
|
||||
-- Component SSO differs from enclosing composite:
|
||||
|
||||
-- Reject if component is a packed array, as it may be represented
|
||||
-- as a scalar internally.
|
||||
|
||||
if Is_Packed (Comp_Type) then
|
||||
Error_Msg_N
|
||||
("type of packed component must have same scalar "
|
||||
& "storage order as enclosing composite", Err_Node);
|
||||
|
||||
-- Reject if not byte aligned
|
||||
|
||||
elsif not Comp_Byte_Aligned then
|
||||
Error_Msg_N
|
||||
("type of non-byte-aligned component must have same scalar "
|
||||
& "storage order as enclosing composite", Err_Node);
|
||||
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Enclosing type has explicit SSO, non-composite component must not
|
||||
|
||||
@ -562,8 +562,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
|
||||
s-vxwext.adb<s-vxwext-rtp.adb \
|
||||
s-tpopsp.adb<s-tpopsp-vxworks-rtp.adb \
|
||||
system.ads<system-vxworks-$(ARCH_STR)-rtp.ads
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
|
||||
else
|
||||
ifeq ($(strip $(filter-out rtp-smp,$(THREAD_KIND))),)
|
||||
LIBGNAT_TARGET_PAIRS += \
|
||||
@ -573,7 +571,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
|
||||
s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
|
||||
system.ads<system-vxworks-$(ARCH_STR)-rtp.ads
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
|
||||
EXTRA_LIBGNAT_OBJS+=affinity.o
|
||||
else
|
||||
ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
|
||||
@ -603,7 +600,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
|
||||
system.ads<system-vxworks-ppc.ads
|
||||
endif
|
||||
endif
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
|
||||
EXTRA_LIBGNAT_OBJS+=sigtramp-ppcvxw.o
|
||||
endif
|
||||
endif
|
||||
@ -650,7 +647,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(target_cpu) $(target_vendor)
|
||||
mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
|
||||
indepsw.adb<indepsw-gnu.adb
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
|
||||
|
||||
EXTRA_LIBGNAT_OBJS+=sigtramp-ppcvxw.o
|
||||
@ -714,7 +711,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(target_cpu) $(target_vendo
|
||||
mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
|
||||
indepsw.adb<indepsw-gnu.adb
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o s-vxwexc.o
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
|
||||
|
||||
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o sigtramp-ppcvxw.o
|
||||
@ -736,8 +733,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
|
||||
LIBGNAT_TARGET_PAIRS = \
|
||||
a-elchha.adb<a-elchha-vxworks-ppc-full.adb \
|
||||
a-intnam.ads<a-intnam-vxworks.ads \
|
||||
a-sytaco.ads<1asytaco.ads \
|
||||
a-sytaco.adb<1asytaco.adb \
|
||||
a-numaux.ads<a-numaux-vxworks.ads \
|
||||
g-io.adb<g-io-vxworks-ppc-cert.adb \
|
||||
s-inmaop.adb<s-inmaop-vxworks.adb \
|
||||
s-interr.adb<s-interr-hwint.adb \
|
||||
@ -747,6 +743,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
|
||||
s-osinte.ads<s-osinte-vxworks.ads \
|
||||
s-osprim.adb<s-osprim-vxworks.adb \
|
||||
s-parame.ads<s-parame-ae653.ads \
|
||||
s-parame.adb<s-parame-vxworks.adb \
|
||||
s-taprop.adb<s-taprop-vxworks.adb \
|
||||
s-tasinf.ads<s-tasinf-vxworks.ads \
|
||||
s-taspri.ads<s-taspri-vxworks.ads \
|
||||
@ -754,17 +751,20 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(target_cpu) $(target_
|
||||
s-vxwext.adb<s-vxwext-noints.adb \
|
||||
s-vxwext.ads<s-vxwext-vthreads.ads \
|
||||
s-vxwork.ads<s-vxwork-x86.ads \
|
||||
system.ads<system-vxworks-x86.ads \
|
||||
$(ATOMICS_TARGET_PAIRS) \
|
||||
$(X86_TARGET_PAIRS) \
|
||||
system.ads<system-vxworks-x86.ads
|
||||
$(ATOMICS_BUILTINS_TARGET_PAIRS)
|
||||
|
||||
TOOLS_TARGET_PAIRS=\
|
||||
mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
|
||||
indepsw.adb<indepsw-gnu.adb
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
|
||||
|
||||
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o # sigtramp-ppcvxw.o
|
||||
GNATRTL_SOCKETS_OBJS =
|
||||
|
||||
# Extra pairs for the vthreads runtime
|
||||
ifeq ($(strip $(filter-out vthreads,$(THREAD_KIND))),)
|
||||
LIBGNAT_TARGET_PAIRS += \
|
||||
@ -887,7 +887,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
|
||||
s-tpopsp.adb<s-tpopsp-vxworks-rtp.adb \
|
||||
system.ads<system-vxworks-x86-rtp.ads
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
|
||||
else
|
||||
ifeq ($(strip $(filter-out rtp-smp, $(THREAD_KIND))),)
|
||||
LIBGNAT_TARGET_PAIRS += \
|
||||
@ -897,7 +896,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
|
||||
s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
|
||||
system.ads<system-vxworks-x86-rtp.ads
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
|
||||
EXTRA_LIBGNAT_OBJS+=affinity.o
|
||||
else
|
||||
ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),)
|
||||
@ -925,7 +923,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(target_cpu) $(target_vendor) $(targ
|
||||
endif
|
||||
endif
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
|
||||
endif
|
||||
endif
|
||||
EXTRA_GNATRTL_TASKING_OBJS += s-vxwork.o s-vxwext.o
|
||||
@ -2421,7 +2419,7 @@ ADA_EXCLUDE_SRCS =\
|
||||
s-po32gl.adb s-po32gl.ads \
|
||||
s-stache.adb s-stache.ads \
|
||||
s-thread.ads \
|
||||
s-vxwexc.adb s-vxwexc.ads s-vxwext.adb s-vxwext.ads \
|
||||
s-vxwext.adb s-vxwext.ads \
|
||||
s-win32.ads s-winext.ads \
|
||||
g-regist.adb g-regist.ads g-sse.ads g-ssvety.ads \
|
||||
i-vxwoio.adb i-vxwoio.ads i-vxwork.ads \
|
||||
|
||||
@ -3171,8 +3171,8 @@ The following packages are currently supported in project files
|
||||
@b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
|
||||
package @code{Builder}.
|
||||
@item ^Gnatls^Gnatls^
|
||||
This package the options to use when invoking @command{gnatls} via the
|
||||
@command{gnat} driver.
|
||||
This package specifies the options to use when invoking @command{gnatls}
|
||||
via the @command{gnat} driver.
|
||||
@item ^Gnatstub^Gnatstub^
|
||||
This package specifies the options used when calling the tool
|
||||
@command{gnatstub} via the @command{gnat} driver. Its attributes
|
||||
|
||||
@ -105,6 +105,11 @@ package body Sem_Ch10 is
|
||||
-- N is the compilation unit whose list of context items receives the
|
||||
-- implicit with_clauses.
|
||||
|
||||
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id);
|
||||
-- Generate cross-reference information for the parents of child units
|
||||
-- and of subunits. N is a defining_program_unit_name, and P_Id is the
|
||||
-- immediate parent scope.
|
||||
|
||||
function Get_Parent_Entity (Unit : Node_Id) return Entity_Id;
|
||||
-- Get defining entity of parent unit of a child unit. In most cases this
|
||||
-- is the defining entity of the unit, but for a child instance whose
|
||||
@ -261,10 +266,6 @@ package body Sem_Ch10 is
|
||||
-- Spec_Context_Items to that of the spec. Parent packages are not
|
||||
-- examined for documentation purposes.
|
||||
|
||||
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id);
|
||||
-- Generate cross-reference information for the parents of child units.
|
||||
-- N is a defining_program_unit_name, and P_Id is the immediate parent.
|
||||
|
||||
---------------------------
|
||||
-- Check_Redundant_Withs --
|
||||
---------------------------
|
||||
@ -598,45 +599,6 @@ package body Sem_Ch10 is
|
||||
end loop;
|
||||
end Check_Redundant_Withs;
|
||||
|
||||
--------------------------------
|
||||
-- Generate_Parent_References --
|
||||
--------------------------------
|
||||
|
||||
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id) is
|
||||
Pref : Node_Id;
|
||||
P_Name : Entity_Id := P_Id;
|
||||
|
||||
begin
|
||||
Pref := Name (Parent (Defining_Entity (N)));
|
||||
|
||||
if Nkind (Pref) = N_Expanded_Name then
|
||||
|
||||
-- Done already, if the unit has been compiled indirectly as
|
||||
-- part of the closure of its context because of inlining.
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
||||
while Nkind (Pref) = N_Selected_Component loop
|
||||
Change_Selected_Component_To_Expanded_Name (Pref);
|
||||
Set_Entity (Pref, P_Name);
|
||||
Set_Etype (Pref, Etype (P_Name));
|
||||
Generate_Reference (P_Name, Pref, 'r');
|
||||
Pref := Prefix (Pref);
|
||||
P_Name := Scope (P_Name);
|
||||
end loop;
|
||||
|
||||
-- The guard here on P_Name is to handle the error condition where
|
||||
-- the parent unit is missing because the file was not found.
|
||||
|
||||
if Present (P_Name) then
|
||||
Set_Entity (Pref, P_Name);
|
||||
Set_Etype (Pref, Etype (P_Name));
|
||||
Generate_Reference (P_Name, Pref, 'r');
|
||||
Style.Check_Identifier (Pref, P_Name);
|
||||
end if;
|
||||
end Generate_Parent_References;
|
||||
|
||||
-- Start of processing for Analyze_Compilation_Unit
|
||||
|
||||
begin
|
||||
@ -865,9 +827,9 @@ package body Sem_Ch10 is
|
||||
if Nkind (Defining_Unit_Name (Specification (Unit_Node))) =
|
||||
N_Defining_Program_Unit_Name
|
||||
then
|
||||
Generate_Parent_References (
|
||||
Specification (Unit_Node),
|
||||
Scope (Defining_Entity (Unit (Lib_Unit))));
|
||||
Generate_Parent_References
|
||||
(Specification (Unit_Node),
|
||||
Scope (Defining_Entity (Unit (Lib_Unit))));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
@ -906,8 +868,8 @@ package body Sem_Ch10 is
|
||||
|
||||
-- Set the entities of all parents in the program_unit_name
|
||||
|
||||
Generate_Parent_References (
|
||||
Unit_Node, Get_Parent_Entity (Unit (Parent_Spec (Unit_Node))));
|
||||
Generate_Parent_References
|
||||
(Unit_Node, Get_Parent_Entity (Unit (Parent_Spec (Unit_Node))));
|
||||
end if;
|
||||
|
||||
-- All components of the context: with-clauses, library unit, ancestors
|
||||
@ -2326,6 +2288,7 @@ package body Sem_Ch10 is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Generate_Parent_References (Unit (N), Par_Unit);
|
||||
Analyze (Proper_Body (Unit (N)));
|
||||
Remove_Context (N);
|
||||
|
||||
@ -3056,6 +3019,49 @@ package body Sem_Ch10 is
|
||||
end if;
|
||||
end Expand_With_Clause;
|
||||
|
||||
--------------------------------
|
||||
-- Generate_Parent_References --
|
||||
--------------------------------
|
||||
|
||||
procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id) is
|
||||
Pref : Node_Id;
|
||||
P_Name : Entity_Id := P_Id;
|
||||
|
||||
begin
|
||||
if Nkind (N) = N_Subunit then
|
||||
Pref := Name (N);
|
||||
else
|
||||
Pref := Name (Parent (Defining_Entity (N)));
|
||||
end if;
|
||||
|
||||
if Nkind (Pref) = N_Expanded_Name then
|
||||
|
||||
-- Done already, if the unit has been compiled indirectly as
|
||||
-- part of the closure of its context because of inlining.
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
||||
while Nkind (Pref) = N_Selected_Component loop
|
||||
Change_Selected_Component_To_Expanded_Name (Pref);
|
||||
Set_Entity (Pref, P_Name);
|
||||
Set_Etype (Pref, Etype (P_Name));
|
||||
Generate_Reference (P_Name, Pref, 'r');
|
||||
Pref := Prefix (Pref);
|
||||
P_Name := Scope (P_Name);
|
||||
end loop;
|
||||
|
||||
-- The guard here on P_Name is to handle the error condition where
|
||||
-- the parent unit is missing because the file was not found.
|
||||
|
||||
if Present (P_Name) then
|
||||
Set_Entity (Pref, P_Name);
|
||||
Set_Etype (Pref, Etype (P_Name));
|
||||
Generate_Reference (P_Name, Pref, 'r');
|
||||
Style.Check_Identifier (Pref, P_Name);
|
||||
end if;
|
||||
end Generate_Parent_References;
|
||||
|
||||
-----------------------
|
||||
-- Get_Parent_Entity --
|
||||
-----------------------
|
||||
|
||||
@ -4652,15 +4652,16 @@ package body Sem_Ch4 is
|
||||
Set_Etype (Sel, Etype (Comp));
|
||||
Set_Etype (N, Etype (Comp));
|
||||
|
||||
-- Emit appropriate message. Gigi will replace the node
|
||||
-- subsequently with the appropriate Raise.
|
||||
-- Emit appropriate message. The node will be replaced
|
||||
-- by an appropriate raise statement.
|
||||
|
||||
-- In SPARK mode, this is made into an error to simplify
|
||||
-- the processing of the formal verification backend.
|
||||
-- Note that in SPARK mode, as with all calls to apply a
|
||||
-- compile time constraint error, this will be made into
|
||||
-- an error to simplify the processing of the formal
|
||||
-- verification backend.
|
||||
|
||||
Error_Msg_Warn := SPARK_Mode /= On;
|
||||
Apply_Compile_Time_Constraint_Error
|
||||
(N, "component not present in }<<",
|
||||
(N, "component not present in }??",
|
||||
CE_Discriminant_Check_Failed,
|
||||
Ent => Prefix_Type, Rep => False);
|
||||
|
||||
|
||||
@ -122,7 +122,7 @@ package Sem_Util is
|
||||
-- is present, this is used instead. Warn is normally False. If it is
|
||||
-- True then the message is treated as a warning even though it does
|
||||
-- not end with a ? (this is used when the caller wants to parameterize
|
||||
-- whether an error or warning is given.
|
||||
-- whether an error or warning is given).
|
||||
|
||||
function Async_Readers_Enabled (Id : Entity_Id) return Boolean;
|
||||
-- Given the entity of an abstract state or a variable, determine whether
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user