Compilation was stopping on errors in Alfa mode due to incorrect generation of
a type, and inconsistent treatment of packing.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-29 Yannick Moy <m...@adacore.com>
* freeze.adb (Freeze_Record_Type): Ignore packing in Alfa mode, like
in CodePeer mode.
* sem_ch3.adb (Signed_Integer_Type_Declaration): Correct the generation
of an explicitly declared type, so that the base types of the original
type and this generated type are the same, and a "type" (not a subtype
like previously).
* errout.adb (Special_Msg_Delete): Do not issue messages "Size too
small" in Alfa mode, like in CodePeer mode.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore rep
clauses in Alfa mode.
Index: errout.adb
===================================================================
--- errout.adb (revision 178155)
+++ errout.adb (working copy)
@@ -2832,10 +2832,10 @@
elsif Msg = "size for& too small, minimum allowed is ^" then
- -- Suppress "size too small" errors in CodePeer mode, since pragma
- -- Pack is also ignored in this configuration.
+ -- Suppress "size too small" errors in CodePeer mode and ALFA mode,
+ -- since pragma Pack is also ignored in this configuration.
- if CodePeer_Mode then
+ if CodePeer_Mode or ALFA_Mode then
return True;
-- When a size is wrong for a frozen type there is no explicit size
Index: freeze.adb
===================================================================
--- freeze.adb (revision 178205)
+++ freeze.adb (working copy)
@@ -2246,12 +2246,14 @@
and then RM_Size (Rec) >= Scalar_Component_Total_RM_Size
- -- Never do implicit packing in CodePeer mode since we don't do
- -- any packing in this mode, since this generates over-complex
- -- code that confuses CodePeer, and in general, CodePeer does not
- -- care about the internal representation of objects.
+ -- Never do implicit packing in CodePeer or ALFA modes since
+ -- we don't do any packing in this mode, since this generates
+ -- over-complex code that confuses static analysis, and in
+ -- general, neither CodePeer not GNATprove care about the
+ -- internal representation of objects.
and then not CodePeer_Mode
+ and then not ALFA_Mode
then
-- If implicit packing enabled, do it
@@ -3066,6 +3068,7 @@
and then not Is_Packed (Root_Type (E))
and then not Has_Component_Size_Clause (Root_Type (E))
and then not CodePeer_Mode
+ and then not ALFA_Mode
then
Get_Index_Bounds (First_Index (E), Lo, Hi);
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 178205)
+++ sem_ch13.adb (working copy)
@@ -2004,9 +2004,10 @@
end if;
-- Process Ignore_Rep_Clauses option (we also ignore rep clauses in
- -- CodePeer mode, since they are not relevant in that context).
+ -- CodePeer mode or ALFA mode, since they are not relevant in these
+ -- contexts).
- if Ignore_Rep_Clauses or CodePeer_Mode then
+ if Ignore_Rep_Clauses or CodePeer_Mode or ALFA_Mode then
case Id is
-- The following should be ignored. They do not affect legality
@@ -2026,8 +2027,8 @@
Rewrite (N, Make_Null_Statement (Sloc (N)));
return;
- -- We do not want too ignore 'Small in CodePeer_Mode, since it
- -- has an impact on the exact computations performed.
+ -- We do not want too ignore 'Small in CodePeer_Mode or ALFA_Mode,
+ -- since it has an impact on the exact computations performed.
-- Perhaps 'Small should also not be ignored by
-- Ignore_Rep_Clauses ???
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 178183)
+++ sem_ch3.adb (working copy)
@@ -19771,14 +19771,14 @@
if ALFA_Mode then
-- If the range of the type is already symmetric with a possible
- -- extra negative value, just make the type its own base type.
+ -- extra negative value, leave it this way.
if UI_Le (Lo_Val, Hi_Val)
and then (UI_Eq (Lo_Val, UI_Negate (Hi_Val))
or else
UI_Eq (Lo_Val, UI_Sub (UI_Negate (Hi_Val), Uint_1)))
then
- Set_Etype (T, T);
+ null;
else
declare
@@ -19830,7 +19830,8 @@
High_Bound => Ubound));
Analyze (Decl);
- Set_Etype (Implicit_Base, Implicit_Base);
+ Set_Etype (Implicit_Base, Base_Type (Implicit_Base));
+ Set_Etype (T, Base_Type (Implicit_Base));
Insert_Before (Parent (Def), Decl);
end;
end if;
