+2013-10-17 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch7.adb: Minor reformatting.
+
+2013-10-17 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_dim.adb (Process_Minus, Process_Divide): Label dimension
+ expression with standard operator and type, for pretty-printing
+ use.
+
+2013-10-17 Bob Duff <duff@adacore.com>
+
+ * gnat_ugn.texi: Document --pp-new and --pp-old switches.
+
+2013-10-17 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * einfo.adb: Flag 159 is now known as From_Limited_With. Replace
+ all references to attribute From_With_Type with From_Limited_With.
+ (From_With_Type): Renamed to From_Limited_With.
+ (Set_From_With_Type): Renamd to Set_From_Limited_With.
+ * einfo.ads: Remove attribute From_With_Type and occurrences in
+ nodes. Add attribute From_Limited_With along with occurrences
+ in nodes.
+ (From_With_Type): Renamed to From_Limited_With along with pragma Inline.
+ (Set_From_With_Type): Renamed to
+ Set_From_Limited_With along with pragma Inline.
+ * sem_ch7.adb, sem_ch8.adb, sem_ch12.adb, sem_ch13.adb, sem_disp.adb,
+ sem_res.adb, sem_type.adb, sem_util.adb, sem_warn.adb,
+ exp_attr.adb, exp_disp.adb, freeze.adb, itypes.adb, layout.adb,
+ lib-writ.adb, rtsfind.adb, sem_attr.adb, sem_aux.adb, sem_ch3.adb,
+ sem_ch4.adb: Replace all references to attribute From_With_Type
+ with From_Limited_With.
+ * sem_ch6.adb: Replace all references to attribute From_With_Type
+ with From_Limited_With.
+ (Designates_From_With_Type): Renamed to Designates_From_Limited_With.
+ (Process_Formals): Update the call to Designates_From_With_Type.
+ * sem_ch10.adb: Replace all references to attribute From_With_Type
+ with From_Limited_With.
+ (Build_Limited_Views): Reimplemented.
+ * gcc-interface/decl.c Replace all references to attribute
+ From_With_Type with From_Limited_With.
+ (finalize_from_with_types): Renamed to finalize_from_limited_with.
+ * gcc-interface/gigi.h (finalize_from_with_types): Renamed to
+ finalize_from_limited_with.
+ * gcc-interface/trans.c: Replace all references to attribute
+ From_With_Type with From_Limited_With.
+ (Compilation_Unit_to_gnu): Update the call to finalize_from_with_types.
+
+2013-10-17 Pascal Obry <obry@adacore.com>
+
+ * projects.texi: Update VCS_Kind documentation.
+
+2013-10-17 Matthew Heaney <heaney@adacore.com>
+
+ * a-convec.adb, a-coinve.adb, a-cobove.adb (Insert, Insert_Space):
+ Inspect value range before converting type.
+
+2013-10-17 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma): Flag the use of pragma Refined_Pre as
+ illegal.
+
2013-10-17 Vincent Celier <celier@adacore.com>
* gnat_ugn.texi: Remove VMS conversion of -gnatet and -gnateT,
-- worry about if No_Index were less than 0, but that case is
-- handled above).
- Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ if Index_Type'Last - No_Index >=
+ Count_Type'Pos (Count_Type'Last)
+ then
+ -- We have determined that range of Index_Type has at least as
+ -- many values as in Count_Type, so Count_Type'Last is the
+ -- maximum number of items that are allowed.
+
+ Max_Length := Count_Type'Last;
+
+ else
+ -- The range of Index_Type has fewer values than in Count_Type,
+ -- so the maximum number of items is computed from the range of
+ -- the Index_Type.
+
+ Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ end if;
end if;
elsif Index_Type'First <= 0 then
-- worry about if No_Index were less than 0, but that case is
-- handled above).
- Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ if Index_Type'Last - No_Index >=
+ Count_Type'Pos (Count_Type'Last)
+ then
+ -- We have determined that range of Index_Type has at least as
+ -- many values as in Count_Type, so Count_Type'Last is the
+ -- maximum number of items that are allowed.
+
+ Max_Length := Count_Type'Last;
+
+ else
+ -- The range of Index_Type has fewer values than in Count_Type,
+ -- so the maximum number of items is computed from the range of
+ -- the Index_Type.
+
+ Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ end if;
end if;
elsif Index_Type'First <= 0 then
-- worry about if No_Index were less than 0, but that case is
-- handled above).
- Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ if Index_Type'Last - No_Index >=
+ Count_Type'Pos (Count_Type'Last)
+ then
+ -- We have determined that range of Index_Type has at least as
+ -- many values as in Count_Type, so Count_Type'Last is the
+ -- maximum number of items that are allowed.
+
+ Max_Length := Count_Type'Last;
+
+ else
+ -- The range of Index_Type has fewer values than in Count_Type,
+ -- so the maximum number of items is computed from the range of
+ -- the Index_Type.
+
+ Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ end if;
end if;
elsif Index_Type'First <= 0 then
-- worry about if No_Index were less than 0, but that case is
-- handled above).
- Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ if Index_Type'Last - No_Index >=
+ Count_Type'Pos (Count_Type'Last)
+ then
+ -- We have determined that range of Index_Type has at least as
+ -- many values as in Count_Type, so Count_Type'Last is the
+ -- maximum number of items that are allowed.
+
+ Max_Length := Count_Type'Last;
+
+ else
+ -- The range of Index_Type has fewer values than in Count_Type,
+ -- so the maximum number of items is computed from the range of
+ -- the Index_Type.
+
+ Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ end if;
end if;
elsif Index_Type'First <= 0 then
-- worry about if No_Index were less than 0, but that case is
-- handled above).
- Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ if Index_Type'Last - No_Index >=
+ Count_Type'Pos (Count_Type'Last)
+ then
+ -- We have determined that range of Index_Type has at least as
+ -- many values as in Count_Type, so Count_Type'Last is the
+ -- maximum number of items that are allowed.
+
+ Max_Length := Count_Type'Last;
+
+ else
+ -- The range of Index_Type has fewer values than in Count_Type,
+ -- so the maximum number of items is computed from the range of
+ -- the Index_Type.
+
+ Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ end if;
end if;
elsif Index_Type'First <= 0 then
-- worry about if No_Index were less than 0, but that case is
-- handled above).
- Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ if Index_Type'Last - No_Index >=
+ Count_Type'Pos (Count_Type'Last)
+ then
+ -- We have determined that range of Index_Type has at least as
+ -- many values as in Count_Type, so Count_Type'Last is the
+ -- maximum number of items that are allowed.
+
+ Max_Length := Count_Type'Last;
+
+ else
+ -- The range of Index_Type has fewer values than in Count_Type,
+ -- so the maximum number of items is computed from the range of
+ -- the Index_Type.
+
+ Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
+ end if;
end if;
elsif Index_Type'First <= 0 then
-- Referenced Flag156
-- Has_Pragma_Inline Flag157
-- Finalize_Storage_Only Flag158
- -- From_With_Type Flag159
+ -- From_Limited_With Flag159
-- Is_Package_Body_Entity Flag160
-- Has_Qualified_Name Flag161
return Node7 (Id);
end Freeze_Node;
- function From_With_Type (Id : E) return B is
+ function From_Limited_With (Id : E) return B is
begin
return Flag159 (Id);
- end From_With_Type;
+ end From_Limited_With;
function Full_View (Id : E) return E is
begin
Set_Node7 (Id, V);
end Set_Freeze_Node;
- procedure Set_From_With_Type (Id : E; V : B := True) is
+ procedure Set_From_Limited_With (Id : E; V : B := True) is
begin
- pragma Assert
- (Is_Type (Id)
- or else Ekind (Id) = E_Package);
+ pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Package);
Set_Flag159 (Id, V);
- end Set_From_With_Type;
+ end Set_From_Limited_With;
procedure Set_Full_View (Id : E; V : E) is
begin
-- view then we return the Underlying_Type of its non-limited
-- view.
- elsif From_With_Type (Id)
+ elsif From_Limited_With (Id)
and then Present (Non_Limited_View (Id))
then
return Underlying_Type (Non_Limited_View (Id));
W ("Entry_Accepted", Flag152 (Id));
W ("Can_Use_Internal_Rep", Flag229 (Id));
W ("Finalize_Storage_Only", Flag158 (Id));
- W ("From_With_Type", Flag159 (Id));
+ W ("From_Limited_With", Flag159 (Id));
W ("Has_Aliased_Components", Flag135 (Id));
W ("Has_Alignment_Clause", Flag46 (Id));
W ("Has_All_Calls_Remote", Flag79 (Id));
procedure Write_Field16_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
-
- when E_Abstract_State =>
- Write_Str ("Body_References");
-
when E_Record_Type |
E_Record_Type_With_Private =>
Write_Str ("Access_Disp_Table");
+ when E_Abstract_State =>
+ Write_Str ("Body_References");
+
when E_Record_Subtype |
E_Class_Wide_Subtype =>
Write_Str ("Cloned_Subtype");
Write_Str ("Non_Limited_View");
when E_Incomplete_Subtype =>
- if From_With_Type (Id) then
+ if From_Limited_With (Id) then
Write_Str ("Non_Limited_View");
end if;
-- associated with the entity, then this field is Empty. See package
-- Freeze for further details.
--- From_With_Type (Flag159)
--- Defined in package and type entities. Indicates that the entity
--- appears in a With_Type clause in the context of some other unit,
--- either as the prefix (which must be a package), or as a type name.
--- The package can only be used to retrieve such a type, and the type
--- can be used only in component declarations and access definitions.
--- The With_Type clause is used to construct mutually recursive
--- types, i.e. record types (Java classes) that hold pointers to each
--- other. If such a type is an access type, it has no explicit freeze
--- node, so that the back-end does not attempt to elaborate it.
--- Currently this flag is also used to implement Ada 2005 (AI-50217).
--- It will be renamed to From_Limited_With after removal of the current
--- GNAT with_type clause???
+-- From_Limited_With (Flag159)
+-- Defined in package and type entities. Set to True when the related
+-- entity is generated by the expansion of a limited with clause. Such
+-- an entity is said to be a "shadow" - it acts as the incomplete view
+-- of a type by inheriting relevant attributes from the said type.
-- Full_View (Node11)
-- Defined in all type and subtype entities and in deferred constants.
-- Depends_On_Private (Flag14)
-- Discard_Names (Flag88)
-- Finalize_Storage_Only (Flag158) (base type only)
- -- From_With_Type (Flag159)
+ -- From_Limited_With (Flag159)
-- Has_Aliased_Components (Flag135) (base type only)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86) (base type only)
-- Discard_Names (Flag88)
-- Elaboration_Entity_Required (Flag174)
-- Elaborate_Body_Desirable (Flag210) (non-generic case only)
- -- From_With_Type (Flag159)
+ -- From_Limited_With (Flag159)
-- Has_All_Calls_Remote (Flag79)
-- Has_Anonymous_Master (Flag253)
-- Has_Completion (Flag26)
function First_Rep_Item (Id : E) return N;
function Float_Rep (Id : E) return F;
function Freeze_Node (Id : E) return N;
- function From_With_Type (Id : E) return B;
+ function From_Limited_With (Id : E) return B;
function Full_View (Id : E) return E;
function Generic_Homonym (Id : E) return E;
function Generic_Renamings (Id : E) return L;
procedure Set_First_Rep_Item (Id : E; V : N);
procedure Set_Float_Rep (Id : E; V : F);
procedure Set_Freeze_Node (Id : E; V : N);
- procedure Set_From_With_Type (Id : E; V : B := True);
+ procedure Set_From_Limited_With (Id : E; V : B := True);
procedure Set_Full_View (Id : E; V : E);
procedure Set_Generic_Homonym (Id : E; V : E);
procedure Set_Generic_Renamings (Id : E; V : L);
pragma Inline (First_Private_Entity);
pragma Inline (First_Rep_Item);
pragma Inline (Freeze_Node);
- pragma Inline (From_With_Type);
+ pragma Inline (From_Limited_With);
pragma Inline (Full_View);
pragma Inline (Generic_Homonym);
pragma Inline (Generic_Renamings);
pragma Inline (Set_First_Private_Entity);
pragma Inline (Set_First_Rep_Item);
pragma Inline (Set_Freeze_Node);
- pragma Inline (Set_From_With_Type);
+ pragma Inline (Set_From_Limited_With);
pragma Inline (Set_Full_View);
pragma Inline (Set_Generic_Homonym);
pragma Inline (Set_Generic_Renamings);
-- Handle designated types that come from the limited view
if Ekind (Btyp_DDT) = E_Incomplete_Type
- and then From_With_Type (Btyp_DDT)
+ and then From_Limited_With (Btyp_DDT)
and then Present (Non_Limited_View (Btyp_DDT))
then
Btyp_DDT := Non_Limited_View (Btyp_DDT);
elsif Is_Class_Wide_Type (Btyp_DDT)
and then Ekind (Etype (Btyp_DDT)) = E_Incomplete_Type
- and then From_With_Type (Etype (Btyp_DDT))
+ and then From_Limited_With (Etype (Btyp_DDT))
and then Present (Non_Limited_View (Etype (Btyp_DDT)))
and then Present (Class_Wide_Type
(Non_Limited_View (Etype (Btyp_DDT))))
Defer_Abort : Boolean;
Fin_Id : out Entity_Id);
-- N may denote an accept statement, block, entry body, package body,
- -- package spec, protected body, subprogram body, and a task body. Create
+ -- package spec, protected body, subprogram body, or a task body. Create
-- a procedure which contains finalization calls for all controlled objects
-- declared in the declarative or statement region of N. The calls are
-- built in reverse order relative to the original declarations. In the
- -- case of a tack body, the routine delays the creation of the finalizer
+ -- case of a task body, the routine delays the creation of the finalizer
-- until all statements have been moved to the task body procedure.
-- Clean_Stmts may contain additional context-dependent code used to abort
-- asynchronous calls or complete tasks (see Build_Cleanup_Statements).
else
Actual_Dup := Relocate_Node (Actual);
- if From_With_Type (Actual_Typ) then
+ if From_Limited_With (Actual_Typ) then
-- If the type of the actual parameter comes from a limited
-- with-clause and the non-limited view is already available
begin
if Ekind (Typ) = E_Incomplete_Type then
- if From_With_Type (Typ) then
+ if From_Limited_With (Typ) then
Typ := Non_Limited_View (Typ);
else
Typ := Full_View (Typ);
if Is_Incomplete_Type (F_Type)
and then Present (Full_View (F_Type))
- and then not From_With_Type (F_Type)
+ and then not From_Limited_With (F_Type)
then
F_Type := Full_View (F_Type);
Set_Etype (Formal, F_Type);
Error_Msg_Qual_Level := 0;
end if;
- if not From_With_Type (F_Type) then
+ if not From_Limited_With (F_Type) then
if Is_Access_Type (F_Type) then
F_Type := Designated_Type (F_Type);
end if;
if Ekind (R_Type) = E_Incomplete_Type
and then Present (Full_View (R_Type))
- and then not From_With_Type (R_Type)
+ and then not From_Limited_With (R_Type)
then
R_Type := Full_View (R_Type);
Set_Etype (E, R_Type);
static int defer_incomplete_level = 0;
static struct incomplete *defer_incomplete_list;
-/* This variable is used to delay expanding From_With_Type types until the
+/* This variable is used to delay expanding From_Limited_With types until the
end of the spec. */
static struct incomplete *defer_limited_with;
/* Whether it comes from a limited with. */
bool is_from_limited_with
= (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
- && From_With_Type (gnat_desig_equiv));
+ && From_Limited_With (gnat_desig_equiv));
/* The "full view" of the designated type. If this is an incomplete
entity from a limited with, treat its non-limited view as the full
view. Otherwise, if this is an incomplete or private type, use the
we are only annotating types, break circularities here. */
if (type_annotate_only
&& IN (Ekind (gnat_return_type), Incomplete_Kind)
- && From_With_Type (gnat_return_type)
+ && From_Limited_With (gnat_return_type)
&& In_Extended_Main_Code_Unit
(Non_Limited_View (gnat_return_type))
&& !present_gnu_tree (Non_Limited_View (gnat_return_type)))
we are only annotating types, break circularities here. */
if (type_annotate_only
&& IN (Ekind (gnat_param_type), Incomplete_Kind)
- && From_With_Type (Etype (gnat_param_type))
+ && From_Limited_With (Etype (gnat_param_type))
&& In_Extended_Main_Code_Unit
(Non_Limited_View (gnat_param_type))
&& !present_gnu_tree (Non_Limited_View (gnat_param_type)))
full view, whichever is present. This is used in all the tests
below. */
Entity_Id full_view
- = (IN (kind, Incomplete_Kind) && From_With_Type (gnat_entity))
+ = (IN (kind, Incomplete_Kind) && From_Limited_With (gnat_entity))
? Non_Limited_View (gnat_entity)
: Present (Full_View (gnat_entity))
? Full_View (gnat_entity)
return false;
}
-/* Finalize the processing of From_With_Type incomplete types. */
+/* Finalize the processing of From_Limited_With incomplete types. */
void
-finalize_from_with_types (void)
+finalize_from_limited_with (void)
{
struct incomplete *p, *next;
mark_visited (EXP); \
} while (0)
-/* Finalize the processing of From_With_Type incomplete types. */
-extern void finalize_from_with_types (void);
+/* Finalize the processing of From_Limited_With incomplete types. */
+extern void finalize_from_limited_with (void);
/* Return the equivalent type to be used for GNAT_ENTITY, if it's a
kind of type (such E_Task_Type) that has a different type which Gigi
/* Process any pragmas and actions following the unit. */
add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node)));
add_stmt_list (Actions (Aux_Decls_Node (gnat_node)));
- finalize_from_with_types ();
+ finalize_from_limited_with ();
/* Save away what we've made so far and record this potential elaboration
procedure. */
Present (gnat_temp);
gnat_temp = Next_Formal_With_Extras (gnat_temp))
if (Is_Itype (Etype (gnat_temp))
- && !From_With_Type (Etype (gnat_temp)))
+ && !From_Limited_With (Etype (gnat_temp)))
gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
/* Then the result type, set to Standard_Void_Type for procedures. */
Entity_Id gnat_temp_type
= Etype (Defining_Entity (Specification (gnat_node)));
- if (Is_Itype (gnat_temp_type) && !From_With_Type (gnat_temp_type))
+ if (Is_Itype (gnat_temp_type) && !From_Limited_With (gnat_temp_type))
gnat_to_gnu_entity (Etype (gnat_temp_type), NULL_TREE, 0);
}
You can specify various style directives via switches; e.g.,
identifier case conventions, rules of indentation, and comment layout.
+Note: A newly-redesigned set of formatting algorithms used by gnatpp
+is now available.
+To invoke the new experimental formatting algorithms, use the
+@option{--pp-new} switch.
+The default is @option{--pp-old}; that is, gnatpp uses the old
+formatting algorithms by default.
+We intend to make @option{--pp-new} the default at some point.
+
To produce a reformatted file, @command{gnatpp} generates and uses the ASIS
tree for the input source and thus requires the input to be syntactically and
semantically legal.
@cindex @option{--help} @command{gnatpp}
Display usage, then exit disregarding all other options.
+@item --pp-new
+@cindex @option{--pp-new} @command{gnatpp}
+Use the new experimental formatting algorithms.
+
+@item --pp-old
+@cindex @option{--pp-old} @command{gnatpp}
+Use the old formatting algorithms. This is the default.
+
@item ^-files @var{filename}^/FILES=@var{filename}^
@cindex @option{^-files^/FILES^} (@code{gnatpp})
Take the argument source files from the specified file. This file should be an
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Set_Etype (I_Typ, Base_Type (T));
Set_Depends_On_Private (I_Typ, Depends_On_Private (T));
Set_Is_Public (I_Typ, Is_Public (T));
- Set_From_With_Type (I_Typ, From_With_Type (T));
+ Set_From_Limited_With (I_Typ, From_Limited_With (T));
Set_Is_Access_Constant (I_Typ, Is_Access_Constant (T));
Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T));
Set_Is_Volatile (I_Typ, Is_Volatile (T));
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- If we only have a limited view of the type, see whether the
-- non-limited view is available.
- if From_With_Type (Designated_Type (E))
+ if From_Limited_With (Designated_Type (E))
and then Ekind (Designated_Type (E)) = E_Incomplete_Type
and then Present (Non_Limited_View (Designated_Type (E)))
then
end if;
else
- Set_From_With_Type (Cunit_Entity (Unum));
+ Set_From_Limited_With (Cunit_Entity (Unum));
end if;
if Implicit_With (Unum) /= Yes then
Write_Info_Initiate ('Z');
elsif Ekind (Cunit_Entity (Unum)) = E_Package
- and then From_With_Type (Cunit_Entity (Unum))
+ and then From_Limited_With (Cunit_Entity (Unum))
then
Write_Info_Initiate ('Y');
end if;
if Ekind (Cunit_Entity (Unum)) = E_Package
- and then From_With_Type (Cunit_Entity (Unum))
+ and then From_Limited_With (Cunit_Entity (Unum))
then
null;
else
for Unum in Units.First .. Last_Unit loop
if Cunit_Entity (Unum) = Empty
- or else not From_With_Type (Cunit_Entity (Unum))
+ or else not From_Limited_With (Cunit_Entity (Unum))
then
Num_Sdep := Num_Sdep + 1;
Sdep_Table (Num_Sdep) := Unum;
@item @b{VCS_Kind}: single
Value is a string used to specify the Version Control System (VCS) to be used
-for this project, for example CVS, RCS, ClearCase or Perforce.
+for this project, for example "Subversion", "ClearCase". If the
+value is set to "Auto", the IDE will try to detect the actual VCS used
+on the list of supported ones.
@item @b{VCS_File_Check}: single
-- a real semantic dependence when the purpose of the limited_with
-- is precisely to avoid such.
- if From_With_Type (Cunit_Entity (U.Unum)) then
+ if From_Limited_With (Cunit_Entity (U.Unum)) then
null;
else
-- only has a limited view, scan the corresponding list of
-- incomplete types.
- if From_With_Type (U.Entity) then
+ if From_Limited_With (U.Entity) then
Pkg_Ent := First_Entity (Limited_View (U.Entity));
else
Pkg_Ent := First_Entity (U.Entity);
Typ := Etype (E);
- if From_With_Type (Typ) then
+ if From_Limited_With (Typ) then
Error_Attr_P
("prefix of % attribute cannot be an incomplete type");
-- entities may occur in subprogram formals.
if Is_Incomplete_Type (Typ)
- and then From_With_Type (Typ)
+ and then From_Limited_With (Typ)
and then Present (Non_Limited_View (Typ))
and then Is_Legal_Shadow_Entity_In_Body (Typ)
then
-- use of it. If it is an incomplete subtype, use the base type
-- in any case.
- if From_With_Type (Des_Btyp)
+ if From_Limited_With (Des_Btyp)
and then Present (Non_Limited_View (Des_Btyp))
then
Des_Btyp := Non_Limited_View (Des_Btyp);
elsif Is_Class_Wide_Type (Typ)
and then Is_Incomplete_Type (Etype (Typ))
- and then From_With_Type (Etype (Typ))
+ and then From_Limited_With (Etype (Typ))
and then Present (Non_Limited_View (Etype (Typ)))
then
return Class_Wide_Type (Non_Limited_View (Etype (Typ)));
and then
Ekind (Defining_Identifier (Decl)) = E_Incomplete_Subtype
and then
- From_With_Type (Defining_Identifier (Decl))
+ From_Limited_With (Defining_Identifier (Decl))
then
Def_Id := Defining_Identifier (Decl);
Non_Lim_View := Non_Limited_View (Def_Id);
end if;
Set_Entity (Name (N), P);
- Set_From_With_Type (P);
+ Set_From_Limited_With (P);
end Install_Limited_Withed_Unit;
-------------------------
-- tions on the use of package entities.
if Ekind (Uname) = E_Package then
- Set_From_With_Type (Uname, False);
+ Set_From_Limited_With (Uname, False);
end if;
-- Ada 2005 (AI-377): it is illegal for a with_clause to name a child
-------------------------
procedure Build_Limited_Views (N : Node_Id) is
+ Nam : constant Node_Id := Name (N);
Unum : constant Unit_Number_Type := Get_Source_Unit (Library_Unit (N));
- P : constant Entity_Id := Cunit_Entity (Unum);
-
- Spec : Node_Id; -- To denote a package specification
- Lim_Typ : Entity_Id; -- To denote shadow entities
- Comp_Typ : Entity_Id; -- To denote real entities
-
- Lim_Header : Entity_Id; -- Package entity
- Last_Lim_E : Entity_Id := Empty; -- Last limited entity built
- Last_Pub_Lim_E : Entity_Id; -- To set the first private entity
-
- procedure Decorate_Incomplete_Type (E : Entity_Id; Scop : Entity_Id);
- -- Add attributes of an incomplete type to a shadow entity. The same
- -- attributes are placed on the real entity, so that gigi receives
- -- a consistent view.
-
- procedure Decorate_Package_Specification (P : Entity_Id);
- -- Add attributes of a package entity to the entity in a package
- -- declaration
-
- procedure Decorate_Tagged_Type
- (Loc : Source_Ptr;
- T : Entity_Id;
- Scop : Entity_Id;
- Mark : Boolean := False);
- -- Set basic attributes of tagged type T, including its class-wide type.
- -- The parameters Loc, Scope are used to decorate the class-wide type.
- -- Use flag Mark to label the class-wide type as Materialize_Entity.
-
- procedure Build_Chain (Scope : Entity_Id; First_Decl : Node_Id);
- -- Construct list of shadow entities and attach it to entity of
- -- package that is mentioned in a limited_with clause.
-
- function New_Internal_Shadow_Entity
- (Kind : Entity_Kind;
- Sloc_Value : Source_Ptr;
- Id_Char : Character) return Entity_Id;
- -- Build a new internal entity and append it to the list of shadow
- -- entities available through the limited-header
-
- -----------------
- -- Build_Chain --
- -----------------
-
- procedure Build_Chain (Scope : Entity_Id; First_Decl : Node_Id) is
- Analyzed_Unit : constant Boolean := Analyzed (Cunit (Unum));
- Is_Tagged : Boolean;
- Decl : Node_Id;
+ Pack : constant Entity_Id := Cunit_Entity (Unum);
+
+ Shadow_Pack : Entity_Id;
+ -- The corresponding shadow entity of the withed package. This entity
+ -- offers incomplete views of all types and visible packages declared
+ -- within.
+
+ Last_Shadow : Entity_Id := Empty;
+ -- The last shadow entity created by routine Build_Shadow_Entity
+
+ function Build_Shadow_Entity
+ (Ent : Entity_Id;
+ Scop : Entity_Id;
+ Is_Tagged : Boolean := False) return Entity_Id;
+ -- Create a shadow entity that hides Ent and offers an incomplete view
+ -- of Ent. Scop is the proper scope. Flag Is_Tagged should be set when
+ -- Ent is a tagged type. The generated entity is added to Lim_Header.
+ -- This routine updates the value of Last_Shadow.
+
+ procedure Decorate_Package (Ent : Entity_Id; Scop : Entity_Id);
+ -- Perform minimal decoration of a package or its corresponding shadow
+ -- entity denoted by Ent. Scop is the proper scope.
+
+ procedure Decorate_Type
+ (Ent : Entity_Id;
+ Scop : Entity_Id;
+ Is_Tagged : Boolean := False;
+ Materialize : Boolean := False);
+ -- Perform minimal decoration of a type or its corresponding shadow
+ -- entity denoted by Ent. Scop is the proper scope. Flag Is_Tagged
+ -- should be set when Ent is a tagged type. Flag Materialize should be
+ -- set when Ent is a tagged type and its class-wide type needs to appear
+ -- in the tree.
+
+ procedure Process_Declarations (Decls : List_Id; Scop : Entity_Id);
+ -- Inspect declarative list Decls and create shadow entities for all
+ -- types and packages encountered. Scop is the proper scope.
+
+ -------------------------
+ -- Build_Shadow_Entity --
+ -------------------------
+
+ function Build_Shadow_Entity
+ (Ent : Entity_Id;
+ Scop : Entity_Id;
+ Is_Tagged : Boolean := False) return Entity_Id
+ is
+ Shadow : constant Entity_Id := Make_Temporary (Sloc (Ent), 'Z');
begin
- Decl := First_Decl;
- while Present (Decl) loop
+ -- The shadow entity must share the same name and parent as the
+ -- entity it hides.
- -- For each library_package_declaration in the environment, there
- -- is an implicit declaration of a *limited view* of that library
- -- package. The limited view of a package contains:
-
- -- * For each nested package_declaration, a declaration of the
- -- limited view of that package, with the same defining-
- -- program-unit name.
-
- -- * For each type_declaration in the visible part, an incomplete
- -- type-declaration with the same defining_identifier, whose
- -- completion is the type_declaration. If the type_declaration
- -- is tagged, then the incomplete_type_declaration is tagged
- -- incomplete.
-
- -- The partial view is tagged if the declaration has the
- -- explicit keyword, or else if it is a type extension, both
- -- of which can be ascertained syntactically.
-
- if Nkind (Decl) = N_Full_Type_Declaration then
- Is_Tagged :=
- (Nkind (Type_Definition (Decl)) = N_Record_Definition
- and then Tagged_Present (Type_Definition (Decl)))
- or else
- (Nkind (Type_Definition (Decl)) = N_Derived_Type_Definition
- and then
- Present
- (Record_Extension_Part (Type_Definition (Decl))));
+ Set_Chars (Shadow, Chars (Ent));
+ Set_Parent (Shadow, Parent (Ent));
+ Set_Ekind (Shadow, Ekind (Ent));
+ Set_Is_Internal (Shadow);
+ Set_From_Limited_With (Shadow);
- Comp_Typ := Defining_Identifier (Decl);
+ -- Add the new shadow entity to the limited view of the package
- if not Analyzed_Unit then
- if Is_Tagged then
- Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope, True);
- else
- Decorate_Incomplete_Type (Comp_Typ, Scope);
- end if;
- end if;
+ Last_Shadow := Shadow;
+ Append_Entity (Shadow, Shadow_Pack);
- -- Create shadow entity for type
+ if Is_Type (Ent) then
+ Decorate_Type (Shadow, Scop, Is_Tagged);
- Lim_Typ :=
- New_Internal_Shadow_Entity
- (Kind => Ekind (Comp_Typ),
- Sloc_Value => Sloc (Comp_Typ),
- Id_Char => 'Z');
+ if Is_Incomplete_Or_Private_Type (Ent) then
+ Set_Private_Dependents (Shadow, New_Elmt_List);
+ end if;
- Set_Chars (Lim_Typ, Chars (Comp_Typ));
- Set_Parent (Lim_Typ, Parent (Comp_Typ));
- Set_From_With_Type (Lim_Typ);
+ Set_Non_Limited_View (Shadow, Ent);
- if Is_Tagged then
- Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
- else
- Decorate_Incomplete_Type (Lim_Typ, Scope);
- end if;
+ elsif Ekind (Ent) = E_Package then
+ Decorate_Package (Shadow, Scop);
+ end if;
- Set_Non_Limited_View (Lim_Typ, Comp_Typ);
- Set_Private_Dependents (Lim_Typ, New_Elmt_List);
+ return Shadow;
+ end Build_Shadow_Entity;
- elsif Nkind_In (Decl, N_Private_Type_Declaration,
- N_Incomplete_Type_Declaration,
- N_Task_Type_Declaration,
- N_Protected_Type_Declaration)
- then
- Comp_Typ := Defining_Identifier (Decl);
+ ----------------------
+ -- Decorate_Package --
+ ----------------------
- Is_Tagged :=
- Nkind_In (Decl, N_Private_Type_Declaration,
- N_Incomplete_Type_Declaration)
- and then Tagged_Present (Decl);
+ procedure Decorate_Package (Ent : Entity_Id; Scop : Entity_Id) is
+ begin
+ Set_Ekind (Ent, E_Package);
+ Set_Etype (Ent, Standard_Void_Type);
+ Set_Scope (Ent, Scop);
+ end Decorate_Package;
+
+ -------------------
+ -- Decorate_Type --
+ -------------------
+
+ procedure Decorate_Type
+ (Ent : Entity_Id;
+ Scop : Entity_Id;
+ Is_Tagged : Boolean := False;
+ Materialize : Boolean := False)
+ is
+ CW_Typ : Entity_Id;
- if not Analyzed_Unit then
- if Is_Tagged then
- Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope, True);
- else
- Decorate_Incomplete_Type (Comp_Typ, Scope);
- end if;
- end if;
+ begin
+ -- An unanalyzed type or a shadow entity of a type is treated as an
+ -- incomplete type.
+
+ Set_Ekind (Ent, E_Incomplete_Type);
+ Set_Etype (Ent, Ent);
+ Set_Scope (Ent, Scop);
+ Set_Is_First_Subtype (Ent);
+ Set_Stored_Constraint (Ent, No_Elist);
+ Set_Full_View (Ent, Empty);
+ Init_Size_Align (Ent);
+
+ -- A tagged type and its corresponding shadow entity share one common
+ -- class-wide type.
+
+ if Is_Tagged then
+ Set_Is_Tagged_Type (Ent);
+
+ if No (Class_Wide_Type (Ent)) then
+ CW_Typ :=
+ New_External_Entity
+ (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T');
+
+ Set_Class_Wide_Type (Ent, CW_Typ);
+
+ -- Set parent to be the same as the parent of the tagged type.
+ -- We need a parent field set, and it is supposed to point to
+ -- the declaration of the type. The tagged type declaration
+ -- essentially declares two separate types, the tagged type
+ -- itself and the corresponding class-wide type, so it is
+ -- reasonable for the parent fields to point to the declaration
+ -- in both cases.
+
+ Set_Parent (CW_Typ, Parent (Ent));
+
+ Set_Ekind (CW_Typ, E_Class_Wide_Type);
+ Set_Etype (CW_Typ, Ent);
+ Set_Scope (CW_Typ, Scop);
+ Set_Is_Tagged_Type (CW_Typ);
+ Set_Is_First_Subtype (CW_Typ);
+ Init_Size_Align (CW_Typ);
+ Set_Has_Unknown_Discriminants (CW_Typ);
+ Set_Class_Wide_Type (CW_Typ, CW_Typ);
+ Set_Equivalent_Type (CW_Typ, Empty);
+ Set_From_Limited_With (CW_Typ, From_Limited_With (Ent));
+ Set_Materialize_Entity (CW_Typ, Materialize);
+ end if;
+ end if;
+ end Decorate_Type;
- Lim_Typ :=
- New_Internal_Shadow_Entity
- (Kind => Ekind (Comp_Typ),
- Sloc_Value => Sloc (Comp_Typ),
- Id_Char => 'Z');
+ --------------------------
+ -- Process_Declarations --
+ --------------------------
- Set_Chars (Lim_Typ, Chars (Comp_Typ));
- Set_Parent (Lim_Typ, Parent (Comp_Typ));
- Set_From_With_Type (Lim_Typ);
+ procedure Process_Declarations (Decls : List_Id; Scop : Entity_Id) is
+ Is_Analyzed : constant Boolean := Analyzed (Cunit (Unum));
+ Is_Tagged : Boolean;
+ Decl : Node_Id;
+ Def : Node_Id;
+ Pack : Entity_Id;
+ Shadow : Entity_Id;
+ Typ : Entity_Id;
- if Is_Tagged then
- Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
- else
- Decorate_Incomplete_Type (Lim_Typ, Scope);
- end if;
+ begin
+ -- Inspect the declarative list, looking for type declarations and
+ -- nested packages.
- Set_Non_Limited_View (Lim_Typ, Comp_Typ);
+ Decl := First (Decls);
+ while Present (Decl) loop
- -- Initialize Private_Depedents, so the field has the proper
- -- type, even though the list will remain empty.
+ -- Types
- Set_Private_Dependents (Lim_Typ, New_Elmt_List);
+ if Nkind_In (Decl, N_Full_Type_Declaration,
+ N_Incomplete_Type_Declaration,
+ N_Private_Extension_Declaration,
+ N_Private_Type_Declaration,
+ N_Protected_Type_Declaration,
+ N_Task_Type_Declaration)
+ then
+ Typ := Defining_Entity (Decl);
- elsif Nkind (Decl) = N_Private_Extension_Declaration then
- Comp_Typ := Defining_Identifier (Decl);
+ -- Determine whether the type is tagged. Note that packages
+ -- included via a limited with clause are not always analyzed,
+ -- hence the tree lookup rather than the use of attribute
+ -- Is_Tagged_Type.
- if not Analyzed_Unit then
- Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope, True);
- end if;
+ if Nkind (Decl) = N_Full_Type_Declaration then
+ Def := Type_Definition (Decl);
- -- Create shadow entity for type
+ Is_Tagged :=
+ (Nkind (Def) = N_Record_Definition
+ and then Tagged_Present (Def))
+ or else
+ (Nkind (Def) = N_Derived_Type_Definition
+ and then Present (Record_Extension_Part (Def)));
- Lim_Typ :=
- New_Internal_Shadow_Entity
- (Kind => Ekind (Comp_Typ),
- Sloc_Value => Sloc (Comp_Typ),
- Id_Char => 'Z');
+ elsif Nkind_In (Decl, N_Incomplete_Type_Declaration,
+ N_Private_Type_Declaration)
+ then
+ Is_Tagged := Tagged_Present (Decl);
- Set_Chars (Lim_Typ, Chars (Comp_Typ));
- Set_Parent (Lim_Typ, Parent (Comp_Typ));
- Set_From_With_Type (Lim_Typ);
+ elsif Nkind (Decl) = N_Private_Extension_Declaration then
+ Is_Tagged := True;
- Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
- Set_Non_Limited_View (Lim_Typ, Comp_Typ);
+ else
+ Is_Tagged := False;
+ end if;
- elsif Nkind (Decl) = N_Package_Declaration then
+ -- Perform minor decoration when the withed package has not
+ -- been analyzed.
- -- Local package
+ if not Is_Analyzed then
+ Decorate_Type (Typ, Scop, Is_Tagged, True);
+ end if;
- declare
- Spec : constant Node_Id := Specification (Decl);
+ -- Create a shadow entity that hides the type and offers an
+ -- incomplete view of the said type.
- begin
- Comp_Typ := Defining_Unit_Name (Spec);
+ Shadow := Build_Shadow_Entity (Typ, Scop, Is_Tagged);
- if not Analyzed (Cunit (Unum)) then
- Decorate_Package_Specification (Comp_Typ);
- Set_Scope (Comp_Typ, Scope);
- end if;
+ -- Packages
+
+ elsif Nkind (Decl) = N_Package_Declaration then
+ Pack := Defining_Entity (Decl);
- Lim_Typ :=
- New_Internal_Shadow_Entity
- (Kind => Ekind (Comp_Typ),
- Sloc_Value => Sloc (Comp_Typ),
- Id_Char => 'Z');
+ -- Perform minor decoration when the withed package has not
+ -- been analyzed.
- Decorate_Package_Specification (Lim_Typ);
- Set_Scope (Lim_Typ, Scope);
+ if not Is_Analyzed then
+ Decorate_Package (Pack, Scop);
+ end if;
- Set_Chars (Lim_Typ, Chars (Comp_Typ));
- Set_Parent (Lim_Typ, Parent (Comp_Typ));
- Set_From_With_Type (Lim_Typ);
+ -- Create a shadow entity that offers a limited view of all
+ -- visible types declared within.
- -- Note: The non_limited_view attribute is not used
- -- for local packages.
+ Shadow := Build_Shadow_Entity (Pack, Scop);
- Build_Chain
- (Scope => Lim_Typ,
- First_Decl => First (Visible_Declarations (Spec)));
- end;
+ Process_Declarations
+ (Decls => Visible_Declarations (Specification (Decl)),
+ Scop => Shadow);
end if;
Next (Decl);
end loop;
- end Build_Chain;
-
- ------------------------------
- -- Decorate_Incomplete_Type --
- ------------------------------
-
- procedure Decorate_Incomplete_Type (E : Entity_Id; Scop : Entity_Id) is
- begin
- Set_Ekind (E, E_Incomplete_Type);
- Set_Scope (E, Scop);
- Set_Etype (E, E);
- Set_Is_First_Subtype (E, True);
- Set_Stored_Constraint (E, No_Elist);
- Set_Full_View (E, Empty);
- Init_Size_Align (E);
- end Decorate_Incomplete_Type;
-
- --------------------------
- -- Decorate_Tagged_Type --
- --------------------------
-
- procedure Decorate_Tagged_Type
- (Loc : Source_Ptr;
- T : Entity_Id;
- Scop : Entity_Id;
- Mark : Boolean := False)
- is
- CW : Entity_Id;
+ end Process_Declarations;
- begin
- Decorate_Incomplete_Type (T, Scop);
- Set_Is_Tagged_Type (T);
-
- -- Build corresponding class_wide type, if not previously done
-
- -- Note: The class-wide entity is shared by the limited-view
- -- and the full-view.
-
- if No (Class_Wide_Type (T)) then
- CW := New_External_Entity (E_Void, Scope (T), Loc, T, 'C', 0, 'T');
-
- -- Set parent to be the same as the parent of the tagged type.
- -- We need a parent field set, and it is supposed to point to
- -- the declaration of the type. The tagged type declaration
- -- essentially declares two separate types, the tagged type
- -- itself and the corresponding class-wide type, so it is
- -- reasonable for the parent fields to point to the declaration
- -- in both cases.
-
- Set_Parent (CW, Parent (T));
-
- -- Set remaining fields of classwide type
-
- Set_Ekind (CW, E_Class_Wide_Type);
- Set_Etype (CW, T);
- Set_Scope (CW, Scop);
- Set_Is_Tagged_Type (CW);
- Set_Is_First_Subtype (CW, True);
- Init_Size_Align (CW);
- Set_Has_Unknown_Discriminants (CW, True);
- Set_Class_Wide_Type (CW, CW);
- Set_Equivalent_Type (CW, Empty);
- Set_From_With_Type (CW, From_With_Type (T));
- Set_Materialize_Entity (CW, Mark);
-
- -- Link type to its class-wide type
-
- Set_Class_Wide_Type (T, CW);
- end if;
- end Decorate_Tagged_Type;
-
- ------------------------------------
- -- Decorate_Package_Specification --
- ------------------------------------
-
- procedure Decorate_Package_Specification (P : Entity_Id) is
- begin
- -- Place only the most basic attributes
-
- Set_Ekind (P, E_Package);
- Set_Etype (P, Standard_Void_Type);
- end Decorate_Package_Specification;
-
- --------------------------------
- -- New_Internal_Shadow_Entity --
- --------------------------------
-
- function New_Internal_Shadow_Entity
- (Kind : Entity_Kind;
- Sloc_Value : Source_Ptr;
- Id_Char : Character) return Entity_Id
- is
- E : constant Entity_Id := Make_Temporary (Sloc_Value, Id_Char);
-
- begin
- Set_Ekind (E, Kind);
- Set_Is_Internal (E, True);
-
- if Kind in Type_Kind then
- Init_Size_Align (E);
- end if;
+ -- Local variables
- Append_Entity (E, Lim_Header);
- Last_Lim_E := E;
- return E;
- end New_Internal_Shadow_Entity;
+ Last_Public_Shadow : Entity_Id := Empty;
+ Private_Shadow : Entity_Id;
+ Spec : Node_Id;
-- Start of processing for Build_Limited_Views
null;
when N_Subprogram_Declaration =>
- Error_Msg_N ("subprograms not allowed in "
- & "limited with_clauses", N);
+ Error_Msg_N ("subprograms not allowed in limited with_clauses", N);
return;
when N_Generic_Package_Declaration |
N_Generic_Subprogram_Declaration =>
- Error_Msg_N ("generics not allowed in "
- & "limited with_clauses", N);
+ Error_Msg_N ("generics not allowed in limited with_clauses", N);
return;
when N_Generic_Instantiation =>
- Error_Msg_N ("generic instantiations not allowed in "
- & "limited with_clauses", N);
+ Error_Msg_N
+ ("generic instantiations not allowed in limited with_clauses",
+ N);
return;
when N_Generic_Renaming_Declaration =>
- Error_Msg_N ("generic renamings not allowed in "
- & "limited with_clauses", N);
+ Error_Msg_N
+ ("generic renamings not allowed in limited with_clauses", N);
return;
when N_Subprogram_Renaming_Declaration =>
- Error_Msg_N ("renamed subprograms not allowed in "
- & "limited with_clauses", N);
+ Error_Msg_N
+ ("renamed subprograms not allowed in limited with_clauses", N);
return;
when N_Package_Renaming_Declaration =>
- Error_Msg_N ("renamed packages not allowed in "
- & "limited with_clauses", N);
+ Error_Msg_N
+ ("renamed packages not allowed in limited with_clauses", N);
return;
when others =>
raise Program_Error;
end case;
- -- The limited unit is not analyzed but the with clause must be
- -- minimally decorated so that checks on unused with clause also work
- -- with limited with clauses.
+ -- The withed unit may not be analyzed, but the with calause itself
+ -- must be minimally decorated. This ensures that the checks on unused
+ -- with clauses also process limieted withs.
+
+ Set_Ekind (Pack, E_Package);
+ Set_Etype (Pack, Standard_Void_Type);
- if Is_Entity_Name (Name (N)) then
- Set_Entity (Name (N), P);
+ if Is_Entity_Name (Nam) then
+ Set_Entity (Nam, Pack);
- elsif Nkind (Name (N)) = N_Selected_Component then
- Set_Entity (Selector_Name (Name (N)), P);
+ elsif Nkind (Nam) = N_Selected_Component then
+ Set_Entity (Selector_Name (Nam), Pack);
end if;
-- Check if the chain is already built
return;
end if;
- Set_Ekind (P, E_Package);
-
- -- Build the header of the limited_view
-
- Lim_Header := Make_Temporary (Sloc (N), 'Z');
- Set_Ekind (Lim_Header, E_Package);
- Set_Is_Internal (Lim_Header);
- Set_Limited_View (P, Lim_Header);
+ -- Create the shadow package wich hides the withed unit and provides
+ -- incomplete view of all types and packages declared within.
- -- Create the auxiliary chain. All the shadow entities are appended to
- -- the list of entities of the limited-view header
+ Shadow_Pack := Make_Temporary (Sloc (N), 'Z');
+ Set_Ekind (Shadow_Pack, E_Package);
+ Set_Is_Internal (Shadow_Pack);
+ Set_Limited_View (Pack, Shadow_Pack);
- Build_Chain
- (Scope => P,
- First_Decl => First (Visible_Declarations (Spec)));
+ -- Inspect the visible declarations of the withed unit and create shadow
+ -- entities that hide existing types and packages.
- -- Save the last built shadow entity. It is needed later to set the
- -- reference to the first shadow entity in the private part
+ Process_Declarations
+ (Decls => Visible_Declarations (Spec),
+ Scop => Pack);
- Last_Pub_Lim_E := Last_Lim_E;
+ Last_Public_Shadow := Last_Shadow;
- -- Ada 2005 (AI-262): Add the limited view of the private declarations
- -- Required to give support to limited-private-with clauses
+ -- Ada 2005 (AI-262): Build the limited view of the private declarations
+ -- to accomodate limited private with clauses.
- Build_Chain (Scope => P,
- First_Decl => First (Private_Declarations (Spec)));
+ Process_Declarations
+ (Decls => Private_Declarations (Spec),
+ Scop => Pack);
- if Last_Pub_Lim_E /= Empty then
- Set_First_Private_Entity
- (Lim_Header, Next_Entity (Last_Pub_Lim_E));
+ if Present (Last_Public_Shadow) then
+ Private_Shadow := Next_Entity (Last_Public_Shadow);
else
- Set_First_Private_Entity
- (Lim_Header, First_Entity (P));
+ Private_Shadow := First_Entity (Shadow_Pack);
end if;
+ Set_First_Private_Entity (Shadow_Pack, Private_Shadow);
Set_Limited_View_Installed (Spec);
end Build_Limited_Views;
-- Indicate that the limited view of the package is not installed
- Set_From_With_Type (P, False);
+ Set_From_Limited_With (P, False);
Set_Limited_View_Installed (N, False);
end Remove_Limited_With_Clause;
-- Ada 2005 (AI-50217): Cannot use instance in limited with_clause
- if From_With_Type (Gen_Unit) then
+ if From_Limited_With (Gen_Unit) then
Error_Msg_N
("cannot instantiate a limited withed package", Gen_Id);
else
-- with clause, in which case retrieve the non-limited view. This
-- applies to incomplete types as well as to class-wide types.
- if From_With_Type (Desig_Act) then
+ if From_Limited_With (Desig_Act) then
Desig_Act := Available_View (Desig_Act);
end if;
-- Exclude imported types, which may be frozen if they appear in a
-- representation clause for a local type.
- and then not From_With_Type (T)
+ and then not From_Limited_With (T)
-- Exclude generated entities (not coming from source). The common
-- case is when we generate a renaming which prematurely freezes the
-- (which is declared elsewhere in some other scope).
if Ekind (Desig_Type) = E_Incomplete_Type
- and then not From_With_Type (Desig_Type)
+ and then not From_Limited_With (Desig_Type)
and then Is_Overloadable (Current_Scope)
then
Append_Elmt (Current_Scope, Private_Dependents (Desig_Type));
-- generic formal, because no use of it will reach the backend.
elsif Nkind (Related_Nod) = N_Function_Specification
- and then not From_With_Type (Desig_Type)
+ and then not From_Limited_With (Desig_Type)
and then not Is_Generic_Type (Desig_Type)
then
if Present (Enclosing_Prot_Type) then
Scope_Id => Current_Scope));
else
- if From_With_Type (Typ) then
+ if From_Limited_With (Typ) then
-- AI05-151: Incomplete types are allowed in all basic
-- declarations, including access to subprograms.
-- 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
+ if not From_Limited_With (T) then
Init_Size_Align (T);
end if;
-- finalization list at the point the access type is frozen, to
-- prevent unsatisfied references at link time.
- if not From_With_Type (T) or else Is_Access_Type (T) then
+ if not From_Limited_With (T) or else Is_Access_Type (T) then
Set_Has_Delayed_Freeze (T);
end if;
end;
-- Ada 2005 (AI-412): Decorate an incomplete subtype of an
-- incomplete type visible through a limited with clause.
- if From_With_Type (T)
+ if From_Limited_With (T)
and then Present (Non_Limited_View (T))
then
- Set_From_With_Type (Id);
- Set_Non_Limited_View (Id, Non_Limited_View (T));
+ Set_From_Limited_With (Id);
+ Set_Non_Limited_View (Id, Non_Limited_View (T));
-- Ada 2005 (AI-412): Add the regular incomplete subtype
-- to the private dependents of the original incomplete
-- incomplete type or imported via a limited with clause.
if Has_Discriminants (T)
- or else
- (From_With_Type (T)
- and then Present (Non_Limited_View (T))
- and then Nkind (Parent (Non_Limited_View (T))) =
- N_Full_Type_Declaration
- and then Present (Discriminant_Specifications
- (Parent (Non_Limited_View (T)))))
+ or else (From_Limited_With (T)
+ and then Present (Non_Limited_View (T))
+ and then Nkind (Parent (Non_Limited_View (T))) =
+ N_Full_Type_Declaration
+ and then Present (Discriminant_Specifications
+ (Parent (Non_Limited_View (T)))))
then
Error_Msg_N
("(Ada 2005) incomplete subtype may not be constrained", C);
-- incomplete type imported through a limited_with clause,
-- if the full view is visible.
- if From_With_Type (DT)
- and then not From_With_Type (Scope (DT))
+ if From_Limited_With (DT)
+ and then not From_Limited_With (Scope (DT))
and then
(Is_Immediately_Visible (Scope (DT))
or else
-- full view if available.
if Is_Incomplete_Type (Prefix_Type)
- and then From_With_Type (Prefix_Type)
+ and then From_Limited_With (Prefix_Type)
and then Present (Non_Limited_View (Prefix_Type))
then
Prefix_Type := Get_Full_View (Non_Limited_View (Prefix_Type));
end if;
elsif Ekind (Prefix_Type) = E_Class_Wide_Type
- and then From_With_Type (Prefix_Type)
+ and then From_Limited_With (Prefix_Type)
and then Present (Non_Limited_View (Etype (Prefix_Type)))
then
Prefix_Type :=
-- end Pkg; -- Comp is not visible
if Nkind (Name) = N_Explicit_Dereference
- and then From_With_Type (Etype (Prefix (Name)))
+ and then From_Limited_With (Etype (Prefix (Name)))
and then not Is_Potentially_Use_Visible (Etype (Name))
and then Nkind (Parent (Cunit_Entity (Current_Sem_Unit))) =
N_Package_Specification
Inc : constant Entity_Id := First_Subtype (Type_To_Use);
begin
- if From_With_Type (Scope (Type_To_Use)) then
+ if From_Limited_With (Scope (Type_To_Use)) then
Error_Msg_NE
("\limited view of& has no components", N, Inc);
-- usage of an entity from the limited view.
if not Analyzed (Etype (Actual))
- and then From_With_Type (Etype (Actual))
+ and then From_Limited_With (Etype (Actual))
then
Error_Msg_Qual_Level := 1;
Error_Msg_NE
-- incomplete type imported through a limited_with clause,
-- if the full view is visible.
- if From_With_Type (Typ)
- and then not From_With_Type (Scope (Typ))
+ if From_Limited_With (Typ)
+ and then not From_Limited_With (Scope (Typ))
and then
(Is_Immediately_Visible (Scope (Typ))
or else
-- non-limited view. If still incomplete, retrieve full view.
if Ekind (Obj_Type) = E_Incomplete_Type
- and then From_With_Type (Obj_Type)
+ and then From_Limited_With (Obj_Type)
then
Obj_Type := Get_Full_View (Non_Limited_View (Obj_Type));
end if;
begin
if Ekind (Typ) = E_Incomplete_Type
- and then From_With_Type (Typ)
+ and then From_Limited_With (Typ)
and then Present (Non_Limited_View (Typ))
then
Set_Etype (Id, Non_Limited_View (Typ));
if Ekind (Rtyp) = E_Anonymous_Access_Type then
Etyp := Directly_Designated_Type (Rtyp);
- if Is_Class_Wide_Type (Etyp) and then From_With_Type (Etyp) then
+ if Is_Class_Wide_Type (Etyp)
+ and then From_Limited_With (Etyp)
+ then
Set_Directly_Designated_Type
(Etype (Current_Scope), Available_View (Etyp));
end if;
then
Set_Has_Delayed_Freeze (Designator);
- elsif Ekind (T) = E_Incomplete_Type and then From_With_Type (T) then
+ elsif Ekind (T) = E_Incomplete_Type
+ and then From_Limited_With (T)
+ then
Set_Has_Delayed_Freeze (Designator);
-- AI05-0151: In Ada 2012, Incomplete types can appear in the profile
-- access-to-class-wide type in a formal. Both entities designate the
-- same type.
- if From_With_Type (T1) and then T2 = Available_View (T1) then
+ if From_Limited_With (T1) and then T2 = Available_View (T1) then
return True;
- elsif From_With_Type (T2) and then T1 = Available_View (T2) then
+ elsif From_Limited_With (T2) and then T1 = Available_View (T2) then
return True;
- elsif From_With_Type (T1)
- and then From_With_Type (T2)
+ elsif From_Limited_With (T1)
+ and then From_Limited_With (T2)
and then Available_View (T1) = Available_View (T2)
then
return True;
-- the designated type comes from the limited view (for back-end
-- purposes).
- Set_From_With_Type (Formal_Typ, From_With_Type (Result_Subt));
+ Set_From_Limited_With
+ (Formal_Typ, From_Limited_With (Result_Subt));
Layout_Type (Formal_Typ);
First_Out_Param : Entity_Id := Empty;
-- Used for setting Is_Only_Out_Parameter
- function Designates_From_With_Type (Typ : Entity_Id) return Boolean;
+ function Designates_From_Limited_With (Typ : Entity_Id) return Boolean;
-- Determine whether an access type designates a type coming from a
-- limited view.
-- default has the type of the formal, so we must also check explicitly
-- for an access attribute.
- -------------------------------
- -- Designates_From_With_Type --
- -------------------------------
+ ----------------------------------
+ -- Designates_From_Limited_With --
+ ----------------------------------
- function Designates_From_With_Type (Typ : Entity_Id) return Boolean is
+ function Designates_From_Limited_With (Typ : Entity_Id) return Boolean is
Desig : Entity_Id := Typ;
begin
end if;
return
- Ekind (Desig) = E_Incomplete_Type and then From_With_Type (Desig);
- end Designates_From_With_Type;
+ Ekind (Desig) = E_Incomplete_Type
+ and then From_Limited_With (Desig);
+ end Designates_From_Limited_With;
---------------------------
-- Is_Class_Wide_Default --
if Is_Tagged_Type (Formal_Type) then
if Ekind (Scope (Current_Scope)) = E_Package
- and then not From_With_Type (Formal_Type)
+ and then not From_Limited_With (Formal_Type)
and then not Is_Generic_Type (Formal_Type)
and then not Is_Class_Wide_Type (Formal_Type)
then
-- is also class-wide.
if Ekind (Formal_Type) = E_Anonymous_Access_Type
- and then not Designates_From_With_Type (Formal_Type)
+ and then not Designates_From_Limited_With (Formal_Type)
and then Is_Class_Wide_Default (Default)
and then not Is_Class_Wide_Type (Designated_Type (Formal_Type))
then
-- limited with Pkg; -- ERROR
-- package Pkg is ...
- if From_With_Type (Id) then
+ if From_Limited_With (Id) then
return;
end if;
E := First_Entity (Spec_Id);
while Present (E) loop
if Ekind (E) = E_Anonymous_Access_Type
- and then From_With_Type (E)
+ and then From_Limited_With (E)
then
IR := Make_Itype_Reference (Sloc (P_Body));
Set_Itype (IR, E);
T := Entity (Id);
- if T = Any_Type or else From_With_Type (T) then
+ if T = Any_Type or else From_Limited_With (T) then
null;
-- Note that the use_type clause may mention a subtype of the type
-- The non-limited view may itself be incomplete, in which case
-- get the full view if available.
- elsif From_With_Type (Id)
+ elsif From_Limited_With (Id)
and then Is_Type (Id)
and then Ekind (Id) = E_Incomplete_Type
and then Present (Non_Limited_View (Id))
-- Ada 2005 (AI-50217): Check usage of entities in limited withed units
- if Ekind (P_Name) = E_Package and then From_With_Type (P_Name) then
- if From_With_Type (Id)
+ if Ekind (P_Name) = E_Package and then From_Limited_With (P_Name) then
+ if From_Limited_With (Id)
or else Is_Type (Id)
or else Ekind (Id) = E_Package
then
-- tagged if the type itself has an untagged incomplete
-- type view in its package.
- if From_With_Type (T)
+ if From_Limited_With (T)
and then not Is_Tagged_Type (Available_View (T))
then
Error_Msg_N
-- Ada 2005 (AI-251, AI-50217): Handle interfaces visible through
-- limited-with clauses
- if From_With_Type (T_Name)
+ if From_Limited_With (T_Name)
and then Ekind (T_Name) in Incomplete_Kind
and then Present (Non_Limited_View (T_Name))
and then Is_Interface (Non_Limited_View (T_Name))
or else (Is_Private_Type (T1) and then Has_Discriminants (T1))
or else (Is_Task_Type (T1) and then Has_Discriminants (T1))
or else (Is_Incomplete_Type (T1)
- and then From_With_Type (T1)
+ and then From_Limited_With (T1)
and then Present (Non_Limited_View (T1))
and then Is_Record_Type
(Get_Full_View (Non_Limited_View (T1))));
-- Ada 2005 (AI-50217): Check restriction
- if From_With_Type (P) then
+ if From_Limited_With (P) then
Error_Msg_N ("limited withed package cannot appear in use clause", N);
end if;
-- a limited view unless we only have a limited view of its enclosing
-- package.
- elsif From_With_Type (T) and then From_With_Type (Scope (T)) then
+ elsif From_Limited_With (T) and then From_Limited_With (Scope (T)) then
Error_Msg_N
("incomplete type from limited view "
& "cannot appear in use clause", Id);
Result := No_Rational;
end if;
+ -- Provide minimal semantic information on dimension expressions,
+ -- even though they have no run-time existence. This is for use by
+ -- ASIS tools, in particular pretty-printing.
+
+ Set_Entity (N, Standard_Op_Minus);
+ Set_Etype (N, Standard_Integer);
return Result;
end Process_Minus;
Result := Left_Rat / Right_Rat;
end if;
+ -- Provide minimal semantic information on dimension expressions,
+ -- even though they have no run-time existence. This is for use by
+ -- ASIS tools, in particular pretty-printing.
+
+ Set_Entity (N, Standard_Op_Divide);
+ Set_Etype (N, Standard_Integer);
return Result;
end Process_Divide;
-- Ada 2005 (AI-50217)
- elsif From_With_Type (Designated_Type (T))
+ elsif From_Limited_With (Designated_Type (T))
and then Present (Non_Limited_View (Designated_Type (T)))
and then Scope (Designated_Type (T)) = Scope (Subp)
then
Spec_Id : Entity_Id;
begin
+ -- Disable the support for pragma Refined_Pre as its static and
+ -- runtime semantics are still under heavy design.
+
+ if Pname = Name_Refined_Pre then
+ Error_Pragma ("pragma % is not supported");
+ return;
+ end if;
+
Analyze_Refined_Pragma (Spec_Id, Body_Id, Legal);
-- Analyze the boolean expression as a "spec expression"
-- Ada 2005 (AI-217): Handle entities from limited views
- if From_With_Type (Opnd) then
+ if From_Limited_With (Opnd) then
Error_Msg_Qual_Level := 99;
Error_Msg_NE -- CODEFIX
("missing WITH clause on package &", N,
("type conversions require visibility of the full view",
N);
- elsif From_With_Type (Target)
+ elsif From_Limited_With (Target)
and then not
(Is_Access_Type (Target_Typ)
and then Present (Non_Limited_View (Etype (Target))))
-- it to determine whether the conversion is legal.
elsif Is_Class_Wide_Type (Opnd_Type)
- and then From_With_Type (Opnd_Type)
+ and then From_Limited_With (Opnd_Type)
and then Present (Non_Limited_View (Etype (Opnd_Type)))
and then Is_Interface (Non_Limited_View (Etype (Opnd_Type)))
then
-- Handle the limited view of a type
if Is_Incomplete_Type (Desig)
- and then From_With_Type (Desig)
+ and then From_Limited_With (Desig)
and then Present (Non_Limited_View (Desig))
then
return Available_View (Desig);
then
return Covers (Designated_Type (T1), Designated_Type (T2))
or else
- (From_With_Type (Designated_Type (T1))
+ (From_Limited_With (Designated_Type (T1))
and then Covers (Designated_Type (T2), Designated_Type (T1)));
-- A boolean operation on integer literals is compatible with modular
-- Ada 2005 (AI-50217): Additional branches to make the shadow entity
-- obtained through a limited_with compatible with its real entity.
- elsif From_With_Type (T1) then
+ elsif From_Limited_With (T1) then
-- If the expected type is the non-limited view of a type, the
-- expression may have the limited view. If that one in turn is
return False;
end if;
- elsif From_With_Type (T2) then
+ elsif From_Limited_With (T2) then
-- If units in the context have Limited_With clauses on each other,
-- either type might have a limited view. Checks performed elsewhere
-- Ada 2005 (AI-50217): If the type is available through a limited
-- with_clause, verify that its full view has been analyzed.
- if From_With_Type (T)
+ if From_Limited_With (T)
and then Present (Non_Limited_View (T))
and then Ekind (Non_Limited_View (T)) /= E_Incomplete_Type
then
begin
return
Is_Class_Wide_Type (Typ)
- and then (Is_Limited_Type (Typ) or else From_With_Type (Typ));
+ and then (Is_Limited_Type (Typ) or else From_Limited_With (Typ));
end Is_Limited_Class_Wide_Type;
---------------------------------
("\\found an access type with designated}!",
Expr, Designated_Type (Found_Type));
else
- if From_With_Type (Found_Type) then
+ if From_Limited_With (Found_Type) then
Error_Msg_NE ("\\found incomplete}!", Expr, Found_Type);
Error_Msg_Qual_Level := 99;
Error_Msg_NE -- CODEFIX
or else Referenced_As_LHS_Check_Spec (Ent)
or else Referenced_As_Out_Parameter_Check_Spec (Ent)
or else
- (From_With_Type (Ent)
+ (From_Limited_With (Ent)
and then Is_Incomplete_Type (Ent)
and then Present (Non_Limited_View (Ent))
and then Referenced (Non_Limited_View (Ent)))
projects / platform / upstream / gcc.git / commitdiff