Commit 709121b5 by Thomas Quinot Committed by Arnaud Charlet

sem_cat.adb (Validate_Object_Declaration): A variable declaration is not illegal per E.2.2(7) if...

2010-06-18  Thomas Quinot  <quinot@adacore.com>

	* sem_cat.adb (Validate_Object_Declaration): A variable declaration is
	not illegal per E.2.2(7) if it occurs in the private part of a
	Remote_Types unit.

From-SVN: r160984
parent bef228c2
2010-06-18 Thomas Quinot <quinot@adacore.com>
* sem_cat.adb (Validate_Object_Declaration): A variable declaration is
not illegal per E.2.2(7) if it occurs in the private part of a
Remote_Types unit.
2010-06-18 Arnaud Charlet <charlet@adacore.com> 2010-06-18 Arnaud Charlet <charlet@adacore.com>
* par-ch9.adb, sem_aggr.adb, sem_ch3.adb, layout.adb, sem_ch4.adb, * par-ch9.adb, sem_aggr.adb, sem_ch3.adb, layout.adb, sem_ch4.adb,
...@@ -17,7 +23,7 @@ ...@@ -17,7 +23,7 @@
* par-labl.adb, restrict.adb, s-osinte-hpux-dce.ads, sem_ch11.adb, * par-labl.adb, restrict.adb, s-osinte-hpux-dce.ads, sem_ch11.adb,
exp_pakd.adb, s-filofl.ads, par-endh.adb, exp_intr.adb, sem_cat.adb, exp_pakd.adb, s-filofl.ads, par-endh.adb, exp_intr.adb, sem_cat.adb,
sem_case.adb, exp_ch11.adb: Fix copyright notices. sem_case.adb, exp_ch11.adb, s-osinte-linux.ads: Fix copyright notices.
2010-06-18 Geert Bosch <bosch@adacore.com> 2010-06-18 Geert Bosch <bosch@adacore.com>
......
...@@ -78,12 +78,12 @@ package body Sem_Cat is ...@@ -78,12 +78,12 @@ package body Sem_Cat is
function In_RCI_Declaration (N : Node_Id) return Boolean; function In_RCI_Declaration (N : Node_Id) return Boolean;
-- Determines if a declaration is within the visible part of a Remote -- Determines if a declaration is within the visible part of a Remote
-- Call Interface compilation unit, for semantic checking purposes only, -- Call Interface compilation unit, for semantic checking purposes only
-- (returns false within an instance and within the package body). -- (returns false within an instance and within the package body).
function In_RT_Declaration return Boolean; function In_RT_Declaration return Boolean;
-- Determines if current scope is within a Remote Types compilation unit, -- Determines if current scope is within the declaration of a Remote Types
-- for semantic checking purposes. -- unit, for semantic checking purposes.
function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean; function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean;
-- Returns true if the entity is a type whose full view is a non-remote -- Returns true if the entity is a type whose full view is a non-remote
...@@ -1061,27 +1061,25 @@ package body Sem_Cat is ...@@ -1061,27 +1061,25 @@ package body Sem_Cat is
-- Exclude generic specs from the checks (this will get rechecked -- Exclude generic specs from the checks (this will get rechecked
-- on instantiations). -- on instantiations).
if Inside_A_Generic if Inside_A_Generic and then No (Enclosing_Generic_Body (Id)) then
and then No (Enclosing_Generic_Body (Id))
then
return; return;
end if; end if;
-- Required checks for declaration that is in a preelaborated -- Required checks for declaration that is in a preelaborated package
-- package and is not within some subprogram. -- and is not within some subprogram.
if In_Preelaborated_Unit if In_Preelaborated_Unit
and then not In_Subprogram_Or_Concurrent_Unit and then not In_Subprogram_Or_Concurrent_Unit
then then
-- Check for default initialized variable case. Note that in -- Check for default initialized variable case. Note that in
-- accordance with (RM B.1(24)) imported objects are not -- accordance with (RM B.1(24)) imported objects are not subject to
-- subject to default initialization. -- default initialization.
-- If the initialization does not come from source and is an -- If the initialization does not come from source and is an
-- aggregate, it is a static initialization that replaces an -- aggregate, it is a static initialization that replaces an
-- implicit call, and must be treated as such. -- implicit call, and must be treated as such.
if Present (E) if Present (E)
and then and then
(Comes_From_Source (E) or else Nkind (E) /= N_Aggregate) (Comes_From_Source (E) or else Nkind (E) /= N_Aggregate)
then then
null; null;
...@@ -1210,13 +1208,8 @@ package body Sem_Cat is ...@@ -1210,13 +1208,8 @@ package body Sem_Cat is
elsif Nkind (Odf) = N_Subtype_Indication then elsif Nkind (Odf) = N_Subtype_Indication then
Ent := Etype (Subtype_Mark (Odf)); Ent := Etype (Subtype_Mark (Odf));
elsif elsif Nkind (Odf) = N_Constrained_Array_Definition then
Nkind (Odf) = N_Constrained_Array_Definition
then
Ent := Component_Type (T); Ent := Component_Type (T);
-- else
-- return;
end if; end if;
if Is_Task_Type (Ent) if Is_Task_Type (Ent)
...@@ -1230,9 +1223,9 @@ package body Sem_Cat is ...@@ -1230,9 +1223,9 @@ package body Sem_Cat is
end; end;
end if; end if;
-- Non-static discriminant not allowed in preelaborated unit -- Non-static discriminants not allowed in preelaborated unit.
-- Controlled object of a type with a user-defined Initialize -- Objects of a controlled type with a user-defined Initialize
-- is forbidden as well. -- are forbidden as well.
if Is_Record_Type (Etype (Id)) then if Is_Record_Type (Etype (Id)) then
declare declare
...@@ -1247,8 +1240,8 @@ package body Sem_Cat is ...@@ -1247,8 +1240,8 @@ package body Sem_Cat is
PEE := Parent (EE); PEE := Parent (EE);
if Nkind (PEE) = N_Full_Type_Declaration if Nkind (PEE) = N_Full_Type_Declaration
and then not Static_Discriminant_Expr and then not Static_Discriminant_Expr
(Discriminant_Specifications (PEE)) (Discriminant_Specifications (PEE))
then then
Error_Msg_N Error_Msg_N
("non-static discriminant in preelaborated unit", ("non-static discriminant in preelaborated unit",
...@@ -1270,23 +1263,21 @@ package body Sem_Cat is ...@@ -1270,23 +1263,21 @@ package body Sem_Cat is
-- except within a subprogram, generic subprogram, task unit, or -- except within a subprogram, generic subprogram, task unit, or
-- protected unit (RM 10.2.1(16)). -- protected unit (RM 10.2.1(16)).
if In_Pure_Unit if In_Pure_Unit and then not In_Subprogram_Task_Protected_Unit then
and then not In_Subprogram_Task_Protected_Unit
then
Error_Msg_N ("declaration of variable not allowed in pure unit", N); Error_Msg_N ("declaration of variable not allowed in pure unit", N);
-- The visible part of an RCI library unit must not contain the -- The visible part of an RCI library unit must not contain the
-- declaration of a variable (RM E.1.3(9)) -- declaration of a variable (RM E.1.3(9))
elsif In_RCI_Declaration (N) then elsif In_RCI_Declaration (N) then
Error_Msg_N ("declaration of variable not allowed in rci unit", N); Error_Msg_N ("visible variable not allowed in 'R'C'I unit", N);
-- The visible part of a Shared Passive library unit must not contain -- The visible part of a Shared Passive library unit must not contain
-- the declaration of a variable (RM E.2.2(7)) -- the declaration of a variable (RM E.2.2(7))
elsif In_RT_Declaration then elsif In_RT_Declaration and then not In_Private_Part (Id) then
Error_Msg_N Error_Msg_N
("variable declaration not allowed in remote types unit", N); ("visible variable not allowed in remote types unit", N);
end if; end if;
end Validate_Object_Declaration; end Validate_Object_Declaration;
......
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