Skip to content

R
riscv-gcc-1
Commit ffdb3d3b by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r165105
parent 8da337c5
Showing with 108 additions and 33 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/exp_ch4.adb
......@@ -3672,15 +3672,6 @@ package body Exp_Ch4 is
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.
......
gcc/ada/sem_ch12.adb
......@@ -9969,12 +9969,13 @@ package body Sem_Ch12 is
-- 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,
......
gcc/ada/sem_ch13.adb
......@@ -1298,6 +1298,34 @@ package body Sem_Ch13 is
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
......@@ -1315,14 +1343,25 @@ package body Sem_Ch13 is
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
......@@ -1385,7 +1424,10 @@ package body Sem_Ch13 is
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;
......
gcc/ada/sem_prag.adb
......@@ -5912,6 +5912,7 @@ package body Sem_Prag is
E : Entity_Id;
D : Node_Id;
K : Node_Kind;
Ctyp : Entity_Id;
begin
Check_Ada_83_Warning;
......@@ -5943,6 +5944,8 @@ package body Sem_Prag is
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
......@@ -5957,9 +5960,13 @@ package body Sem_Prag is
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;
......@@ -9869,6 +9876,8 @@ package body Sem_Prag is
Assoc : constant Node_Id := Arg1;
Type_Id : Node_Id;
Typ : Entity_Id;
Ctyp : Entity_Id;
Ignore : Boolean := False;
begin
Check_No_Identifiers;
......@@ -9899,18 +9908,29 @@ package body Sem_Prag is
-- 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
......@@ -9944,12 +9964,15 @@ package body Sem_Prag is
-- 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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment