Skip to content

R
riscv-gcc-1
Commit 1355d373 by Arnaud Charlet
Options

[multiple changes] 

2013-04-25  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, einfo.adb: Put back with/use for Namet.
	(Get_Pragma): New name (wi new spec) for Find_Pragma.
	* sem_ch6.adb: Change name Find_Pragma to Get_Pragma with
	different interface.

2013-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Is_Visible_Component): In an instance all
	components are visible.

From-SVN: r198286
parent 7271429c
Showing with 69 additions and 49 deletions
gcc/ada/ChangeLog
2013-04-25 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb: Put back with/use for Namet.
(Get_Pragma): New name (wi new spec) for Find_Pragma.
* sem_ch6.adb: Change name Find_Pragma to Get_Pragma with
different interface.
2013-04-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Is_Visible_Component): In an instance all
components are visible.
2013-04-25 Matthew Heaney <heaney@adacore.com>
* a-rbtgbo.adb, a-crbtgo.adb (Generic_Equal): do not test for
......
gcc/ada/einfo.adb
......@@ -33,6 +33,7 @@ pragma Style_Checks (All_Checks);
-- Turn off subprogram ordering, not used for this unit
with Atree; use Atree;
with Namet; use Namet;
with Nlists; use Nlists;
with Output; use Output;
with Sinfo; use Sinfo;
......@@ -6101,26 +6102,6 @@ package body Einfo is
return Etype (Discrete_Subtype_Definition (Parent (Id)));
end Entry_Index_Type;
-----------------
-- Find_Pragma --
-----------------
function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id is
Item : Node_Id;
begin
Item := First_Rep_Item (Id);
while Present (Item) loop
if Nkind (Item) = N_Pragma and then Pragma_Name (Item) = Name then
return Item;
end if;
Item := Next_Rep_Item (Item);
end loop;
return Empty;
end Find_Pragma;
---------------------
-- First_Component --
---------------------
......@@ -6264,6 +6245,29 @@ package body Einfo is
end if;
end Get_Full_View;
----------------
-- Get_Pragma --
----------------
function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id
is
N : Node_Id;
begin
N := First_Rep_Item (E);
while Present (N) loop
if Nkind (N) = N_Pragma
and then Get_Pragma_Id (Pragma_Name (N)) = Id
then
return N;
else
Next_Rep_Item (N);
end if;
end loop;
return Empty;
end Get_Pragma;
--------------------------------------
-- Get_Record_Representation_Clause --
--------------------------------------
......
gcc/ada/einfo.ads
......@@ -29,7 +29,6 @@
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Snames; use Snames;
with Types; use Types;
with Uintp; use Uintp;
......@@ -7354,11 +7353,6 @@ package Einfo is
-- expression is deferred to the freeze point. For further details see
-- Sem_Ch13.Analyze_Aspect_Specifications.
function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id;
-- Given entity Id and pragma name Name, attempt to find the corresponding
-- pragma in Id's chain of representation items. The function returns Empty
-- if no such pragma has been found.
function Get_Attribute_Definition_Clause
(E : Entity_Id;
Id : Attribute_Id) return Node_Id;
......@@ -7367,6 +7361,11 @@ package Einfo is
-- value returned is the N_Attribute_Definition_Clause node, otherwise
-- Empty is returned.
function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of
-- a pragma with the given pragma Id. If found, the value returned is the
-- N_Pragma node, otherwise Empty is returned.
function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for a record
-- representation clause, and if found, returns it. Returns Empty
......
gcc/ada/sem_ch3.adb
......@@ -1230,11 +1230,11 @@ package body Sem_Ch3 is
Check_For_Premature_Usage (T_Def);
-- The return type and/or any parameter type may be incomplete. Mark
-- the subprogram_type as depending on the incomplete type, so that
-- it can be updated when the full type declaration is seen. This
-- only applies to incomplete types declared in some enclosing scope,
-- not to limited views from other packages.
-- The return type and/or any parameter type may be incomplete. Mark the
-- subprogram_type as depending on the incomplete type, so that it can
-- be updated when the full type declaration is seen. This only applies
-- to incomplete types declared in some enclosing scope, not to limited
-- views from other packages.
if Present (Formals) then
Formal := First_Formal (Desig_Type);
......@@ -1256,9 +1256,9 @@ package body Sem_Ch3 is
end loop;
end if;
-- If the return type is incomplete, this is legal as long as the
-- type is declared in the current scope and will be completed in
-- it (rather than being part of limited view).
-- If the return type is incomplete, this is legal as long as the type
-- is declared in the current scope and will be completed in it (rather
-- than being part of limited view).
if Ekind (Etype (Desig_Type)) = E_Incomplete_Type
and then not Has_Delayed_Freeze (Desig_Type)
......@@ -1331,9 +1331,9 @@ package body Sem_Ch3 is
if Base_Type (Full_Desig) = T then
Error_Msg_N ("access type cannot designate itself", S);
-- In Ada 2005, the type may have a limited view through some unit
-- in its own context, allowing the following circularity that cannot
-- be detected earlier
-- In Ada 2005, the type may have a limited view through some unit in
-- its own context, allowing the following circularity that cannot be
-- detected earlier
elsif Is_Class_Wide_Type (Full_Desig)
and then Etype (Full_Desig) = T
......@@ -1348,8 +1348,8 @@ package body Sem_Ch3 is
Set_Etype (T, T);
-- If the type has appeared already in a with_type clause, it is
-- frozen and the pointer size is already set. Else, initialize.
-- If the type has appeared already in a with_type clause, it is frozen
-- and the pointer size is already set. Else, initialize.
if not From_With_Type (T) then
Init_Size_Align (T);
......@@ -16468,15 +16468,16 @@ package body Sem_Ch3 is
Type_Scope := Scope (Base_Type (Scope (C)));
end if;
-- For an untagged type derived from a private type, the only
-- visible components are new discriminants.
-- For an untagged type derived from a private type, the only visible
-- components are new discriminants. In an instance all components are
-- visible (see Analyze_Selected_Component).
if not Is_Tagged_Type (Original_Scope) then
return not Has_Private_Ancestor (Original_Scope)
or else In_Open_Scopes (Scope (Original_Scope))
or else
(Ekind (Original_Comp) = E_Discriminant
and then Original_Scope = Type_Scope);
or else In_Open_Scopes (Scope (Original_Scope))
or else In_Instance
or else (Ekind (Original_Comp) = E_Discriminant
and then Original_Scope = Type_Scope);
-- If it is _Parent or _Tag, there is no visibility issue
......@@ -16545,9 +16546,9 @@ package body Sem_Ch3 is
and then Is_Local_Type (Type_Scope);
end if;
-- There is another weird way in which a component may be invisible
-- when the private and the full view are not derived from the same
-- ancestor. Here is an example :
-- There is another weird way in which a component may be invisible when
-- the private and the full view are not derived from the same ancestor.
-- Here is an example :
-- type A1 is tagged record F1 : integer; end record;
-- type A2 is new A1 with record F2 : integer; end record;
......
gcc/ada/sem_ch6.adb
......@@ -11908,9 +11908,13 @@ package body Sem_Ch6 is
-- because the input type may lack aspect/pragma predicate and simply
-- inherit those from its ancestor.
-- Note that predicate pragmas include all three cases of predicate
-- aspects (Predicate, Dynamic_Predicate, Static_Predicate), so this
-- routine checks for all three cases.
Anc := Typ;
while Present (Anc) loop
Pred := Find_Pragma (Anc, Name_Predicate);
Pred := Get_Pragma (Anc, Pragma_Predicate);
if Present (Pred) and then not Is_Ignored (Pred) then
return True;
......
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