[multiple changes]
2014-05-21 Robert Dewar <dewar@adacore.com> * gnatcmd.adb: Minor error msg changes (no upper case letter at start). * sem_ch12.adb, sem_ch5.adb, sem_res.adb, sem_util.adb: Minor reformatting. 2014-05-21 Robert Dewar <dewar@adacore.com> * debug.adb: Debug flag -gnatd.G inhibits static elab tracing via generic formals. * sem_elab.adb (Is_Call_Of_Generic_Formal): Return False if -gnatd.G is set. 2014-05-21 Thomas Quinot <quinot@adacore.com> * exp_pakd.adb (Revert_Storage_Order): Renamed from Byte_Swap to more accurately describe that this subprogram needs to come into play also in cases where no byte swapping is involved, because it also takes care of some required shifts (left-justification of values). 2014-05-21 Thomas Quinot <quinot@adacore.com> * freeze.adb (Check_Component_Storage_Order): Indicate whether a Scalar_Storage_Order attribute definition is present for the component's type. (Freeze_Record_Type): Suppress junk warnings about purportedly junk Bit_Order / Scalar_Storage_Order attribute definitions. 2014-05-21 Robert Dewar <dewar@adacore.com> * sem_ch8.adb (Analyze_Subprogram_Renaming): Put back call to Kill_Elaboration_Checks. 2014-05-21 Gary Dismukes <dismukes@adacore.com> * layout.adb (Assoc_Add): Suppress the optimization of the (E - C1) + C2 case, when the expression type is unsigned and C1 < C2, to avoid creating a negative literal when folding. From-SVN: r210709
This commit is contained in:
parent
ea26c8e414
commit
ee6208f2d5
|
@ -1,3 +1,45 @@
|
|||
2014-05-21 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* gnatcmd.adb: Minor error msg changes (no upper case letter
|
||||
at start).
|
||||
* sem_ch12.adb, sem_ch5.adb, sem_res.adb, sem_util.adb: Minor
|
||||
reformatting.
|
||||
|
||||
2014-05-21 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* debug.adb: Debug flag -gnatd.G inhibits static elab tracing
|
||||
via generic formals.
|
||||
* sem_elab.adb (Is_Call_Of_Generic_Formal): Return False if
|
||||
-gnatd.G is set.
|
||||
|
||||
2014-05-21 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* exp_pakd.adb (Revert_Storage_Order): Renamed from Byte_Swap to
|
||||
more accurately describe that this subprogram needs to come into
|
||||
play also in cases where no byte swapping is involved, because
|
||||
it also takes care of some required shifts (left-justification
|
||||
of values).
|
||||
|
||||
2014-05-21 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* freeze.adb (Check_Component_Storage_Order): Indicate whether
|
||||
a Scalar_Storage_Order attribute definition is present for the
|
||||
component's type.
|
||||
(Freeze_Record_Type): Suppress junk warnings
|
||||
about purportedly junk Bit_Order / Scalar_Storage_Order attribute
|
||||
definitions.
|
||||
|
||||
2014-05-21 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch8.adb (Analyze_Subprogram_Renaming): Put back call
|
||||
to Kill_Elaboration_Checks.
|
||||
|
||||
2014-05-21 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* layout.adb (Assoc_Add): Suppress the optimization of the (E
|
||||
- C1) + C2 case, when the expression type is unsigned and C1 <
|
||||
C2, to avoid creating a negative literal when folding.
|
||||
|
||||
2014-05-21 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* freeze.adb (Freeze_Record_Type): Update the use of
|
||||
|
|
|
@ -124,7 +124,7 @@ package body Debug is
|
|||
-- d.D
|
||||
-- d.E Turn selected errors into warnings
|
||||
-- d.F Debug mode for GNATprove
|
||||
-- d.G
|
||||
-- d.G Ignore calls through generic formal parameters for elaboration
|
||||
-- d.H
|
||||
-- d.I Do not ignore enum representation clauses in CodePeer mode
|
||||
-- d.J Disable parallel SCIL generation mode
|
||||
|
@ -623,6 +623,11 @@ package body Debug is
|
|||
-- d.F Sets GNATprove_Mode to True. This allows debugging the frontend in
|
||||
-- the special mode used by GNATprove.
|
||||
|
||||
-- d.G Previously the compiler ignored calls via generic formal parameters
|
||||
-- when doing the analysis for the static elaboration model. This is
|
||||
-- now fixed, but we provide this debug flag to revert to the previous
|
||||
-- situation of ignoring such calls to aid in transition.
|
||||
|
||||
-- d.I Do not ignore enum representation clauses in CodePeer mode.
|
||||
-- The default of ignoring representation clauses for enumeration
|
||||
-- types in CodePeer is good for the majority of Ada code, but in some
|
||||
|
|
|
@ -543,25 +543,19 @@ package body Exp_Pakd is
|
|||
-- array type on the fly). Such actions are inserted into the tree
|
||||
-- directly using Insert_Action.
|
||||
|
||||
function Byte_Swap
|
||||
(N : Node_Id;
|
||||
Left_Justify : Boolean := False;
|
||||
Right_Justify : Boolean := False) return Node_Id;
|
||||
-- Wrap N in a call to a byte swapping function, with appropriate type
|
||||
-- conversions. If Left_Justify is set True, the value is left justified
|
||||
-- before swapping. If Right_Justify is set True, the value is right
|
||||
-- justified after swapping. The Etype of the returned node is an
|
||||
-- integer type of an appropriate power-of-2 size.
|
||||
function Revert_Storage_Order (N : Node_Id) return Node_Id;
|
||||
-- Perform appropriate justification and byte ordering adjustments for N,
|
||||
-- an element of a packed array type, when both the component type and
|
||||
-- the enclosing packed array type have reverse scalar storage order.
|
||||
-- On little-endian targets, the value is left justified before byte
|
||||
-- swapping. The Etype of the returned expression is an integer type of
|
||||
-- an appropriate power-of-2 size.
|
||||
|
||||
---------------
|
||||
-- Byte_Swap --
|
||||
---------------
|
||||
--------------------------
|
||||
-- Revert_Storage_Order --
|
||||
--------------------------
|
||||
|
||||
function Byte_Swap
|
||||
(N : Node_Id;
|
||||
Left_Justify : Boolean := False;
|
||||
Right_Justify : Boolean := False) return Node_Id
|
||||
is
|
||||
function Revert_Storage_Order (N : Node_Id) return Node_Id is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
T : constant Entity_Id := Etype (N);
|
||||
T_Size : constant Uint := RM_Size (T);
|
||||
|
@ -571,16 +565,21 @@ package body Exp_Pakd is
|
|||
Swap_T : Entity_Id;
|
||||
-- Swapping function
|
||||
|
||||
Arg : Node_Id;
|
||||
Swapped : Node_Id;
|
||||
Shift : Uint;
|
||||
Arg : Node_Id;
|
||||
Adjusted : Node_Id;
|
||||
Shift : Uint;
|
||||
|
||||
begin
|
||||
if T_Size <= 8 then
|
||||
|
||||
-- Array component size is less than a byte: no swapping needed
|
||||
|
||||
Swap_F := Empty;
|
||||
Swap_T := RTE (RE_Unsigned_8);
|
||||
|
||||
else
|
||||
-- Select byte swapping function depending on array component size
|
||||
|
||||
if T_Size <= 16 then
|
||||
Swap_RE := RE_Bswap_16;
|
||||
|
||||
|
@ -600,7 +599,7 @@ package body Exp_Pakd is
|
|||
|
||||
Arg := RJ_Unchecked_Convert_To (Swap_T, N);
|
||||
|
||||
if Left_Justify and then Shift > Uint_0 then
|
||||
if not Bytes_Big_Endian and then Shift > Uint_0 then
|
||||
Arg :=
|
||||
Make_Op_Shift_Left (Loc,
|
||||
Left_Opnd => Arg,
|
||||
|
@ -608,24 +607,17 @@ package body Exp_Pakd is
|
|||
end if;
|
||||
|
||||
if Present (Swap_F) then
|
||||
Swapped :=
|
||||
Adjusted :=
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (Swap_F, Loc),
|
||||
Parameter_Associations => New_List (Arg));
|
||||
else
|
||||
Swapped := Arg;
|
||||
Adjusted := Arg;
|
||||
end if;
|
||||
|
||||
if Right_Justify and then Shift > Uint_0 then
|
||||
Swapped :=
|
||||
Make_Op_Shift_Right (Loc,
|
||||
Left_Opnd => Swapped,
|
||||
Right_Opnd => Make_Integer_Literal (Loc, Shift));
|
||||
end if;
|
||||
|
||||
Set_Etype (Swapped, Swap_T);
|
||||
return Swapped;
|
||||
end Byte_Swap;
|
||||
Set_Etype (Adjusted, Swap_T);
|
||||
return Adjusted;
|
||||
end Revert_Storage_Order;
|
||||
|
||||
------------------------------
|
||||
-- Compute_Linear_Subscript --
|
||||
|
@ -2095,15 +2087,10 @@ package body Exp_Pakd is
|
|||
-- 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
|
||||
Arg :=
|
||||
Byte_Swap
|
||||
(Arg,
|
||||
Left_Justify => not Bytes_Big_Endian,
|
||||
Right_Justify => False);
|
||||
Arg := Revert_Storage_Order (Arg);
|
||||
end if;
|
||||
|
||||
-- We needed to analyze this before we do the unchecked convert
|
||||
|
|
|
@ -90,16 +90,19 @@ package body Freeze is
|
|||
-- performed only after the object has been frozen.
|
||||
|
||||
procedure Check_Component_Storage_Order
|
||||
(Encl_Type : Entity_Id;
|
||||
Comp : Entity_Id;
|
||||
ADC : Node_Id);
|
||||
(Encl_Type : Entity_Id;
|
||||
Comp : Entity_Id;
|
||||
ADC : Node_Id;
|
||||
Comp_ADC_Present : out Boolean);
|
||||
-- For an Encl_Type that has a Scalar_Storage_Order attribute definition
|
||||
-- clause, verify that the component type has an explicit and compatible
|
||||
-- attribute/aspect. For arrays, Comp is Empty; for records, it is the
|
||||
-- entity of the component under consideration. For an Encl_Type that
|
||||
-- does not have a Scalar_Storage_Order attribute definition clause,
|
||||
-- verify that the component also does not have such a clause.
|
||||
-- ADC is the attribute definition clause if present (or Empty).
|
||||
-- ADC is the attribute definition clause if present (or Empty). On return,
|
||||
-- Comp_ADC_Present is set True if the component has a Scalar_Storage_Order
|
||||
-- attribute definition clause.
|
||||
|
||||
procedure Check_Strict_Alignment (E : Entity_Id);
|
||||
-- E is a base type. If E is tagged or has a component that is aliased
|
||||
|
@ -1070,9 +1073,10 @@ package body Freeze is
|
|||
-----------------------------------
|
||||
|
||||
procedure Check_Component_Storage_Order
|
||||
(Encl_Type : Entity_Id;
|
||||
Comp : Entity_Id;
|
||||
ADC : Node_Id)
|
||||
(Encl_Type : Entity_Id;
|
||||
Comp : Entity_Id;
|
||||
ADC : Node_Id;
|
||||
Comp_ADC_Present : out Boolean)
|
||||
is
|
||||
Comp_Type : Entity_Id;
|
||||
Comp_ADC : Node_Id;
|
||||
|
@ -1124,12 +1128,13 @@ package body Freeze is
|
|||
Comp_ADC := Get_Attribute_Definition_Clause
|
||||
(First_Subtype (Comp_Type),
|
||||
Attribute_Scalar_Storage_Order);
|
||||
Comp_ADC_Present := Present (Comp_ADC);
|
||||
|
||||
-- Case of enclosing type not having explicit SSO: component cannot
|
||||
-- have it either.
|
||||
|
||||
if No (ADC) then
|
||||
if Present (Comp_ADC) then
|
||||
if Comp_ADC_Present then
|
||||
Error_Msg_N
|
||||
("composite type must have explicit scalar storage order",
|
||||
Err_Node);
|
||||
|
@ -2350,14 +2355,19 @@ package body Freeze is
|
|||
|
||||
-- Check for scalar storage order
|
||||
|
||||
Check_Component_Storage_Order
|
||||
(Encl_Type => Arr,
|
||||
Comp => Empty,
|
||||
ADC => Get_Attribute_Definition_Clause
|
||||
(First_Subtype (Arr),
|
||||
Attribute_Scalar_Storage_Order));
|
||||
declare
|
||||
Dummy : Boolean;
|
||||
begin
|
||||
Check_Component_Storage_Order
|
||||
(Encl_Type => Arr,
|
||||
Comp => Empty,
|
||||
ADC => Get_Attribute_Definition_Clause
|
||||
(First_Subtype (Arr),
|
||||
Attribute_Scalar_Storage_Order),
|
||||
Comp_ADC_Present => Dummy);
|
||||
end;
|
||||
|
||||
-- Processing that is done only for subtypes
|
||||
-- Processing that is done only for subtypes
|
||||
|
||||
else
|
||||
-- Acquire alignment from base type
|
||||
|
@ -2549,8 +2559,8 @@ package body Freeze is
|
|||
procedure Freeze_Record_Type (Rec : Entity_Id) is
|
||||
Comp : Entity_Id;
|
||||
IR : Node_Id;
|
||||
ADC : Node_Id;
|
||||
Prev : Entity_Id;
|
||||
ADC : Node_Id;
|
||||
|
||||
Junk : Boolean;
|
||||
pragma Warnings (Off, Junk);
|
||||
|
@ -2560,6 +2570,9 @@ package body Freeze is
|
|||
-- stack. Needed for the analysis of delayed aspects specified to the
|
||||
-- components of Rec.
|
||||
|
||||
SSO_ADC : Node_Id;
|
||||
-- Scalar_Storage_Order attribute definition clause for the record
|
||||
|
||||
Unplaced_Component : Boolean := False;
|
||||
-- Set True if we find at least one component with no component
|
||||
-- clause (used to warn about useless Pack pragmas).
|
||||
|
@ -2574,6 +2587,10 @@ package body Freeze is
|
|||
-- is used to prevent Implicit_Packing of the record, since packing
|
||||
-- cannot modify the size of alignment of an aliased component.
|
||||
|
||||
SSO_ADC_Component : Boolean := False;
|
||||
-- Set True if we find at least one component whose type has a
|
||||
-- Scalar_Storage_Order attribute definition clause.
|
||||
|
||||
All_Scalar_Components : Boolean := True;
|
||||
-- Set False if we encounter a component of a non-scalar type
|
||||
|
||||
|
@ -3014,56 +3031,80 @@ package body Freeze is
|
|||
Next_Entity (Comp);
|
||||
end loop;
|
||||
|
||||
ADC := Get_Attribute_Definition_Clause
|
||||
(Rec, Attribute_Scalar_Storage_Order);
|
||||
SSO_ADC := Get_Attribute_Definition_Clause
|
||||
(Rec, Attribute_Scalar_Storage_Order);
|
||||
|
||||
if Present (ADC) then
|
||||
-- Check consistent attribute setting on component types
|
||||
|
||||
declare
|
||||
Comp_ADC_Present : Boolean;
|
||||
begin
|
||||
Comp := First_Component (Rec);
|
||||
while Present (Comp) loop
|
||||
Check_Component_Storage_Order
|
||||
(Encl_Type => Rec,
|
||||
Comp => Comp,
|
||||
ADC => SSO_ADC,
|
||||
Comp_ADC_Present => Comp_ADC_Present);
|
||||
SSO_ADC_Component := SSO_ADC_Component or Comp_ADC_Present;
|
||||
Next_Component (Comp);
|
||||
end loop;
|
||||
end;
|
||||
|
||||
if Present (SSO_ADC) then
|
||||
|
||||
-- Check compatibility of Scalar_Storage_Order with Bit_Order, if
|
||||
-- the former is specified.
|
||||
|
||||
if Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec) then
|
||||
|
||||
-- Note: report error on Rec, not on ADC, as ADC may apply to
|
||||
-- an ancestor type.
|
||||
-- Note: report error on Rec, not on SSO_ADC, as ADC may apply
|
||||
-- to some ancestor type.
|
||||
|
||||
Error_Msg_Sloc := Sloc (ADC);
|
||||
Error_Msg_Sloc := Sloc (SSO_ADC);
|
||||
Error_Msg_N
|
||||
("scalar storage order for& specified# inconsistent with "
|
||||
& "bit order", Rec);
|
||||
end if;
|
||||
|
||||
-- Warn if there is a Scalar_Storage_Order but no component clause
|
||||
-- (or pragma Pack).
|
||||
-- Warn if there is an Scalar_Storage_Order attribute definition
|
||||
-- clause but no component clause, no component that itself has
|
||||
-- such an attribute definition, and no pragma Pack.
|
||||
|
||||
if not (Placed_Component or else Is_Packed (Rec)) then
|
||||
if not (Placed_Component
|
||||
or else
|
||||
SSO_ADC_Component
|
||||
or else
|
||||
Is_Packed (Rec))
|
||||
then
|
||||
Error_Msg_N
|
||||
("??scalar storage order specified but no component clause",
|
||||
ADC);
|
||||
SSO_ADC);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Check consistent attribute setting on component types
|
||||
|
||||
Comp := First_Component (Rec);
|
||||
while Present (Comp) loop
|
||||
Check_Component_Storage_Order
|
||||
(Encl_Type => Rec, Comp => Comp, ADC => ADC);
|
||||
Next_Component (Comp);
|
||||
end loop;
|
||||
|
||||
-- Deal with Bit_Order aspect specifying a non-default bit order
|
||||
-- Deal with Bit_Order aspect
|
||||
|
||||
ADC := Get_Attribute_Definition_Clause (Rec, Attribute_Bit_Order);
|
||||
|
||||
if Present (ADC) and then Base_Type (Rec) = Rec then
|
||||
if not (Placed_Component or else Is_Packed (Rec)) then
|
||||
if not (Placed_Component
|
||||
or else
|
||||
Present (SSO_ADC)
|
||||
or else
|
||||
Is_Packed (Rec))
|
||||
then
|
||||
-- Warn if clause has no effect when no component clause is
|
||||
-- present, but suppress warning if the Bit_Order is required
|
||||
-- due to the presence of a Scalar_Storage_Order attribute.
|
||||
|
||||
Error_Msg_N
|
||||
("??bit order specification has no effect", ADC);
|
||||
Error_Msg_N
|
||||
("\??since no component clauses were specified", ADC);
|
||||
|
||||
-- Here is where we do the processing for reversed bit order
|
||||
-- Here is where we do the processing to adjust component clauses
|
||||
-- for reversed bit order.
|
||||
|
||||
elsif Reverse_Bit_Order (Rec)
|
||||
and then not Reverse_Storage_Order (Rec)
|
||||
|
|
|
@ -1527,7 +1527,7 @@ begin
|
|||
if Command_List (The_Command).VMS_Only then
|
||||
Non_VMS_Usage;
|
||||
Fail
|
||||
("Command """
|
||||
("command """
|
||||
& Command_List (The_Command).Cname.all
|
||||
& """ can only be used on VMS");
|
||||
end if;
|
||||
|
@ -1542,13 +1542,13 @@ begin
|
|||
|
||||
begin
|
||||
Alternate := Alternate_Command'Value
|
||||
(Argument (Command_Arg));
|
||||
(Argument (Command_Arg));
|
||||
The_Command := Corresponding_To (Alternate);
|
||||
|
||||
exception
|
||||
when Constraint_Error =>
|
||||
Non_VMS_Usage;
|
||||
Fail ("Unknown command: " & Argument (Command_Arg));
|
||||
Fail ("unknown command: " & Argument (Command_Arg));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -1578,12 +1578,9 @@ begin
|
|||
|
||||
exception
|
||||
when others =>
|
||||
Put
|
||||
(Standard_Error, "Cannot open argument file """);
|
||||
Put
|
||||
(Standard_Error,
|
||||
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
|
||||
|
||||
Put (Standard_Error, "Cannot open argument file """);
|
||||
Put (Standard_Error,
|
||||
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
|
||||
Put_Line (Standard_Error, """");
|
||||
raise Error_Exit;
|
||||
end;
|
||||
|
@ -1816,7 +1813,7 @@ begin
|
|||
end case;
|
||||
else
|
||||
Fail ("invalid verbosity level: "
|
||||
& Argv (Argv'First + 3 .. Argv'Last));
|
||||
& Argv (Argv'First + 3 .. Argv'Last));
|
||||
end if;
|
||||
|
||||
Remove_Switch (Arg_Num);
|
||||
|
@ -2104,13 +2101,13 @@ begin
|
|||
end if;
|
||||
end;
|
||||
|
||||
if The_Command = Bind
|
||||
or else The_Command = Link
|
||||
or else The_Command = Elim
|
||||
if The_Command = Bind or else
|
||||
The_Command = Link or else
|
||||
The_Command = Elim
|
||||
then
|
||||
if Project.Object_Directory.Name = No_Path then
|
||||
Fail ("project " & Get_Name_String (Project.Display_Name) &
|
||||
" has no object directory");
|
||||
Fail ("project " & Get_Name_String (Project.Display_Name)
|
||||
& " has no object directory");
|
||||
end if;
|
||||
|
||||
Change_Dir (Get_Name_String (Project.Object_Directory.Name));
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2014, 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- --
|
||||
|
@ -353,7 +353,7 @@ package body Layout is
|
|||
|
||||
elsif Nkind (L) = N_Op_Subtract then
|
||||
|
||||
-- (C1 - E) + C2 = (C1 + C2) + E
|
||||
-- (C1 - E) + C2 = (C1 + C2) - E
|
||||
|
||||
if Compile_Time_Known_Value (Sinfo.Left_Opnd (L)) then
|
||||
Rewrite_Integer
|
||||
|
@ -363,7 +363,14 @@ package body Layout is
|
|||
|
||||
-- (E - C1) + C2 = E - (C1 - C2)
|
||||
|
||||
elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L)) then
|
||||
-- If the type is unsigned, then only do the optimization if
|
||||
-- C1 >= C2, to avoid creating a negative literal that can't be
|
||||
-- used with the unsigned type.
|
||||
|
||||
elsif Compile_Time_Known_Value (Sinfo.Right_Opnd (L))
|
||||
and then (not Is_Unsigned_Type (Etype (Sinfo.Right_Opnd (L)))
|
||||
or else Expr_Value (Sinfo.Right_Opnd (L)) >= R)
|
||||
then
|
||||
Rewrite_Integer
|
||||
(Sinfo.Right_Opnd (L),
|
||||
Expr_Value (Sinfo.Right_Opnd (L)) - R);
|
||||
|
|
|
@ -10070,7 +10070,6 @@ package body Sem_Ch12 is
|
|||
|
||||
Set_Corresponding_Spec (Act_Body, Act_Decl_Id);
|
||||
Check_Generic_Actuals (Act_Decl_Id, False);
|
||||
|
||||
Check_Initialized_Types;
|
||||
|
||||
-- Install primitives hidden at the point of the instantiation but
|
||||
|
|
|
@ -1875,7 +1875,6 @@ package body Sem_Ch5 is
|
|||
if No (Elt) then
|
||||
Error_Msg_N
|
||||
("missing Element primitive for iteration", N);
|
||||
|
||||
else
|
||||
Set_Etype (Def_Id, Etype (Elt));
|
||||
end if;
|
||||
|
|
|
@ -2505,26 +2505,25 @@ package body Sem_Ch8 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- At this point, we used to have the following, but we removed it
|
||||
-- because it was certainly wrong for generic formal parameters in
|
||||
-- at least some cases, causing elaboration checks to be skipped.
|
||||
-- Possibly it is helpful in some other cases, but it caused no
|
||||
-- regressions to remove it completely.
|
||||
|
||||
-- There is no need for elaboration checks on the new entity, which may
|
||||
-- be called before the next freezing point where the body will appear.
|
||||
-- Elaboration checks refer to the real entity, not the one created by
|
||||
-- the renaming declaration.
|
||||
|
||||
-- Set_Kill_Elaboration_Checks (New_S, True);
|
||||
Set_Kill_Elaboration_Checks (New_S, True);
|
||||
|
||||
-- If we had a previous error, indicate a completely is present to stop
|
||||
-- junk cascaded messages, but don't take any further action.
|
||||
|
||||
if Etype (Nam) = Any_Type then
|
||||
Set_Has_Completion (New_S);
|
||||
return;
|
||||
|
||||
-- Case where name has the form of a selected component
|
||||
|
||||
elsif Nkind (Nam) = N_Selected_Component then
|
||||
|
||||
-- A prefix of the form A.B can designate an entry of task A, a
|
||||
-- A name which has the form A.B can designate an entry of task A, a
|
||||
-- protected operation of protected object A, or finally a primitive
|
||||
-- operation of object A. In the later case, A is an object of some
|
||||
-- tagged type, or an access type that denotes one such. To further
|
||||
|
@ -2573,6 +2572,8 @@ package body Sem_Ch8 is
|
|||
end if;
|
||||
end;
|
||||
|
||||
-- Case where name is an explicit dereference X.all
|
||||
|
||||
elsif Nkind (Nam) = N_Explicit_Dereference then
|
||||
|
||||
-- Renamed entity is designated by access_to_subprogram expression.
|
||||
|
@ -2581,14 +2582,21 @@ package body Sem_Ch8 is
|
|||
Analyze_Renamed_Dereference (N, New_S, Present (Rename_Spec));
|
||||
return;
|
||||
|
||||
-- Indexed component
|
||||
|
||||
elsif Nkind (Nam) = N_Indexed_Component then
|
||||
Analyze_Renamed_Family_Member (N, New_S, Present (Rename_Spec));
|
||||
return;
|
||||
|
||||
-- Character literal
|
||||
|
||||
elsif Nkind (Nam) = N_Character_Literal then
|
||||
Analyze_Renamed_Character (N, New_S, Present (Rename_Spec));
|
||||
return;
|
||||
|
||||
-- Only remaining case is where we have a non-entity name, or a
|
||||
-- renaming of some other non-overloadable entity.
|
||||
|
||||
elsif not Is_Entity_Name (Nam)
|
||||
or else not Is_Overloadable (Entity (Nam))
|
||||
then
|
||||
|
|
|
@ -552,6 +552,10 @@ package body Sem_Elab is
|
|||
begin
|
||||
return Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
|
||||
|
||||
-- Always return False if debug flag -gnatd.G is set
|
||||
|
||||
and then not Debug_Flag_Dot_GG
|
||||
|
||||
-- For now, we detect this by looking for the strange identifier
|
||||
-- node, whose Chars reflect the name of the generic formal, but
|
||||
-- the Chars of the Entity references the generic actual.
|
||||
|
@ -564,10 +568,12 @@ package body Sem_Elab is
|
|||
|
||||
begin
|
||||
-- If the call is known to be within a local Suppress Elaboration
|
||||
-- pragma, nothing to check. This can happen in task bodies.
|
||||
-- pragma, nothing to check. This can happen in task bodies. But
|
||||
-- we ignore this for a call to a generic formal.
|
||||
|
||||
if Nkind (N) in N_Subprogram_Call
|
||||
and then No_Elaboration_Check (N)
|
||||
and then not Is_Call_Of_Generic_Formal
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
|
|
@ -6583,8 +6583,7 @@ package body Sem_Res is
|
|||
and then Is_SPARK_Volatile (E)
|
||||
and then Comes_From_Source (E)
|
||||
and then
|
||||
(Async_Writers_Enabled (E)
|
||||
or else Effective_Reads_Enabled (E))
|
||||
(Async_Writers_Enabled (E) or else Effective_Reads_Enabled (E))
|
||||
then
|
||||
-- The volatile object can appear on either side of an assignment
|
||||
|
||||
|
|
|
@ -7500,9 +7500,7 @@ package body Sem_Util is
|
|||
|
||||
elsif Property = Name_Effective_Writes
|
||||
and then
|
||||
(Present (EW)
|
||||
or else
|
||||
(No (AR) and then No (AW) and then No (ER)))
|
||||
(Present (EW) or else (No (AR) and then No (AW) and then No (ER)))
|
||||
then
|
||||
return True;
|
||||
|
||||
|
|
Loading…
Reference in New Issue