* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
Component_Size): It is now illegal to give an incorrect component size
clause in the case of aliased or atomic components.
* sem_prag.adb (Analyze_Pragma, case Pack): It is now illegal to give
an effective pragma Pack in the case of aliased or atomic components.
2010-10-07 Steve Baird <baird@adacore.com>
* exp_ch4.adb (Expand_N_Allocator): Do not bypass expansion
in the case of a violation of an active No_Task_Hierarchy restriction.
2010-10-07 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Validate_Derived_Type_Instance): If a formal derived
type is non-limited, an actual for it cannot be limited.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165105
138bc75d-0d04-0410-961f-
82ee72b054a4
2010-10-07 Robert Dewar <dewar@adacore.com>
+ * sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
+ Component_Size): It is now illegal to give an incorrect component size
+ clause in the case of aliased or atomic components.
+ * sem_prag.adb (Analyze_Pragma, case Pack): It is now illegal to give
+ an effective pragma Pack in the case of aliased or atomic components.
+
+2010-10-07 Steve Baird <baird@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Allocator): Do not bypass expansion
+ in the case of a violation of an active No_Task_Hierarchy restriction.
+
+2010-10-07 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Validate_Derived_Type_Instance): If a formal derived
+ type is non-limited, an actual for it cannot be limited.
+
+2010-10-07 Robert Dewar <dewar@adacore.com>
+
* einfo.ads (No_Pool_Assigned): Update documentation.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
Storage_Size): We only set No_Pool_Assigned if the expression is a
if Has_Task (T) then
if No (Master_Id (Base_Type (PtrT))) then
- -- If we have a non-library level task with restriction
- -- No_Task_Hierarchy set, then no point in expanding.
-
- if not Is_Library_Level_Entity (T)
- and then Restriction_Active (No_Task_Hierarchy)
- then
- return;
- end if;
-
-- The designated type was an incomplete type, and the
-- access type did not get expanded. Salvage it now.
-- interface then the generic formal is not unless declared
-- explicitly so. If not declared limited, the actual cannot be
-- limited (see AI05-0087).
- -- Disable check for now, limited interfaces implemented by
- -- protected types are common, Need to update tests ???
+ -- Even though this AI is a binding interpretation, we enable the
+ -- check only in Ada2012 mode, because this improper construct
+ -- shows up in user code and in existing B-tests.
if Is_Limited_Type (Act_T)
and then not Is_Limited_Type (A_Gen_T)
- and then False
+ and then Ada_Version >= Ada_12
then
Error_Msg_NE
("actual for non-limited & cannot be a limited type", Actual,
Biased : Boolean;
New_Ctyp : Entity_Id;
Decl : Node_Id;
+ Ignore : Boolean := False;
+
+ procedure Complain_CS (T : String);
+ -- Outputs error messages for incorrect CS clause for aliased or
+ -- atomic components (T is "aliased" or "atomic");
+
+ -----------------
+ -- Complain_CS --
+ -----------------
+
+ procedure Complain_CS (T : String) is
+ begin
+ if Known_Static_Esize (Ctyp) then
+ Error_Msg_N
+ ("incorrect component size for " & T & " components", N);
+ Error_Msg_Uint_1 := Esize (Ctyp);
+ Error_Msg_N ("\only allowed value is^", N);
+
+ else
+ Error_Msg_N
+ ("component size cannot be given for " & T & " components",
+ N);
+ end if;
+
+ return;
+ end Complain_CS;
+
+ -- Start of processing for Component_Size_Case
begin
if not Is_Array_Type (U_Ent) then
elsif Csize /= No_Uint then
Check_Size (Expr, Ctyp, Csize, Biased);
- if Has_Aliased_Components (Btype)
- and then Csize < 32
- and then Csize /= 8
- and then Csize /= 16
+ -- Case where component size has no effect
+
+ if Known_Static_Esize (Ctyp)
+ and then Known_Static_RM_Size (Ctyp)
+ and then Esize (Ctyp) = RM_Size (Ctyp)
+ and then (Esize (Ctyp) = 8 or else
+ Esize (Ctyp) = 16 or else
+ Esize (Ctyp) = 32 or else
+ Esize (Ctyp) = 64)
then
- Error_Msg_N
- ("component size incorrect for aliased components", N);
- return;
+ Ignore := True;
+
+ -- Cannot give component size for aliased/atomic types
+
+ elsif Has_Aliased_Components (Btype) then
+ Complain_CS ("aliased");
+
+ elsif Has_Atomic_Components (Btype) then
+ Complain_CS ("atomic");
end if;
-- For the biased case, build a declaration for a subtype
end if;
Set_Has_Component_Size_Clause (Btype, True);
- Set_Has_Non_Standard_Rep (Btype, True);
+
+ if not Ignore then
+ Set_Has_Non_Standard_Rep (Btype, True);
+ end if;
end if;
end Component_Size_Case;
E : Entity_Id;
D : Node_Id;
K : Node_Kind;
+ Ctyp : Entity_Id;
begin
Check_Ada_83_Warning;
and then Nkind (Object_Definition (D)) =
N_Constrained_Array_Definition)
then
+ Ctyp := Component_Type (E);
+
-- The flag is set on the object, or on the base type
if Nkind (D) /= N_Object_Declaration then
if Is_Packed (E) then
Set_Is_Packed (E, False);
- Error_Pragma_Arg
- ("?Pack canceled, cannot pack atomic components",
- Arg1);
+ if not (Known_Static_Esize (Ctyp)
+ and then Known_Static_RM_Size (Ctyp)
+ and then Esize (Ctyp) = RM_Size (Ctyp))
+ then
+ Error_Pragma_Arg
+ ("cannot pack atomic components", Arg1);
+ end if;
end if;
end if;
Assoc : constant Node_Id := Arg1;
Type_Id : Node_Id;
Typ : Entity_Id;
+ Ctyp : Entity_Id;
+ Ignore : Boolean := False;
begin
Check_No_Identifiers;
-- Array type
elsif Is_Array_Type (Typ) then
+ Ctyp := Component_Type (Typ);
- -- Pack not allowed for aliased or atomic components
+ -- Ignore pack that does nothing
- if Has_Aliased_Components (Base_Type (Typ)) then
- Error_Pragma
- ("pragma% ignored, cannot pack aliased components?");
+ if Known_Static_Esize (Ctyp)
+ and then Known_Static_RM_Size (Ctyp)
+ and then Esize (Ctyp) = RM_Size (Ctyp)
+ and then (Esize (Ctyp) = 8 or else
+ Esize (Ctyp) = 16 or else
+ Esize (Ctyp) = 32 or else
+ Esize (Ctyp) = 64)
+ then
+ Ignore := True;
+
+ -- Pack not allowed for aliased/atomic components
+
+ elsif Has_Aliased_Components (Base_Type (Typ)) then
+ Error_Pragma ("cannot pack aliased components");
elsif Has_Atomic_Components (Typ)
or else Is_Atomic (Component_Type (Typ))
then
- Error_Pragma
- ("?pragma% ignored, cannot pack atomic components");
+ Error_Pragma ("cannot pack atomic components");
end if;
-- If we had an explicit component size given, then we do not
-- For normal non-VM target, do the packing
elsif VM_Target = No_VM then
- Set_Is_Packed (Base_Type (Typ));
+ if not Ignore then
+ Set_Is_Packed (Base_Type (Typ));
+ Set_Has_Non_Standard_Rep (Base_Type (Typ));
+ end if;
+
Set_Has_Pragma_Pack (Base_Type (Typ));
- Set_Has_Non_Standard_Rep (Base_Type (Typ));
- -- If we ignore the pack, then warn about this, except
- -- that we suppress the warning in GNAT mode.
+ -- If we ignore the pack for VM_Targets, then warn about
+ -- this, except suppress the warning in GNAT mode.
elsif not GNAT_Mode then
Error_Pragma