+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
-- 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
-- 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
-- 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.
-
- ---------------
- -- Byte_Swap --
- ---------------
-
- 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;
+ -- 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.
+
+ --------------------------
+ -- Revert_Storage_Order --
+ --------------------------
+
+ 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);
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;
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,
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;
- 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));
+ Adjusted := Arg;
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 --
-- 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
-- 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
-----------------------------------
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;
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);
-- 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
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);
-- 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).
-- 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
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);
+
+ -- 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 (ADC) then
+ 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)
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;
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;
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;
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);
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));
-- --
-- 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- --
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
-- (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);
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
if No (Elt) then
Error_Msg_N
("missing Element primitive for iteration", N);
-
else
Set_Etype (Def_Id, Etype (Elt));
end if;
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
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.
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
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.
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;
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
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;
projects / thirdparty / gcc.git / commitdiff
