+2015-11-25 Bob Duff <duff@adacore.com>
+
+ * sem_elab.adb (Check_Internal_Call_Continue): Code clean ups.
+
+2015-11-25 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_util.ads (Has_Compatible_Alignment): Add Layout_Done
+ parameter.
+ * sem_util.adb (Has_Compatible_Alignment): Likewise.
+ (Has_Compatible_Alignment_Internal): Likewise. Do not set the
+ result to Unknown for packed types if Layout_Done is true.
+ * checks.adb (Apply_Address_Clause_Check): Adjust call and
+ pass False to Has_Compatible_Alignment.
+ * sem_ch13.adb (Validate_Address_Clauses): Likewise but pass True.
+
2015-11-25 Vincent Celier <celier@adacore.com>
* gnatcmd.adb: When <target>-gnat is called with switch -P
end if;
end;
- -- If the expression has the form X'Address, then we can find out if
- -- the object X has an alignment that is compatible with the object E.
- -- If it hasn't or we don't know, we defer issuing the warning until
- -- the end of the compilation to take into account back end annotations.
+ -- If the expression has the form X'Address, then we can find out if the
+ -- object X has an alignment that is compatible with the object E. If it
+ -- hasn't or we don't know, we defer issuing the warning until the end
+ -- of the compilation to take into account back end annotations.
elsif Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) = Name_Address
- and then Has_Compatible_Alignment (E, Prefix (Expr)) = Known_Compatible
+ and then
+ Has_Compatible_Alignment (E, Prefix (Expr), False) = Known_Compatible
then
return;
end if;
and then X_Size > Uint_0
and then X_Size > Y_Size
then
- Error_Msg_NE
- ("??& overlays smaller object", ACCR.N, ACCR.X);
+ Error_Msg_NE ("??& overlays smaller object", ACCR.N, ACCR.X);
Error_Msg_N
("\??program execution may be erroneous", ACCR.N);
+
Error_Msg_Uint_1 := X_Size;
- Error_Msg_NE
- ("\??size of & is ^", ACCR.N, ACCR.X);
+ Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.X);
+
Error_Msg_Uint_1 := Y_Size;
- Error_Msg_NE
- ("\??size of & is ^", ACCR.N, ACCR.Y);
+ Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y);
-- Check for inadequate alignment, both of the base object
-- and of the offset, if any. We only do this check if the
elsif not Alignment_Checks_Suppressed (ACCR.Y)
and then Y_Alignment /= Uint_0
- and then (Y_Alignment < X_Alignment
- or else (ACCR.Off
- and then
- Nkind (Expr) = N_Attribute_Reference
- and then
- Attribute_Name (Expr) = Name_Address
- and then
- Has_Compatible_Alignment
- (ACCR.X, Prefix (Expr))
- /= Known_Compatible))
+ and then
+ (Y_Alignment < X_Alignment
+ or else
+ (ACCR.Off
+ and then Nkind (Expr) = N_Attribute_Reference
+ and then Attribute_Name (Expr) = Name_Address
+ and then Has_Compatible_Alignment
+ (ACCR.X, Prefix (Expr), True) /=
+ Known_Compatible))
then
Error_Msg_NE
- ("??specified address for& may be inconsistent "
- & "with alignment", ACCR.N, ACCR.X);
+ ("??specified address for& may be inconsistent with "
+ & "alignment", ACCR.N, ACCR.X);
Error_Msg_N
("\??program execution may be erroneous (RM 13.3(27))",
ACCR.N);
+
Error_Msg_Uint_1 := X_Alignment;
- Error_Msg_NE
- ("\??alignment of & is ^", ACCR.N, ACCR.X);
+ Error_Msg_NE ("\??alignment of & is ^", ACCR.N, ACCR.X);
+
Error_Msg_Uint_1 := Y_Alignment;
- Error_Msg_NE
- ("\??alignment of & is ^", ACCR.N, ACCR.Y);
+ Error_Msg_NE ("\??alignment of & is ^", ACCR.N, ACCR.Y);
+
if Y_Alignment >= X_Alignment then
Error_Msg_N
- ("\??but offset is not multiple of alignment", ACCR.N);
+ ("\??but offset is not multiple of alignment", ACCR.N);
end if;
end if;
end if;
------------------------------
function Has_Compatible_Alignment
- (Obj : Entity_Id;
- Expr : Node_Id) return Alignment_Result
+ (Obj : Entity_Id;
+ Expr : Node_Id;
+ Layout_Done : Boolean) return Alignment_Result
is
function Has_Compatible_Alignment_Internal
- (Obj : Entity_Id;
- Expr : Node_Id;
- Default : Alignment_Result) return Alignment_Result;
+ (Obj : Entity_Id;
+ Expr : Node_Id;
+ Layout_Done : Boolean;
+ Default : Alignment_Result) return Alignment_Result;
-- This is the internal recursive function that actually does the work.
-- There is one additional parameter, which says what the result should
-- be if no alignment information is found, and there is no definite
---------------------------------------
function Has_Compatible_Alignment_Internal
- (Obj : Entity_Id;
- Expr : Node_Id;
- Default : Alignment_Result) return Alignment_Result
+ (Obj : Entity_Id;
+ Expr : Node_Id;
+ Layout_Done : Boolean;
+ Default : Alignment_Result) return Alignment_Result
is
Result : Alignment_Result := Known_Compatible;
-- Holds the current status of the result. Note that once a value of
then
Set_Result
(Has_Compatible_Alignment_Internal
- (Obj, Prefix (Expr), Known_Compatible));
+ (Obj, Prefix (Expr), Layout_Done, Known_Compatible));
-- In all other cases, we need a full check on the prefix
else
Set_Result
(Has_Compatible_Alignment_Internal
- (Obj, Prefix (Expr), Unknown));
+ (Obj, Prefix (Expr), Layout_Done, Unknown));
end if;
end Check_Prefix;
begin
-- If Expr is a selected component, we must make sure there is no
- -- potentially troublesome component clause, and that the record is
- -- not packed.
+ -- potentially troublesome component clause and that the record is
+ -- not packed if the layout is not done.
if Nkind (Expr) = N_Selected_Component then
- -- Packed record always generate unknown alignment
+ -- Packing generates unknown alignment if layout is not done
- if Is_Packed (Etype (Prefix (Expr))) then
+ if Is_Packed (Etype (Prefix (Expr))) and then not Layout_Done then
Set_Result (Unknown);
end if;
-- If Expr is an indexed component, we must make sure there is no
-- potentially troublesome Component_Size clause and that the array
- -- is not bit-packed.
+ -- is not bit-packed if the layout is not done.
elsif Nkind (Expr) = N_Indexed_Component then
declare
Ind : constant Node_Id := First_Index (Typ);
begin
- -- Bit packed array always generates unknown alignment
+ -- Packing generates unknown alignment if layout is not done
- if Is_Bit_Packed_Array (Typ) then
+ if Is_Bit_Packed_Array (Typ) and then not Layout_Done then
Set_Result (Unknown);
end if;
-- Now do the internal call that does all the work
- return Has_Compatible_Alignment_Internal (Obj, Expr, Unknown);
+ return
+ Has_Compatible_Alignment_Internal (Obj, Expr, Layout_Done, Unknown);
end Has_Compatible_Alignment;
----------------------
-- that the values are arranged in increasing order of problematicness.
function Has_Compatible_Alignment
- (Obj : Entity_Id;
- Expr : Node_Id) return Alignment_Result;
+ (Obj : Entity_Id;
+ Expr : Node_Id;
+ Layout_Done : Boolean) return Alignment_Result;
-- Obj is an object entity, and expr is a node for an object reference. If
-- the alignment of the object referenced by Expr is known to be compatible
-- with the alignment of Obj (i.e. is larger or the same), then the result
-- is Known_Compatible. If the alignment of the object referenced by Expr
-- is known to be less than the alignment of Obj, then Known_Incompatible
-- is returned. If neither condition can be reliably established at compile
- -- time, then Unknown is returned. This is used to determine if alignment
- -- checks are required for address clauses, and also whether copies must
- -- be made when objects are passed by reference.
+ -- time, then Unknown is returned. If Layout_Done is True, the function can
+ -- assume that the information on size and alignment of types and objects
+ -- is present in the tree. This is used to determine if alignment checks
+ -- are required for address clauses (Layout_Done is False in this case) as
+ -- well as to issue appropriate warnings for them in the post compilation
+ -- phase (Layout_Done is True in this case).
--
-- Note: Known_Incompatible does not mean that at run time the alignment
-- of Expr is known to be wrong for Obj, just that it can be determined
projects / gcc.git / commitdiff