Skip to content

R
riscv-gcc-1
Commit 375cbc2b by Thomas Quinot Committed by Arnaud Charlet
Options

sem_util.ads: Minor reformatting. 

2015-01-06  Thomas Quinot  <quinot@adacore.com>

	* sem_util.ads: Minor reformatting.
	* sem_cat.adb (In_RCI_Visible_Declarations): Change back to...
	(In_RCI_Declaration) Return to old name, as proper checking of
	entity being in the visible part depends on entity kind and must
	be done by the caller.

From-SVN: r219249
parent fc6d9796
Showing with 67 additions and 81 deletions
gcc/ada/ChangeLog
2015-01-06 Thomas Quinot <quinot@adacore.com>
* sem_util.ads: Minor reformatting.
* sem_cat.adb (In_RCI_Visible_Declarations): Change back to...
(In_RCI_Declaration) Return to old name, as proper checking of
entity being in the visible part depends on entity kind and must
be done by the caller.
2015-01-06 Ed Schonberg <schonberg@adacore.com> 2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb, sem_ch12.ads, sem_ch8.adb: Ongoing work for wrappers * sem_ch12.adb, sem_ch12.ads, sem_ch8.adb: Ongoing work for wrappers
for operators in SPARK. for operators in SPARK.
2015-01-06 Javier Miranda <miranda@adacore.com>
* exp_disp.adb: Revert previous patch again.
2015-01-06 Ed Schonberg <schonberg@adacore.com> 2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Get_Value): In ASIS mode, preanalyze the * sem_aggr.adb (Get_Value): In ASIS mode, preanalyze the
...@@ -52,10 +56,6 @@ ...@@ -52,10 +56,6 @@
non-limited view is available, use it in the specification of non-limited view is available, use it in the specification of
the generated body. the generated body.
2015-01-06 Javier Miranda <miranda@adacore.com>
* exp_disp.adb: Reapplying reversed patch.
2015-01-06 Ed Schonberg <schonberg@adacore.com> 2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Find_Type_Name): If there is a previous tagged * sem_ch3.adb (Find_Type_Name): If there is a previous tagged
......
gcc/ada/sem_cat.adb
...@@ -86,14 +86,13 @@ package body Sem_Cat is ...@@ -86,14 +86,13 @@ package body Sem_Cat is
-- Return True if the entity or one of its subcomponents does not support -- Return True if the entity or one of its subcomponents does not support
-- external streaming. -- external streaming.
function In_RCI_Visible_Declarations return Boolean; function In_RCI_Declaration return Boolean;
-- Determines if the visible part of a remote call interface library unit
-- is being compiled, for semantic checking purposes (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 the declaration of a Remote Types -- Determine if current scope is within the declaration of a Remote Call
-- unit, for semantic checking purposes. -- Interface or Remote Types unit, for semantic checking purposes.
function In_Package_Declaration return Boolean;
-- Shared supporting routine for In_RCI_Declaration and In_RT_Declaration
function In_Shared_Passive_Unit return Boolean; function In_Shared_Passive_Unit return Boolean;
-- Determines if current scope is within a Shared Passive compilation unit -- Determines if current scope is within a Shared Passive compilation unit
...@@ -498,6 +497,23 @@ package body Sem_Cat is ...@@ -498,6 +497,23 @@ package body Sem_Cat is
or else not Is_Hidden (Entity (Rep_Item))); or else not Is_Hidden (Entity (Rep_Item)));
end Has_Stream_Attribute_Definition; end Has_Stream_Attribute_Definition;
----------------------------
-- In_Package_Declaration --
----------------------------
function In_Package_Declaration return Boolean is
Unit_Kind : constant Node_Kind :=
Nkind (Unit (Cunit (Current_Sem_Unit)));
begin
-- There are no restrictions on the body of an RCI or RT unit
return Is_Package_Or_Generic_Package (Current_Scope)
and then Unit_Kind /= N_Package_Body
and then not In_Package_Body (Current_Scope)
and then not In_Instance;
end In_Package_Declaration;
--------------------------- ---------------------------
-- In_Preelaborated_Unit -- -- In_Preelaborated_Unit --
--------------------------- ---------------------------
...@@ -544,57 +560,23 @@ package body Sem_Cat is ...@@ -544,57 +560,23 @@ package body Sem_Cat is
return Is_Pure (Current_Scope); return Is_Pure (Current_Scope);
end In_Pure_Unit; end In_Pure_Unit;
--------------------------------- ------------------------
-- In_RCI_Visible_Declarations -- -- In_RCI_Declaration --
--------------------------------- ------------------------
function In_RCI_Visible_Declarations return Boolean is
Unit_Entity : Entity_Id := Current_Scope;
Unit_Kind : constant Node_Kind :=
Nkind (Unit (Cunit (Current_Sem_Unit)));
function In_RCI_Declaration return Boolean is
begin begin
-- There are no restrictions on the private part or body of an RCI unit return Is_Remote_Call_Interface (Current_Scope)
and then In_Package_Declaration;
if not (Is_Remote_Call_Interface (Unit_Entity) end In_RCI_Declaration;
and then Is_Package_Or_Generic_Package (Unit_Entity)
and then Unit_Kind /= N_Package_Body
and then not In_Instance)
then
return False;
end if;
while Unit_Entity /= Standard_Standard loop
if In_Private_Part (Unit_Entity) then
return False;
end if;
Unit_Entity := Scope (Unit_Entity);
end loop;
-- Here if in RCI declaration, and not in private part of any open
-- scope.
return True;
end In_RCI_Visible_Declarations;
----------------------- -----------------------
-- In_RT_Declaration -- -- In_RT_Declaration --
----------------------- -----------------------
function In_RT_Declaration return Boolean is function In_RT_Declaration return Boolean is
Unit_Entity : constant Entity_Id := Current_Scope;
Unit_Kind : constant Node_Kind :=
Nkind (Unit (Cunit (Current_Sem_Unit)));
begin begin
-- There are no restrictions on the body of a Remote Types unit return Is_Remote_Types (Current_Scope) and then In_Package_Declaration;
return Is_Remote_Types (Unit_Entity)
and then Is_Package_Or_Generic_Package (Unit_Entity)
and then Unit_Kind /= N_Package_Body
and then not In_Package_Body (Unit_Entity)
and then not In_Instance;
end In_RT_Declaration; end In_RT_Declaration;
---------------------------- ----------------------------
...@@ -1377,20 +1359,22 @@ package body Sem_Cat is ...@@ -1377,20 +1359,22 @@ package body Sem_Cat is
if In_Pure_Unit and then not In_Subprogram_Task_Protected_Unit then if In_Pure_Unit 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 elsif not In_Private_Part (Id) then
-- declaration of a variable (RM E.1.3(9))
elsif In_RCI_Visible_Declarations then -- The visible part of an RCI library unit must not contain the
Error_Msg_N ("visible variable not allowed in 'R'C'I unit", N); -- declaration of a variable (RM E.1.3(9)).
-- The visible part of a Shared Passive library unit must not contain if In_RCI_Declaration then
-- the declaration of a variable (RM E.2.2(7)) Error_Msg_N ("visible variable not allowed in 'R'C'I unit", N);
elsif In_RT_Declaration and then not In_Private_Part (Id) then -- The visible part of a Shared Passive library unit must not contain
Error_Msg_N -- the declaration of a variable (RM E.2.2(7)).
("visible variable not allowed in remote types unit", N);
end if;
elsif In_RT_Declaration then
Error_Msg_N
("visible variable not allowed in remote types unit", N);
end if;
end if;
end Validate_Object_Declaration; end Validate_Object_Declaration;
----------------------------- -----------------------------
...@@ -1605,7 +1589,7 @@ package body Sem_Cat is ...@@ -1605,7 +1589,7 @@ package body Sem_Cat is
procedure Validate_RCI_Subprogram_Declaration (N : Node_Id) is procedure Validate_RCI_Subprogram_Declaration (N : Node_Id) is
K : constant Node_Kind := Nkind (N); K : constant Node_Kind := Nkind (N);
Profile : List_Id; Profile : List_Id;
Id : Node_Id; Id : constant Entity_Id := Defining_Entity (N);
Param_Spec : Node_Id; Param_Spec : Node_Id;
Param_Type : Entity_Id; Param_Type : Entity_Id;
Error_Node : Node_Id := N; Error_Node : Node_Id := N;
...@@ -1618,22 +1602,23 @@ package body Sem_Cat is ...@@ -1618,22 +1602,23 @@ package body Sem_Cat is
-- 1. from Analyze_Subprogram_Declaration. -- 1. from Analyze_Subprogram_Declaration.
-- 2. from Validate_Object_Declaration (access to subprogram). -- 2. from Validate_Object_Declaration (access to subprogram).
if not (Comes_From_Source (N) and then In_RCI_Visible_Declarations) then if not (Comes_From_Source (N)
and then In_RCI_Declaration
and then not In_Private_Part (Scope (Id)))
then
return; return;
end if; end if;
if K = N_Subprogram_Declaration then if K = N_Subprogram_Declaration then
Id := Defining_Unit_Name (Specification (N));
Profile := Parameter_Specifications (Specification (N)); Profile := Parameter_Specifications (Specification (N));
else pragma Assert (K = N_Object_Declaration); else
pragma Assert (K = N_Object_Declaration);
-- The above assertion is dubious, the visible declarations of an -- The above assertion is dubious, the visible declarations of an
-- RCI unit never contain an object declaration, this should be an -- RCI unit never contain an object declaration, this should be an
-- ACCESS-to-object declaration??? -- ACCESS-to-object declaration???
Id := Defining_Identifier (N);
if Nkind (Id) = N_Defining_Identifier if Nkind (Id) = N_Defining_Identifier
and then Nkind (Parent (Etype (Id))) = N_Full_Type_Declaration and then Nkind (Parent (Etype (Id))) = N_Full_Type_Declaration
and then Ekind (Etype (Id)) = E_Access_Subprogram_Type and then Ekind (Etype (Id)) = E_Access_Subprogram_Type
...@@ -1712,17 +1697,18 @@ package body Sem_Cat is ...@@ -1712,17 +1697,18 @@ package body Sem_Cat is
-- the given node is N_Access_To_Object_Definition. -- the given node is N_Access_To_Object_Definition.
if not Comes_From_Source (T) if not Comes_From_Source (T)
or else (not In_RCI_Visible_Declarations or else (not In_RCI_Declaration and then not In_RT_Declaration)
and then not In_RT_Declaration)
then then
return; return;
end if; end if;
-- An access definition in the private part of a Remote Types package -- An access definition in the private part of a package is not a
-- may be legal if it has user-defined Read and Write attributes. This -- remote access type. Restrictions related to external streaming
-- will be checked at the end of the package spec processing. -- support for non-remote access types are enforced elsewhere. Note
-- that In_Private_Part is never set on type entities: check flag
-- on enclosing scope.
if In_RT_Declaration and then In_Private_Part (Scope (T)) then if In_Private_Part (Scope (T)) then
return; return;
end if; end if;
...@@ -1735,7 +1721,7 @@ package body Sem_Cat is ...@@ -1735,7 +1721,7 @@ package body Sem_Cat is
if Ekind (T) /= E_General_Access_Type if Ekind (T) /= E_General_Access_Type
or else not Is_Class_Wide_Type (Designated_Type (T)) or else not Is_Class_Wide_Type (Designated_Type (T))
then then
if In_RCI_Visible_Declarations then if In_RCI_Declaration then
Error_Msg_N Error_Msg_N
("error in access type in Remote_Call_Interface unit", T); ("error in access type in Remote_Call_Interface unit", T);
else else
......
gcc/ada/sem_util.ads
...@@ -469,7 +469,7 @@ package Sem_Util is ...@@ -469,7 +469,7 @@ package Sem_Util is
-- --
-- Iterator loops also have a defining entity, which holds the list of -- Iterator loops also have a defining entity, which holds the list of
-- local entities declared during loop expansion. These entities need -- local entities declared during loop expansion. These entities need
-- debugging information, generated through QUalify_Entity_Names, and -- debugging information, generated through Qualify_Entity_Names, and
-- the loop declaration must be placed in the table Name_Qualify_Units. -- the loop declaration must be placed in the table Name_Qualify_Units.
function Denotes_Discriminant function Denotes_Discriminant
......
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