mentioned legality rule, to prevent breaking the privacy of the type when
imposing that rule on outside types that derive from the private view of the
type.
+
+Structural Generic Instantiation
+--------------------------------
+
+The compiler implements a second kind of generic instantiation, called
+"structural", alongside the traditional instantiation specified by the
+language, which is defined as follows: the structural instantiation of
+a generic unit on given actual parameters is the anonymous instantiation
+of the generic unit on the actual parameters done in the outermost scope
+where it would be legal to do an identical traditional instantiation.
+
+There is at most one structural instantiation of a generic unit on given
+actual parameters done in a partition.
+
+Structural generic instances (the product of structural instantiation)
+are implicitly created whenever a reference to them is made in a place
+where a name is accepted by the language.
+
+Syntax
+^^^^^^
+
+.. code-block:: text
+
+ name ::= { set of productions specified in the RM }
+ | structural_generic_instance_name
+
+ structural_generic_instance_name ::= name generic_actual_part
+
+Legality Rules
+^^^^^^^^^^^^^^
+
+The ``name`` in a ``structural_generic_instance_name`` shall denote a generic
+unit that is preelaborated. Note that, unlike in a traditional instantiation,
+there are no square brackets around the ``generic_actual_part`` in the second
+production, which means that it is mandatory and, therefore, that the generic
+unit shall have at least one generic formal parameter.
+
+The generic unit shall not take a generic formal object of mode ``in out``.
+If the generic unit takes a generic formal object of mode ``in``, then the
+corresponding generic actual parameter shall be a static expression.
+
+A ``structural_generic_instance_name`` shall not be present in a library
+unit if the structural instance is also a library unit and has a semantic
+dependence on the former.
+
+Static Semantics
+^^^^^^^^^^^^^^^^
+
+A ``structural_generic_instance_name`` denotes the instance that is the
+product of the structural instantiation of a generic unit on the specified
+actual parameters. This instance is unique to a partition.
+
+Example:
+
+.. code-block:: ada
+
+ with Ada.Containers.Vectors;
+
+ procedure P is
+ V : Ada.Containers.Vectors(Positive,Integer).Vector;
+
+ begin
+ V.Append (1);
+ V.Append (0);
+ Ada.Containers.Vectors(Positive,Integer).Generic_Sorting("<").Sort (V);
+ end;
+
+This procedure references two structural instantiations of two different generic
+units: ``Ada.Containers.Vectors(Positive,Integer)`` is the structural instance
+of the generic unit ``Ada.Containers.Vectors`` on ``Positive`` and ``Integer``
+and ``Ada.Containers.Vectors(Positive,Integer).Generic_Sorting("<")`` is the
+structural instance of the nested generic unit
+``Ada.Containers.Vectors(Positive,Integer).Generic_Sorting`` on ``"<"``.
+
+Note that the following example is illegal:
+
+.. code-block:: ada
+
+ with Ada.Containers.Vectors;
+
+ package Q is
+ type T is record
+ I : Integer;
+ end record;
+
+ V : Ada.Containers.Vectors(Positive,T).Vector;
+ end Q;
+
+The reason is that ``Ada.Containers.Vectors``, ``Positive`` and ``Q.T`` being
+library-level entities, the structural instance ``Ada.Containers.Vectors(Positive,T)`` is a library unit with a dependence
+on ``Q`` and, therefore, cannot be referenced from within ``Q``. The simple
+way out is to declare a traditional instantiation in this case:
+
+.. code-block:: ada
+
+ with Ada.Containers.Vectors;
+
+ package Q is
+ type T is record
+ I : Integer;
+ end record;
+
+ package Vectors_Of_T is new Ada.Containers.Vectors(Positive,T);
+
+ V : Vectors_Of_T.Vector;
+ end Q;
+
+But the following example is legal:
+
+.. code-block:: ada
+
+ with Ada.Containers.Vectors;
+
+ procedure P is
+ type T is record
+ I : Integer;
+ end record;
+
+ V : Ada.Containers.Vectors(Positive,T).Vector;
+ end;
+
+because the structural instance ``Ada.Containers.Vectors(Positive,T)`` is
+not a library unit.
+
+The first example can be rewritten in a less verbose manner:
+
+.. code-block:: ada
+
+ with Ada.Containers.Vectors; use Ada.Containers.Vectors(Positive,Integer);
+
+ procedure P is
+ V : Vector;
+
+ begin
+ V.Append (1);
+ V.Append (0);
+ Generic_Sorting("<").Sort (V);
+ end;
+
+Another example, which additionally uses the inference of dependent types:
+
+.. code-block:: ada
+
+ with Ada.Unchecked_Deallocation;
+
+ procedure P is
+
+ type Integer_Access is access all Integer;
+
+ A : Integer_Access := new Integer'(1);
+
+ begin
+ Ada.Unchecked_Deallocation(Name => Integer_Access) (A);
+ end;
-- record is declared to be limited. Note that this flag is not set
-- simply because some components of the record are limited.
+-- Is_Link_Once
+-- Defined in all entities. Set to indicate that an entity can be defined
+-- in multiple compilation units without generating a linker error. The
+-- compiler guarantees that the multiple definitions are equivalent and,
+-- therefore, that the linker can freely pick one of them. If this flag
+-- is set on an entity, then the Is_Public flag is also set on it.
+
-- Is_Local_Anonymous_Access
-- Defined in access types. Set for an anonymous access type to indicate
-- that the type is created for a record component with an access
-- Is_Known_Valid
-- Is_Limited_Composite
-- Is_Limited_Record
+ -- Is_Link_Once
-- Is_Loop_Parameter
-- Is_Obsolescent
-- Is_Package_Body_Entity
with Sem; use Sem;
with Sem_Aux;
with Sem_Ch8;
+with Sem_Ch12;
with Sem_SCIL;
with Sem_Elab; use Sem_Elab;
with Sem_Prag; use Sem_Prag;
Analyze_Inlined_Bodies;
end if;
+ -- Mark the structural instances spawned by the main unit as
+ -- Link Once because other units may spawn them too.
+
+ Sem_Ch12.Mark_Link_Once
+ (Declarations (Aux_Decls_Node (Cunit (Main_Unit))));
+
+ if Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body then
+ Sem_Ch12.Mark_Link_Once
+ (Declarations
+ (Aux_Decls_Node (Spec_Lib_Unit (Cunit (Main_Unit)))));
+ end if;
+
-- Remove entities from program that do not have any execution
-- time references.
Is_SPARK_Mode_On_Node,
Is_Static_Coextension,
Is_Static_Expression,
+ Is_Structural,
Is_Subprogram_Descriptor,
Is_Task_Allocation_Block,
Is_Task_Body_Procedure,
Is_Limited_Composite,
Is_Limited_Interface,
Is_Limited_Record,
+ Is_Link_Once,
Is_Local_Anonymous_Access,
Is_Loop_Parameter,
Is_Machine_Code_Subprogram,
Sm (Is_Limited_Composite, Flag),
Sm (Is_Limited_Interface, Flag),
Sm (Is_Limited_Record, Flag),
+ Sm (Is_Link_Once, Flag),
Sm (Is_Loop_Parameter, Flag),
Sm (Is_Obsolescent, Flag),
Sm (Is_Package_Body_Entity, Flag),
(Sy (Defining_Unit_Name, Node_Id),
Sy (Name, Node_Id, Default_Empty),
Sy (Generic_Associations, List_Id, Default_No_List),
+ Sm (Parent_Spec, Node_Id),
Sm (Instance_Spec, Node_Id),
Sm (Is_Declaration_Level_Node, Flag),
Sm (Is_Elaboration_Checks_OK_Node, Flag),
Sm (Is_Elaboration_Warnings_OK_Node, Flag),
Sm (Is_Known_Guaranteed_ABE, Flag),
Sm (Is_SPARK_Mode_On_Node, Flag),
- Sm (Parent_Spec, Node_Id)));
+ Sm (Is_Structural, Flag)));
Ab (N_Subprogram_Instantiation, N_Generic_Instantiation,
(Sy (Must_Override, Flag),
@copying
@quotation
-GNAT Reference Manual , Sep 12, 2025
+GNAT Reference Manual , Sep 19, 2025
AdaCore
* Finally construct::
* Continue statement::
* Destructors::
+* Structural Generic Instantiation::
Storage Model
* Legality Rules: Legality Rules<2>.
* Dynamic Semantics: Dynamic Semantics<2>.
+Structural Generic Instantiation
+
+* Syntax: Syntax<3>.
+* Legality Rules: Legality Rules<3>.
+* Static Semantics::
+
Security Hardening Features
* Register Scrubbing::
* Finally construct::
* Continue statement::
* Destructors::
+* Structural Generic Instantiation::
@end menu
Note that @code{continue} is a keyword but it is not a reserved word. This is a
configuration that does not exist in standard Ada.
-@node Destructors,,Continue statement,Experimental Language Extensions
+@node Destructors,Structural Generic Instantiation,Continue statement,Experimental Language Extensions
@anchor{gnat_rm/gnat_language_extensions destructors}@anchor{476}
@subsection Destructors
imposing that rule on outside types that derive from the private view of the
type.
+@node Structural Generic Instantiation,,Destructors,Experimental Language Extensions
+@anchor{gnat_rm/gnat_language_extensions structural-generic-instantiation}@anchor{477}
+@subsection Structural Generic Instantiation
+
+
+The compiler implements a second kind of generic instantiation, called
+“structural”, alongside the traditional instantiation specified by the
+language, which is defined as follows: the structural instantiation of
+a generic unit on given actual parameters is the anonymous instantiation
+of the generic unit on the actual parameters done in the outermost scope
+where it would be legal to do an identical traditional instantiation.
+
+There is at most one structural instantiation of a generic unit on given
+actual parameters done in a partition.
+
+Structural generic instances (the product of structural instantiation)
+are implicitly created whenever a reference to them is made in a place
+where a name is accepted by the language.
+
+@menu
+* Syntax: Syntax<3>.
+* Legality Rules: Legality Rules<3>.
+* Static Semantics::
+
+@end menu
+
+@node Syntax<3>,Legality Rules<3>,,Structural Generic Instantiation
+@anchor{gnat_rm/gnat_language_extensions id7}@anchor{478}
+@subsubsection Syntax
+
+
+@example
+name ::= @{ set of productions specified in the RM @}
+ | structural_generic_instance_name
+
+structural_generic_instance_name ::= name generic_actual_part
+@end example
+
+@node Legality Rules<3>,Static Semantics,Syntax<3>,Structural Generic Instantiation
+@anchor{gnat_rm/gnat_language_extensions id8}@anchor{479}
+@subsubsection Legality Rules
+
+
+The @code{name} in a @code{structural_generic_instance_name} shall denote a generic
+unit that is preelaborated. Note that, unlike in a traditional instantiation,
+there are no square brackets around the @code{generic_actual_part} in the second
+production, which means that it is mandatory and, therefore, that the generic
+unit shall have at least one generic formal parameter.
+
+The generic unit shall not take a generic formal object of mode @code{in out}.
+If the generic unit takes a generic formal object of mode @code{in}, then the
+corresponding generic actual parameter shall be a static expression.
+
+A @code{structural_generic_instance_name} shall not be present in a library
+unit if the structural instance is also a library unit and has a semantic
+dependence on the former.
+
+@node Static Semantics,,Legality Rules<3>,Structural Generic Instantiation
+@anchor{gnat_rm/gnat_language_extensions static-semantics}@anchor{47a}
+@subsubsection Static Semantics
+
+
+A @code{structural_generic_instance_name} denotes the instance that is the
+product of the structural instantiation of a generic unit on the specified
+actual parameters. This instance is unique to a partition.
+
+Example:
+
+@example
+with Ada.Containers.Vectors;
+
+procedure P is
+ V : Ada.Containers.Vectors(Positive,Integer).Vector;
+
+begin
+ V.Append (1);
+ V.Append (0);
+ Ada.Containers.Vectors(Positive,Integer).Generic_Sorting("<").Sort (V);
+end;
+@end example
+
+This procedure references two structural instantiations of two different generic
+units: @code{Ada.Containers.Vectors(Positive,Integer)} is the structural instance
+of the generic unit @code{Ada.Containers.Vectors} on @code{Positive} and @code{Integer}
+and @code{Ada.Containers.Vectors(Positive,Integer).Generic_Sorting("<")} is the
+structural instance of the nested generic unit
+@code{Ada.Containers.Vectors(Positive,Integer).Generic_Sorting} on @code{"<"}.
+
+Note that the following example is illegal:
+
+@example
+with Ada.Containers.Vectors;
+
+package Q is
+ type T is record
+ I : Integer;
+ end record;
+
+ V : Ada.Containers.Vectors(Positive,T).Vector;
+end Q;
+@end example
+
+The reason is that @code{Ada.Containers.Vectors}, @code{Positive} and @code{Q.T} being
+library-level entities, the structural instance @code{Ada.Containers.Vectors(Positive,T)} is a library unit with a dependence
+on @code{Q} and, therefore, cannot be referenced from within @code{Q}. The simple
+way out is to declare a traditional instantiation in this case:
+
+@example
+with Ada.Containers.Vectors;
+
+package Q is
+ type T is record
+ I : Integer;
+ end record;
+
+ package Vectors_Of_T is new Ada.Containers.Vectors(Positive,T);
+
+ V : Vectors_Of_T.Vector;
+end Q;
+@end example
+
+But the following example is legal:
+
+@example
+with Ada.Containers.Vectors;
+
+procedure P is
+ type T is record
+ I : Integer;
+ end record;
+
+ V : Ada.Containers.Vectors(Positive,T).Vector;
+end;
+@end example
+
+because the structural instance @code{Ada.Containers.Vectors(Positive,T)} is
+not a library unit.
+
+The first example can be rewritten in a less verbose manner:
+
+@example
+with Ada.Containers.Vectors; use Ada.Containers.Vectors(Positive,Integer);
+
+procedure P is
+ V : Vector;
+
+begin
+ V.Append (1);
+ V.Append (0);
+ Generic_Sorting("<").Sort (V);
+end;
+@end example
+
+Another example, which additionally uses the inference of dependent types:
+
+@example
+with Ada.Unchecked_Deallocation;
+
+procedure P is
+
+ type Integer_Access is access all Integer;
+
+ A : Integer_Access := new Integer'(1);
+
+begin
+ Ada.Unchecked_Deallocation(Name => Integer_Access) (A);
+end;
+@end example
+
@node Security Hardening Features,Obsolescent Features,GNAT language extensions,Top
-@anchor{gnat_rm/security_hardening_features doc}@anchor{477}@anchor{gnat_rm/security_hardening_features id1}@anchor{478}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15}
+@anchor{gnat_rm/security_hardening_features doc}@anchor{47b}@anchor{gnat_rm/security_hardening_features id1}@anchor{47c}@anchor{gnat_rm/security_hardening_features security-hardening-features}@anchor{15}
@chapter Security Hardening Features
@end menu
@node Register Scrubbing,Stack Scrubbing,,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{479}
+@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{47d}
@section Register Scrubbing
@c Stack Scrubbing:
@node Stack Scrubbing,Hardened Conditionals,Register Scrubbing,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{47a}
+@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{47e}
@section Stack Scrubbing
@c Hardened Conditionals:
@node Hardened Conditionals,Hardened Booleans,Stack Scrubbing,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{47b}
+@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{47f}
@section Hardened Conditionals
@c Hardened Booleans:
@node Hardened Booleans,Control Flow Redundancy,Hardened Conditionals,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{47c}
+@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{480}
@section Hardened Booleans
@c Control Flow Redundancy:
@node Control Flow Redundancy,,Hardened Booleans,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{47d}
+@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{481}
@section Control Flow Redundancy
can be used with other programming languages supported by GCC.
@node Obsolescent Features,Compatibility and Porting Guide,Security Hardening Features,Top
-@anchor{gnat_rm/obsolescent_features doc}@anchor{47e}@anchor{gnat_rm/obsolescent_features id1}@anchor{47f}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16}
+@anchor{gnat_rm/obsolescent_features doc}@anchor{482}@anchor{gnat_rm/obsolescent_features id1}@anchor{483}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16}
@chapter Obsolescent Features
@end menu
@node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id2}@anchor{480}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{481}
+@anchor{gnat_rm/obsolescent_features id2}@anchor{484}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{485}
@section pragma No_Run_Time
includes just those features that are to be made accessible.
@node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id3}@anchor{482}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{483}
+@anchor{gnat_rm/obsolescent_features id3}@anchor{486}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{487}
@section pragma Ravenscar
is part of the new Ada 2005 standard.
@node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id4}@anchor{484}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{485}
+@anchor{gnat_rm/obsolescent_features id4}@anchor{488}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{489}
@section pragma Restricted_Run_Time
this kind of implementation dependent addition.
@node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id5}@anchor{486}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{487}
+@anchor{gnat_rm/obsolescent_features id5}@anchor{48a}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{48b}
@section pragma Task_Info
library.
@node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{488}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{489}
+@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{48c}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{48d}
@section package System.Task_Info (@code{s-tasinf.ads})
standard replacement for GNAT’s @code{Task_Info} functionality.
@node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top
-@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{48a}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{48b}
+@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{48e}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{48f}
@chapter Compatibility and Porting Guide
@end menu
@node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{48c}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{48d}
+@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{490}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{491}
@section Writing Portable Fixed-Point Declarations
types will be portable.
@node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{48e}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{48f}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{492}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{493}
@section Compatibility with Ada 83
@end menu
@node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{490}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{491}
+@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{494}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{495}
@subsection Legal Ada 83 programs that are illegal in Ada 95
@end itemize
@node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{492}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{493}
+@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{496}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{497}
@subsection More deterministic semantics
@end itemize
@node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{494}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{495}
+@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{498}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{499}
@subsection Changed semantics
@end itemize
@node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{496}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{497}
+@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{49a}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{49b}
@subsection Other language compatibility issues
@end itemize
@node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{498}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{499}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{49c}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{49d}
@section Compatibility between Ada 95 and Ada 2005
@end itemize
@node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{49a}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{49b}
+@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{49e}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{49f}
@section Implementation-dependent characteristics
@end menu
@node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{49c}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{49d}
+@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{4a0}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{4a1}
@subsection Implementation-defined pragmas
relevant in a GNAT context and hence are not otherwise implemented.
@node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{49e}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{49f}
+@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{4a2}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{4a3}
@subsection Implementation-defined attributes
@code{Type_Class}.
@node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{4a0}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{4a1}
+@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{4a4}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{4a5}
@subsection Libraries
@end itemize
@node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{4a2}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{4a3}
+@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{4a6}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{4a7}
@subsection Elaboration order
@end itemize
@node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{4a4}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{4a5}
+@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{4a8}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{4a9}
@subsection Target-specific aspects
Ada 2005, Ada 2012, and Ada 2022) are sometimes
incompatible with typical Ada 83 compiler practices regarding implicit
packing, the meaning of the Size attribute, and the size of access values.
-GNAT’s approach to these issues is described in @ref{4a6,,Representation Clauses}.
+GNAT’s approach to these issues is described in @ref{4aa,,Representation Clauses}.
@node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{4a7}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{4a8}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{4ab}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{4ac}
@section Compatibility with Other Ada Systems
@end itemize
@node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{4a9}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{4a6}
+@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{4ad}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{4aa}
@section Representation Clauses
@end itemize
@node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{4aa}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{4ab}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{4ae}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{4af}
@section Compatibility with HP Ada 83
@end itemize
@node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top
-@anchor{share/gnu_free_documentation_license doc}@anchor{4ac}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{4ad}
+@anchor{share/gnu_free_documentation_license doc}@anchor{4b0}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{4b1}
@chapter GNU Free Documentation License
@copying
@quotation
-GNAT User's Guide for Native Platforms , Sep 12, 2025
+GNAT User's Guide for Native Platforms , Sep 19, 2025
AdaCore
@printindex ge
-@anchor{d2}@w{ }
@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ }
+@anchor{d2}@w{ }
@c %**end of body
@bye
-- then the compilation of the child unit itself is the
-- place where such an "error" should be caught.
- Set_Name (With_Node, P_Qualified_Simple_Name);
+ Set_Name (With_Node, P_Library_Unit_Name);
if Name (With_Node) = Error then
Remove (With_Node);
end if;
Scan; -- past SEPARATE;
U_Left_Paren;
- Set_Name (Subunit_Node, P_Qualified_Simple_Name);
+ Set_Name (Subunit_Node, P_Parent_Unit_Name);
U_Right_Paren;
Ignore (Tok_Semicolon);
Check_Misspelling_Of (Tok_Renames);
if Token = Tok_Renames then
+ Scan; -- past RENAMES
+
if Ren_Token = Tok_Package then
Decl_Node := New_Node
(N_Generic_Package_Renaming_Declaration, Gen_Sloc);
(N_Generic_Function_Renaming_Declaration, Gen_Sloc);
end if;
- Scan; -- past RENAMES
Set_Defining_Unit_Name (Decl_Node, Def_Unit);
- Set_Name (Decl_Node, P_Name);
-
+ Set_Name (Decl_Node, P_Generic_Unit_Name);
P_Aspect_Specifications (Decl_Node, Semicolon => False);
TF_Semicolon;
return Decl_Node;
Set_Interface_List (Def_Node, New_List);
loop
- Append (P_Qualified_Simple_Name, Interface_List (Def_Node));
+ Append (P_Subtype_Name, Interface_List (Def_Node));
exit when Token /= Tok_And;
Scan; -- past AND
end loop;
Set_Defining_Identifier (Def_Node, P_Defining_Identifier (C_Is));
T_Is;
T_New;
- Set_Name (Def_Node, P_Qualified_Simple_Name);
+ Set_Name (Def_Node, P_Generic_Unit_Name);
if Token = Tok_Left_Paren then
Save_Scan_State (Scan_State); -- at the left paren
return Error;
else
- Type_Node := P_Qualified_Simple_Name_Resync;
+ Type_Node := P_Subtype_Name_Resync;
-- Check for a subtype mark attribute. The only valid possibilities
-- are 'CLASS and 'BASE. Anything else is a definite error. We may
No_List;
Decl_Node :=
New_Node (N_Exception_Renaming_Declaration, Ident_Sloc);
- Set_Name (Decl_Node, P_Qualified_Simple_Name_Resync);
+ Set_Name (Decl_Node, P_Exception_Name);
No_Constraint;
else
Decl_Node := New_Node (N_Exception_Declaration, Prev_Token_Ptr);
Set_Interface_List (Typedef_Node, New_List);
loop
- Append (P_Qualified_Simple_Name, Interface_List (Typedef_Node));
+ Append (P_Subtype_Name, Interface_List (Typedef_Node));
exit when Token /= Tok_And;
Scan; -- past AND
end loop;
Set_Abstract_Present (Typedef_Node);
Set_Interface_Present (Typedef_Node);
- Set_Subtype_Indication (Typedef_Node, P_Qualified_Simple_Name);
+ Set_Subtype_Indication (Typedef_Node, P_Subtype_Name);
Set_Record_Extension_Part (Typedef_Node,
New_Node (N_Record_Definition, Token_Ptr));
Scan; -- past AND
loop
- Append (P_Qualified_Simple_Name,
- Interface_List (Typedef_Node));
+ Append (P_Subtype_Name, Interface_List (Typedef_Node));
exit when Token /= Tok_And;
Scan; -- past AND
end loop;
function P_Relation return Node_Id;
function P_Term return Node_Id;
function P_Declare_Expression return Node_Id;
- function P_Reduction_Attribute_Reference (S : Node_Id)
- return Node_Id;
function P_Binary_Adding_Operator return Node_Kind;
function P_Logical_Operator return Node_Kind;
function P_Relational_Operator return Node_Kind;
function P_Unary_Adding_Operator return Node_Kind;
+ function P_Simple_Name (Instance_OK : Boolean) return Node_Id;
+ function P_Simple_Name_Resync (Instance_OK : Boolean) return Node_Id;
+
procedure Bad_Range_Attribute (Loc : Source_Ptr);
-- Called to place complaint about bad range attribute at the given
-- source location. Terminates by raising Error_Resync.
-- prefix. The current token is known to be an apostrophe and the
-- following token is known to be RANGE.
+ function P_Reduction_Attribute_Reference (Pref : Node_Id) return Node_Id;
+ -- Scan a reduction attribute reference. The caller has scanned out the
+ -- prefix. The current token is known to be an identifier.
+
function P_Case_Expression return Node_Id;
-- Scans out a case expression. Called with Token pointing to the CASE
-- keyword, and returns pointing to the terminating right parent,
-- NAME ::=
-- DIRECT_NAME | EXPLICIT_DEREFERENCE
-- | INDEXED_COMPONENT | SLICE
- -- | SELECTED_COMPONENT | ATTRIBUTE
+ -- | SELECTED_COMPONENT | ATTRIBUTE_REFERENCE
-- | TYPE_CONVERSION | FUNCTION_CALL
-- | CHARACTER_LITERAL | TARGET_NAME
+ -- | STRUCTURAL_GENERIC_INSTANCE_NAME
-- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
-- TARGET_NAME ::= @ (AI12-0125-3: abbreviation for LHS)
+ -- STRUCTURAL_GENERIC_INSTANCE_NAME ::= NAME GENERIC_ACTUAL_PART
+
-- Note: syntactically a procedure call looks just like a function call,
-- so this routine is in practice used to scan out procedure calls as well.
-- If there is at least one occurrence of identifier => (but
-- none of the other cases apply), then we have a call.
+ -- This case is handled by LP_State_Call.
-- Test for Id => case
-- have seen at least one named parameter already.
Error_Msg_SC
- ("positional parameter association " &
- "not allowed after named one");
+ ("positional parameter association not allowed after named one");
Error_Loc := Token_Ptr;
end P_Name;
+ -- These functions parse a restricted form of Names which are either
+ -- designators or structural generic instance names, and are preceded,
+ -- or not, by a sequence of prefixes that are either direct names or
+ -- structural generic instance names.
+
+ -- Error recovery: can raise Error_Resync
+
+ function P_Exception_Name return Node_Id is
+ begin
+ return P_Simple_Name_Resync (Instance_OK => False);
+ end P_Exception_Name;
+
+ function P_Label_Name return Node_Id is
+ begin
+ return P_Simple_Name_Resync (Instance_OK => False);
+ end P_Label_Name;
+
+ function P_Loop_Name return Node_Id is
+ begin
+ return P_Simple_Name_Resync (Instance_OK => False);
+ end P_Loop_Name;
+
+ function P_Subtype_Name_Resync return Node_Id is
+ begin
+ return P_Simple_Name_Resync (Instance_OK => False);
+ end P_Subtype_Name_Resync;
+
+ -- Error recovery: cannot raise Error_Resync
+
+ function P_Generic_Unit_Name return Node_Id is
+ begin
+ return P_Simple_Name (Instance_OK => False);
+ end P_Generic_Unit_Name;
+
+ function P_Library_Unit_Name return Node_Id is
+ begin
+ return P_Simple_Name (Instance_OK => False);
+ end P_Library_Unit_Name;
+
+ function P_Package_Name return Node_Id is
+ begin
+ return P_Simple_Name (Instance_OK => True);
+ end P_Package_Name;
+
+ function P_Parent_Unit_Name return Node_Id is
+ begin
+ return P_Simple_Name (Instance_OK => False);
+ end P_Parent_Unit_Name;
+
+ function P_Subtype_Name return Node_Id is
+ begin
+ return P_Simple_Name (Instance_OK => False);
+ end P_Subtype_Name;
+
-- This function parses a restricted form of Names which are either
- -- designators, or designators preceded by a sequence of prefixes
- -- that are direct names.
+ -- designators or structural generic instance names, and are preceded,
+ -- or not, by a sequence of prefixes that are either direct names or
+ -- structural generic instance names.
+
+ -- If Instance_OK is False, the simple name cannot be a structural
+ -- generic instance name, preceded or not by prefixes (Instance_OK
+ -- has no effects on the accepted prefixes, if any).
-- Error recovery: cannot raise Error_Resync
- function P_Qualified_Simple_Name return Node_Id is
+ function P_Simple_Name (Instance_OK : Boolean) return Node_Id is
begin
- return P_Qualified_Simple_Name_Resync;
+ return P_Simple_Name_Resync (Instance_OK);
exception
when Error_Resync =>
return Error;
- end P_Qualified_Simple_Name;
+ end P_Simple_Name;
- -- This procedure differs from P_Qualified_Simple_Name only in that it
- -- raises Error_Resync if any error is encountered. It only returns after
- -- scanning a valid qualified simple name.
+ -- This procedure differs from P_Simple_Name only in that it raises
+ -- Error_Resync if any error is encountered. It only returns after
+ -- scanning a valid simple name.
-- Error recovery: can raise Error_Resync
- function P_Qualified_Simple_Name_Resync return Node_Id is
- Designator_Node : Node_Id;
- Prefix_Node : Node_Id;
- Selector_Node : Node_Id;
- Dot_Sloc : Source_Ptr := No_Location;
+ function P_Simple_Name_Resync (Instance_OK : Boolean) return Node_Id is
+ Arg_Node : Node_Id;
+ Ident_Node : Node_Id;
+ Name_Node : Node_Id;
+ Prefix_Node : Node_Id;
+ Scan_State_Id : Saved_Scan_State;
+ Scan_State_LP : Saved_Scan_State;
+
+ Arg_List : List_Id := No_List; -- kill junk warning
begin
- -- Prefix_Node is set to the gathered prefix so far, Empty means that
- -- no prefix has been scanned. This allows us to build up the result
- -- in the required right recursive manner.
+ -- Case of not a designator
- Prefix_Node := Empty;
+ if Token not in Token_Class_Desig then
+ Discard_Junk_Node (P_Identifier); -- to issue the error message
+ raise Error_Resync;
+ end if;
- -- Loop through prefixes
+ Name_Node := Token_Node;
- loop
- Designator_Node := Token_Node;
+ Scan; -- past designator
- if Token not in Token_Class_Desig then
- Discard_Junk_Node (P_Identifier); -- to issue the error message
- raise Error_Resync;
+ -- Loop scanning past name extensions. A label is used for control
+ -- transfer for this loop for ease of interfacing with the finite state
+ -- machine in the parenthesis scanning circuit, and also to allow for
+ -- passing in control to the appropriate point from the above code.
- else
- Scan; -- past designator
- exit when Token /= Tok_Dot;
- end if;
+ <<Scan_Name_Extension>>
+
+ case Token is
+ when Tok_Left_Paren =>
+ Save_Scan_State (Scan_State_LP); -- at left paren
+ Scan; -- past left paren
+ Arg_List := New_List;
+ goto Scan_Name_Extension_Left_Paren;
+
+ when Tok_Dot =>
+ Scan; -- past dot
+ goto Scan_Name_Extension_Dot;
+
+ when others =>
+ return Name_Node;
+ end case;
+
+ -- Case of name extended by dot (selection), dot is already skipped
+ -- and the scan state at the point of the dot is saved in Scan_State.
+
+ <<Scan_Name_Extension_Dot>>
+
+ if Token in Token_Class_Desig then
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
+ Set_Prefix (Name_Node, Prefix_Node);
+ Set_Selector_Name (Name_Node, Token_Node);
+ Scan; -- past selector
+ goto Scan_Name_Extension;
- -- Here at a dot, with token just before it in Designator_Node
+ -- Here if nothing legal after the dot
+
+ else
+ Discard_Junk_Node (P_Identifier); -- to issue the error message
+ raise Error_Resync;
+ end if;
+
+ -- Here for left parenthesis extending name (left paren skipped)
+
+ <<Scan_Name_Extension_Left_Paren>>
+
+ -- We now have to scan through a list of items, terminated by a
+ -- right parenthesis. The scan is handled by a finite state
+ -- machine. The possibilities are:
+
+ -- (expression, expression, ..)
+
+ -- This is interpreted as an indexed component, i.e. as a
+ -- case of a name which can be extended in the normal manner.
+ -- This case is handled by LP_State_Expr.
+
+ -- Note: if and case expressions (without an extra level of
+ -- parentheses) are permitted in this context).
+
+ -- (..., identifier => expression , ...)
+
+ -- If there is at least one occurrence of identifier => (but
+ -- none of the other cases apply), then we have a call.
+ -- This case is handled by LP_State_Call.
+
+ -- Test for Id => case
+
+ if Token in Tok_Identifier | Tok_Operator_Symbol | Tok_Others then
+ Save_Scan_State (Scan_State_Id); -- at Id
+ Scan; -- past Id
+
+ -- Test for => (allow := as an error substitute)
+
+ if Token in Tok_Arrow | Tok_Colon_Equal then
+ Restore_Scan_State (Scan_State_Id); -- to Id
+ goto LP_State_Call;
- if No (Prefix_Node) then
- Prefix_Node := Designator_Node;
else
- Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
- Set_Prefix (Selector_Node, Prefix_Node);
- Set_Selector_Name (Selector_Node, Designator_Node);
- Prefix_Node := Selector_Node;
+ Restore_Scan_State (Scan_State_Id); -- to Id
end if;
+ end if;
- Dot_Sloc := Token_Ptr;
- Scan; -- past dot
- end loop;
+ -- Here we have an expression after all
- -- Fall out of the loop having just scanned an identifier
+ <<LP_State_Expr>>
+
+ if Token in Tok_Box | Tok_Right_Paren then
+ goto LP_State_Rewind;
+ end if;
+
+ Append (P_Expression_Or_Range_Attribute_If_OK, Arg_List);
+
+ if Token = Tok_Comma then
+ Scan; -- past comma
+ goto Scan_Name_Extension_Left_Paren;
+
+ elsif Token = Tok_Right_Paren then
+ Scan; -- past right paren
+
+ if not Instance_OK and then Token /= Tok_Dot then
+ goto LP_State_Rewind;
+ end if;
+
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
+ Set_Prefix (Name_Node, Prefix_Node);
+ Set_Expressions (Name_Node, Arg_List);
+ goto Scan_Name_Extension;
- if No (Prefix_Node) then
- return Designator_Node;
else
- Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
- Set_Prefix (Selector_Node, Prefix_Node);
- Set_Selector_Name (Selector_Node, Designator_Node);
- return Selector_Node;
+ goto LP_State_Rewind;
end if;
- end P_Qualified_Simple_Name_Resync;
+
+ -- LP_State_Call corresponds to the situation in which at least one
+ -- instance of Id => Expression has been encountered, so we know that
+ -- we do not have a name, but rather a call. We enter it with the
+ -- scan pointer pointing to the next argument to scan, and Arg_List
+ -- containing the list of arguments scanned so far.
+
+ <<LP_State_Call>>
+
+ -- Test for case of Id => Expression (named parameter)
+
+ if Token in Tok_Identifier | Tok_Operator_Symbol | Tok_Others then
+ Save_Scan_State (Scan_State_Id); -- at Id
+ Ident_Node := Token_Node;
+ Scan; -- past Id
+
+ -- Deal with => (allow := as incorrect substitute)
+
+ if Token in Tok_Arrow | Tok_Colon_Equal then
+ Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
+ T_Arrow;
+ if Token in Tok_Box then
+ goto LP_State_Rewind;
+ end if;
+ Set_Selector_Name (Arg_Node, Ident_Node);
+ Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
+ Append (Arg_Node, Arg_List);
+
+ -- If a comma follows, go back and scan next entry
+
+ if Comma_Present then
+ goto LP_State_Call;
+
+ -- Otherwise we have the end of a call
+
+ else
+ T_Right_Paren; -- past right paren
+
+ if not Instance_OK and then Token /= Tok_Dot then
+ goto LP_State_Rewind;
+ end if;
+
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
+ Set_Name (Name_Node, Prefix_Node);
+ Set_Parameter_Associations (Name_Node, Arg_List);
+ goto Scan_Name_Extension;
+ end if;
+
+ -- Filter out tokens that may appear in constraints
+
+ elsif Token in Tok_Vertical_Bar then
+ goto LP_State_Rewind;
+
+ -- Not named parameter: Id started an expression after all
+
+ else
+ Restore_Scan_State (Scan_State_Id); -- to Id
+ end if;
+ end if;
+
+ -- Here if entry did not start with Id => which means that it
+ -- is a positional parameter, which is not allowed, since we
+ -- have seen at least one named parameter already.
+
+ goto LP_State_Expr;
+
+ <<LP_State_Rewind>>
+ Restore_Scan_State (Scan_State_LP);
+ return Name_Node;
+ end P_Simple_Name_Resync;
----------------------
-- 4.1 Direct_Name --
-- P_Reduction_Attribute_Reference --
-------------------------------------
- function P_Reduction_Attribute_Reference (S : Node_Id)
+ function P_Reduction_Attribute_Reference (Pref : Node_Id)
return Node_Id
is
Attr_Node : Node_Id;
Error_Msg ("Reduce attribute expected", Prev_Token_Ptr);
end if;
- Set_Prefix (Attr_Node, S);
+ Set_Prefix (Attr_Node, Pref);
Set_Expressions (Attr_Node, New_List);
T_Left_Paren;
Append (P_Name, Expressions (Attr_Node));
and then Token = Tok_Identifier
then
Save_Scan_State (Scan_State);
- Type_Node := P_Qualified_Simple_Name_Resync;
+ Type_Node := P_Subtype_Name_Resync;
if Token = Tok_Apostrophe then
Scan;
if Token_Name = Name_Make then
begin
Goto_Node := New_Node (N_Goto_Statement, Token_Ptr);
Scan; -- past GOTO (or TO)
- Set_Name (Goto_Node, P_Qualified_Simple_Name_Resync);
+ Set_Name (Goto_Node, P_Label_Name);
Append_Elmt (Goto_Node, Goto_List);
if Token = Tok_When then
Scan; -- past EXIT or CONTINUE
if Token = Tok_Identifier then
- Set_Name (N, P_Qualified_Simple_Name);
+ Set_Name (N, P_Loop_Name);
elsif Style_Check and then Nkind (N) = N_Exit_Statement then
-- This statement has no name, so check that
-- the innermost loop is unnamed too.
Inst_Node := New_Node (N_Procedure_Instantiation, Fproc_Sloc);
end if;
- Set_Name (Inst_Node, P_Qualified_Simple_Name);
Set_Defining_Unit_Name (Inst_Node, Name_Node);
+ Set_Name (Inst_Node, P_Generic_Unit_Name);
Set_Generic_Associations (Inst_Node, P_Generic_Actual_Part_Opt);
P_Aspect_Specifications (Inst_Node, Semicolon => True);
Pop_Scope_Stack; -- Don't need scope stack entry in this case
Package_Node :=
New_Node (N_Package_Renaming_Declaration, Package_Sloc);
Set_Defining_Unit_Name (Package_Node, Name_Node);
- Set_Name (Package_Node, P_Qualified_Simple_Name);
+ Set_Name (Package_Node, P_Package_Name);
No_Constraint;
P_Aspect_Specifications (Package_Node, Semicolon => False);
Package_Node :=
New_Node (N_Package_Instantiation, Package_Sloc);
Set_Defining_Unit_Name (Package_Node, Name_Node);
- Set_Name (Package_Node, P_Qualified_Simple_Name);
+ Set_Name (Package_Node, P_Generic_Unit_Name);
Set_Generic_Associations
(Package_Node, P_Generic_Actual_Part_Opt);
loop
Use_Node := New_Node (N_Use_Package_Clause, Use_Sloc);
- Set_Name (Use_Node, P_Qualified_Simple_Name);
+ Set_Name (Use_Node, P_Package_Name);
-- Locally chain each name's use-package node
Set_Interface_List (Task_Node, New_List);
loop
- Append (P_Qualified_Simple_Name, Interface_List (Task_Node));
+ Append (P_Subtype_Name, Interface_List (Task_Node));
exit when Token /= Tok_And;
Scan; -- past AND
end loop;
Set_Interface_List (Protected_Node, New_List);
loop
- Append (P_Qualified_Simple_Name,
- Interface_List (Protected_Node));
+ Append (P_Subtype_Name, Interface_List (Protected_Node));
exit when Token /= Tok_And;
Scan; -- past AND
function P_Expression return Node_Id;
function P_Expression_Or_Range_Attribute return Node_Id;
function P_Name return Node_Id;
- function P_Qualified_Simple_Name return Node_Id;
- function P_Qualified_Simple_Name_Resync return Node_Id;
+ function P_Exception_Name return Node_Id;
+ function P_Label_Name return Node_Id;
+ function P_Loop_Name return Node_Id;
+ function P_Generic_Unit_Name return Node_Id;
+ function P_Library_Unit_Name return Node_Id;
+ function P_Package_Name return Node_Id;
+ function P_Parent_Unit_Name return Node_Id;
+ function P_Subtype_Name return Node_Id;
+ function P_Subtype_Name_Resync return Node_Id;
function P_Simple_Expression return Node_Id;
function P_Simple_Expression_Or_Range_Attribute return Node_Id;
elsif Unit_Kind = N_Package_Instantiation
and then Nkind (U) = N_Package_Instantiation
- and then Present (Instance_Spec (U))
then
-- If the instance has not been rewritten as a package declaration,
-- then it appeared already in a previous with clause. Retrieve
-- the entity from the previous instance.
- E_Name := Defining_Entity (Specification (Instance_Spec (U)));
+ E_Name := Defining_Entity_Of_Instance (U);
elsif Unit_Kind in N_Subprogram_Instantiation then
-- been rewritten as the declaration of the wrapper itself.
if Nkind (U) in N_Subprogram_Instantiation then
- E_Name :=
- Related_Instance
- (Defining_Entity (Specification (Instance_Spec (U))));
+ E_Name := Defining_Entity_Of_Instance (U);
else
E_Name := Related_Instance (Defining_Entity (U));
end if;
with Elists; use Elists;
with Errout; use Errout;
with Expander; use Expander;
+with Exp_Dbug; use Exp_Dbug;
with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Freeze; use Freeze;
-- onto Default_Actuals, and actuals that require freezing are
-- appended onto Actuals_To_Freeze.
+ procedure Analyze_Structural_Associations
+ (N : Node_Id;
+ Match : Associations.Match_Rec);
+ -- Analyze associations for structural instantiation N
+
procedure Check_Fixed_Point_Warning
(Match : Associations.Match_Rec;
Renamings : List_Id);
Match : constant Match_Rec := Match_Assocs (N, Formals, F_Copy);
begin
+ if Nkind (N) in N_Generic_Instantiation and then Is_Structural (N) then
+ Analyze_Structural_Associations (N, Match);
+
+ -- Bail out if the instantiation has been turned into something else
+
+ if Nkind (N) not in N_Generic_Instantiation then
+ return Result_Renamings;
+ end if;
+ end if;
+
for Index in Match.Assocs'Range loop
declare
Assoc : Assoc_Rec renames Match.Assocs (Index);
function Needs_Body_Instantiated (Gen_Unit : Entity_Id) return Boolean is
begin
+ -- If the instantiation is in the auxiliary declarations of the main
+ -- unit, then the body is needed, even if the main unit is generic.
+
+ if Parent (N) = Aux_Decls_Node (Cunit (Main_Unit)) then
+ return True;
+ end if;
+
-- No need to instantiate bodies in generic units
if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
Formals => Generic_Formal_Declarations (Act_Tree),
F_Copy => Generic_Formal_Declarations (Gen_Decl));
+ -- Bail out if the instantiation has been turned into something else
+
+ if Nkind (N) /= N_Package_Instantiation then
+ if Parent_Installed then
+ Remove_Parent;
+ end if;
+
+ Restore_Env;
+ goto Leave;
+ end if;
+
Vis_Prims_List := Check_Hidden_Primitives (Renamings);
-- Set minimal decoration on the original entity
Mutate_Ekind (Defining_Entity (N), E_Package);
Set_Scope (Defining_Entity (N), Current_Scope);
+ -- From now on only Act_Decl_Id matters. If was copied from the
+ -- original entity earlier but, if the instance is structural,
+ -- the latter has been changed, so adjust it accordingly.
+
+ if Chars (Defining_Entity (N)) /= Chars (Act_Decl_Id) then
+ pragma Assert (Is_Structural (N));
+ Set_Incomplete_Actuals
+ (Defining_Entity (N), Incomplete_Actuals (Act_Decl_Id));
+ Act_Decl_Id := New_Copy (Defining_Entity (N));
+ Set_Is_Not_Self_Hidden (Act_Decl_Id);
+ end if;
+
Set_Instance_Env (Gen_Unit, Act_Decl_Id);
Set_Is_Generic_Instance (Act_Decl_Id);
Generate_Definition (Act_Decl_Id);
Analyze_Subprogram_Instantiation (N, E_Procedure);
end Analyze_Procedure_Instantiation;
+ -------------------------------------
+ -- Analyze_Structural_Associations --
+ -------------------------------------
+
+ procedure Analyze_Structural_Associations
+ (N : Node_Id;
+ Match : Associations.Match_Rec)
+ is
+ use Associations;
+
+ Loc : constant Source_Ptr := Sloc (N);
+ -- The source location of the instantiation
+
+ type Accessibility_Depth is record
+ Global : Uint;
+ Local : Uint;
+ end record;
+ -- The accessibility depth of an entity is the depth of the outermost
+ -- scope from which the entity can be accessed at run time. It's zero
+ -- for library-level entities since they can be accessed from Standard.
+
+ -- However it can be accessed at run time only after being elaborated;
+ -- for a library-level entity, this means that it can be accessed from
+ -- Standard only after its enclosing library unit is elaborated, which
+ -- means that it can be accessed from all the other library units (that
+ -- have a dependence on this enclosing library unit) as if it was itself
+ -- declared in Standard, but not from this enclosing library unit.
+
+ -- Global contains the accessibility depth as computed from outside the
+ -- library or program unit where the entity is declared.
+
+ -- Local contains the accessibility depth as computed from the current
+ -- scope, which may be different from Global if the scope is within the
+ -- library or program unit where the entity is declared.
+
+ procedure Append_Entity_Name (B : in out Bounded_String; E : Entity_Id);
+ -- Append E's name to B
+
+ procedure Append_Expression (B : in out Bounded_String; N : Node_Id);
+ -- Append an encoding of N, a compile-time known expression, to B
+
+ function Get_Actual_Subtype (N : Node_Id) return Entity_Id;
+ -- Return the actual subtype of the formal object declared by N, which
+ -- is an N_Formal_Object_Declaration. It's the declared subtype of the
+ -- formal object if it is not a generic type, otherwise it's the actual
+ -- corresponding to this generic type in the instantiation.
+
+ function Get_Entity_Depth (E : Entity_Id) return Accessibility_Depth;
+ -- Return the accessibility depth of E
+
+ procedure Structural_Instantiation_Error (N : Node_Id);
+ -- Output an error for the specified structural instantiation
+
+ function Max (L, R : Accessibility_Depth) return Accessibility_Depth is
+ (Global => UI_Max (L.Global, R.Global),
+ Local => UI_Max (L.Local, R.Local));
+ -- Return a pair made up of the maximum value of each component
+
+ function OK_For_Structural_Instantiation (E : Entity_Id) return Boolean;
+ -- Return True if the generic unit E is OK for structural instantiation
+ -- and False if it is not, giving an error in the latter case.
+
+ procedure Rewrite_As_Renaming (N : Node_Id; E : Entity_Id);
+ -- Rewrite N as a renaming of E
+
+ ------------------------
+ -- Append_Entity_Name --
+ ------------------------
+
+ procedure Append_Entity_Name (B : in out Bounded_String; E : Entity_Id)
+ is
+ begin
+ if Operating_Mode = Generate_Code then
+ Get_External_Name (E);
+ Append (B, Global_Name_Buffer);
+ else
+ Append (B, 'E');
+ Append (B, Nat (E));
+ end if;
+ end Append_Entity_Name;
+
+ -----------------------
+ -- Append_Expression --
+ -----------------------
+
+ procedure Append_Expression (B : in out Bounded_String; N : Node_Id) is
+ Typ : constant Entity_Id := Etype (N);
+
+ begin
+ if Is_Integer_Type (Typ) then
+ Append (B, 'I');
+ Append (B, UI_Image (Expr_Value (N)));
+
+ elsif Is_Real_Type (Typ) then
+ declare
+ Val : constant Ureal := Expr_Value_R (N);
+ begin
+ Append (B, 'R');
+ Append (B, UI_Image (Norm_Num (Val)));
+ Append (B, '_');
+ Append (B, UI_Image (Norm_Den (Val)));
+ end;
+
+ elsif Is_Enumeration_Type (Typ) then
+ Append (B, 'E');
+ Append_Entity_Name (B, Expr_Value_E (N));
+
+ elsif Is_String_Type (Typ) then
+ Append (B, 'S');
+ Append (B, Strval (Expr_Value_S (N)));
+
+ else
+ raise Program_Error;
+ end if;
+ end Append_Expression;
+
+ ------------------------
+ -- Get_Actual_Subtype --
+ ------------------------
+
+ function Get_Actual_Subtype (N : Node_Id) return Entity_Id is
+ Subt : constant Entity_Id := Entity (Subtype_Mark (N));
+
+ begin
+ if not Is_Generic_Type (Subt) then
+ return Subt;
+ end if;
+
+ for Index in Match.Assocs'Range loop
+ declare
+ Assoc : Assoc_Rec renames Match.Assocs (Index);
+
+ begin
+ if Assoc.Actual.Kind = Name_Exp
+ and then Nkind (Assoc.An_Formal) = N_Formal_Type_Declaration
+ and then Defining_Identifier (Assoc.An_Formal) = Subt
+ then
+ return Entity (Assoc.Actual.Name_Exp);
+ end if;
+ end;
+ end loop;
+
+ return Empty;
+ end Get_Actual_Subtype;
+
+ ----------------------
+ -- Get_Entity_Depth --
+ ----------------------
+
+ function Get_Entity_Depth (E : Entity_Id) return Accessibility_Depth is
+ Global : constant Uint := Scope_Depth (Enclosing_Dynamic_Scope (E));
+ CS : constant Entity_Id := Current_Scope;
+
+ S : Entity_Id := Scope (E);
+
+ begin
+ -- Generic formal types are treated as local entities
+
+ if Is_Generic_Type (E) then
+ return (Global => Scope_Depth (S), Local => Scope_Depth (S));
+ end if;
+
+ -- Compute the accessibility depth from the current scope
+
+ while Scope_Depth (S) > Global
+ and then (not Scope_Within_Or_Same (CS, S)
+ or else
+ (Ekind (S) = E_Package
+ and then Is_Generic_Instance (S)
+ and then Alias (Related_Instance (S)) = CS))
+ loop
+ S := Scope (S);
+ end loop;
+
+ return (Global => Global, Local => Scope_Depth (S));
+ end Get_Entity_Depth;
+
+ ------------------------------------
+ -- Structural_Instantiation_Error --
+ ------------------------------------
+
+ procedure Structural_Instantiation_Error (N : Node_Id) is
+ begin
+ Error_Msg_N ("generic unit cannot be instantiated structurally", N);
+ end Structural_Instantiation_Error;
+
+ -------------------------------------
+ -- OK_For_Structural_Instantiation --
+ -------------------------------------
+
+ function OK_For_Structural_Instantiation (E : Entity_Id) return Boolean
+ is
+ Formals : constant List_Id :=
+ Generic_Formal_Declarations (Unit_Declaration_Node (E));
+ Unit_Entity : constant Entity_Id :=
+ Cunit_Entity (Get_Source_Unit (E));
+
+ Formal : Node_Id;
+
+ begin
+ -- Check that the generic unit is preelaborated
+
+ if Ekind (Unit_Entity) in E_Package | E_Generic_Package
+ and then not Is_Preelaborated (Unit_Entity)
+ and then not Is_Pure (Unit_Entity)
+ then
+ Structural_Instantiation_Error (N);
+ Error_Msg_NE
+ ("\generic unit& is not preelaborated", N, Unit_Entity);
+ return False;
+ end if;
+
+ -- Check that there is no generic formal object of mode In Out
+
+ Formal := First (Formals);
+ while Present (Formal) loop
+ if Nkind (Formal) = N_Formal_Object_Declaration
+ and then Out_Present (Formal)
+ then
+ Structural_Instantiation_Error (N);
+ Error_Msg_NE
+ ("\in out formal parameter& not allowed", N,
+ Defining_Identifier (Formal));
+ return False;
+ end if;
+
+ Next (Formal);
+ end loop;
+
+ return True;
+ end OK_For_Structural_Instantiation;
+
+ -------------------------
+ -- Rewrite_As_Renaming --
+ -------------------------
+
+ procedure Rewrite_As_Renaming (N : Node_Id; E : Entity_Id) is
+ begin
+ case Nkind (N) is
+ when N_Function_Instantiation =>
+ Rewrite (N,
+ Make_Subprogram_Renaming_Declaration (Loc,
+ Specification =>
+ Make_Function_Specification (Loc,
+ Defining_Unit_Name => Defining_Unit_Name (N),
+ Parameter_Specifications =>
+ New_Copy_List
+ (Parameter_Specifications
+ (Subprogram_Specification (E))),
+ Result_Definition =>
+ New_Occurrence_Of (Etype (E), Loc)),
+ Name => New_Occurrence_Of (E, Loc)));
+
+ when N_Procedure_Instantiation =>
+ Rewrite (N,
+ Make_Subprogram_Renaming_Declaration (Loc,
+ Specification =>
+ Make_Procedure_Specification (Loc,
+ Defining_Unit_Name => Defining_Unit_Name (N),
+ Parameter_Specifications =>
+ New_Copy_List
+ (Parameter_Specifications
+ (Subprogram_Specification (E)))),
+ Name => New_Occurrence_Of (E, Loc)));
+
+ when N_Package_Instantiation =>
+ Rewrite (N,
+ Make_Package_Renaming_Declaration (Loc,
+ Defining_Unit_Name => Defining_Unit_Name (N),
+ Name => New_Occurrence_Of (E, Loc)));
+
+ when others =>
+ raise Program_Error;
+ end case;
+ end Rewrite_As_Renaming;
+
+ -- Local variables
+
+ Buf : Bounded_String;
+ Depth : Accessibility_Depth;
+ Ent : Entity_Id;
+ Nam : Name_Id;
+ R : Node_Id;
+ Scop : Entity_Id;
+
+ -- Start of processing for Analyze_Structural_Associations
+
+ begin
+ if not OK_For_Structural_Instantiation (Match.Gen_Unit) then
+ return;
+ end if;
+
+ -- Compute the name and the scope depth of the structural instance
+
+ Append_Entity_Name (Buf, Match.Gen_Unit);
+ Append (Buf, "SI");
+ Depth := Get_Entity_Depth (Match.Gen_Unit);
+
+ for Index in Match.Assocs'Range loop
+ declare
+ Assoc : Assoc_Rec renames Match.Assocs (Index);
+
+ begin
+ Append (Buf, '_');
+
+ case Assoc.Actual.Kind is
+ when Name_Exp
+ | Exp_Func_Default
+ =>
+ if Nkind (Assoc.An_Formal) = N_Formal_Object_Declaration then
+ -- Resolve the expression to compute whether it is static
+
+ Resolve
+ (Assoc.Actual.Name_Exp,
+ Get_Actual_Subtype (Assoc.An_Formal));
+
+ if Is_OK_Static_Expression (Assoc.Actual.Name_Exp) then
+ -- We need the value of the expression to encode it
+
+ pragma Assert
+ (Compile_Time_Known_Value (Assoc.Actual.Name_Exp));
+
+ Append_Expression (Buf, Assoc.Actual.Name_Exp);
+
+ else
+ Structural_Instantiation_Error (N);
+ Error_Msg_N
+ ("\expression is not static", Assoc.Actual.Name_Exp);
+ end if;
+
+ elsif Nkind (Assoc.Actual.Name_Exp) = N_Operator_Symbol then
+ Append (Buf, Chars (Assoc.Actual.Name_Exp));
+
+ else pragma Assert (Is_Entity_Name (Assoc.Actual.Name_Exp));
+ Ent := Entity (Assoc.Actual.Name_Exp);
+
+ -- If this is a type that is a renaming of another one,
+ -- as is the case for actuals in instances, retain the
+ -- latter. Beware of Natural and Positive, see Cstand.
+
+ if Is_Type (Ent)
+ and then Nkind (Parent (Ent)) = N_Subtype_Declaration
+ and then
+ Is_Entity_Name (Subtype_Indication (Parent (Ent)))
+ and then not Comes_From_Source (Parent (Ent))
+ and then Scope (Ent) /= Standard_Standard
+ then
+ Ent := Entity (Subtype_Indication (Parent (Ent)));
+ end if;
+
+ -- ??? Need to implement handling of explicit renaming
+
+ Append_Entity_Name (Buf, Ent);
+ Depth := Max (Depth, Get_Entity_Depth (Ent));
+ end if;
+
+ when Box_Subp_Default =>
+ Append (Buf, 'F');
+
+ when Null_Default =>
+ Append (Buf, 'N');
+
+ when others =>
+ Structural_Instantiation_Error (N);
+ end case;
+ end;
+ end loop;
+
+ Nam := Name_Find (Buf);
+ Ent := Get_Name_Entity_Id (Nam);
+
+ -- If the structural instance has already been created, then rewrite
+ -- this occurrence as a renaming of it.
+
+ if Present (Ent) then
+ Rewrite_As_Renaming (N, Ent);
+ Analyze (N);
+
+ -- Otherwise, create it in the outermost possible scope
+
+ else
+ -- Depth.Global is the accessibility depth of the structural instance
+ -- which is defined to be the depth of the outermost scope where the
+ -- instantiation is possible. If the depth cannot be reached from the
+ -- current scope, then the structural instance cannot be accessed out
+ -- of it and we would need to create a local instance instead.
+
+ if Depth.Local > Depth.Global then
+ Structural_Instantiation_Error (N);
+ Error_Msg_N ("\local entity used in the instantiation", N);
+ return;
+ end if;
+
+ Scop := Current_Scope;
+
+ -- If the current scope is too nested, analyze the instantiation
+ -- relocated in the outermost possible scope, which will invoke
+ -- us recursively with a matching scope depth this time.
+
+ if Scope_Depth (Scop) > Depth.Global then
+ while Scope_Depth (Scop) > Depth.Global loop
+ Scop := Scope (Scop);
+ end loop;
+
+ R := Relocate_Node (N);
+
+ -- If the scope is Standard, the instantiation is done outside the
+ -- current compilation unit and, therefore, needs a clean context.
+
+ if Scop = Standard_Standard then
+ declare
+ S_Expander_Active : constant Boolean := Expander_Active;
+ S_Full_Analysis : constant Boolean := Full_Analysis;
+ S_In_Spec_Expr : constant Boolean := In_Spec_Expression;
+ S_Inside_A_Generic : constant Boolean := Inside_A_Generic;
+
+ begin
+ Expander_Active := (Operating_Mode = Opt.Generate_Code);
+ Full_Analysis := True;
+ In_Spec_Expression := False;
+ Inside_A_Generic := False;
+
+ Add_Local_Declaration (R, N, Scop => Scop);
+
+ Expander_Active := S_Expander_Active;
+ Full_Analysis := S_Full_Analysis;
+ In_Spec_Expression := S_In_Spec_Expr;
+ Inside_A_Generic := S_Inside_A_Generic;
+ end;
+
+ else
+ Add_Local_Declaration (R, N, Scop => Scop);
+ end if;
+
+ Ent := Defining_Entity_Of_Instance (R);
+ Rewrite_As_Renaming (N, Ent);
+ Analyze (N);
+
+ -- Otherwise we are in the right scope and only need to set the
+ -- name of the instance.
+
+ else
+ Ent := Make_Defining_Identifier (Loc, Chars => Nam);
+ Set_Defining_Unit_Name (N, Ent);
+ end if;
+ end if;
+ end Analyze_Structural_Associations;
+
-----------------------------------
-- Need_Subprogram_Instance_Body --
-----------------------------------
if (Is_In_Main_Unit (N) or else Is_Inlined_Or_Child_Of_Inlined (Subp))
- -- No need to instantiate bodies in generic units
+ -- No need to instantiate bodies in generic units, except when the
+ -- instantiation is in the auxiliary declarations of the main unit;
+ -- in this case the body is needed, even if the main unit is generic.
- and then not Is_Generic_Unit (Cunit_Entity (Main_Unit))
+ and then (not Is_Generic_Unit (Cunit_Entity (Main_Unit))
+ or else Parent (N) = Aux_Decls_Node (Cunit (Main_Unit)))
-- Must be generating code or analyzing code in GNATprove mode
Formals => Generic_Formal_Declarations (Act_Tree),
F_Copy => Generic_Formal_Declarations (Gen_Decl));
+ -- Bail out if the instantiation has been turned into something else
+
+ if Nkind (N) not in N_Subprogram_Instantiation then
+ if Parent_Installed then
+ Remove_Parent;
+ end if;
+
+ Restore_Env;
+ goto Leave;
+ end if;
+
Vis_Prims_List := Check_Hidden_Primitives (Renamings);
-- The subprogram itself cannot contain a nested instance, so the
end if;
end Get_Associated_Node;
+ ------------------------------------
+ -- Build_Structural_Instantiation --
+ ------------------------------------
+
+ function Build_Structural_Instantiation
+ (N : Node_Id;
+ Gen_Unit : Entity_Id;
+ Actuals : List_Id) return Entity_Id
+ is
+ Loc : constant Source_Ptr := Sloc (N);
+ Inst_Id : constant Entity_Id := Make_Temporary (Loc, 'P');
+
+ Inst : Node_Id;
+
+ begin
+ case Ekind (Gen_Unit) is
+ when E_Generic_Function =>
+ Inst :=
+ Make_Function_Instantiation (Loc,
+ Defining_Unit_Name => Inst_Id,
+ Name => New_Occurrence_Of (Gen_Unit, Loc),
+ Generic_Associations => Actuals);
+
+ when E_Generic_Package =>
+ Inst :=
+ Make_Package_Instantiation (Loc,
+ Defining_Unit_Name => Inst_Id,
+ Name => New_Occurrence_Of (Gen_Unit, Loc),
+ Generic_Associations => Actuals);
+
+ when E_Generic_Procedure =>
+ Inst :=
+ Make_Procedure_Instantiation (Loc,
+ Defining_Unit_Name => Inst_Id,
+ Name => New_Occurrence_Of (Gen_Unit, Loc),
+ Generic_Associations => Actuals);
+
+ when others =>
+ raise Program_Error;
+ end case;
+
+ Set_Is_Internal (Inst_Id);
+ Set_Is_Structural (Inst);
+
+ -- The instantiation must be added to a declarative part for technical
+ -- reasons pertaining to freezing (see the Freeze_Package_Instance and
+ -- Freeze_Subprogram_Instance procedures).
+
+ Add_Local_Declaration (Inst, N, Scop => Empty);
+ if Error_Posted (Inst) then
+ return Empty;
+ end if;
+
+ -- If the structural instance had already been created, this occurrence
+ -- has been turned into a renaming of it.
+
+ if Nkind (Inst) in N_Renaming_Declaration then
+ return Defining_Entity (Inst);
+ else
+ return Defining_Entity_Of_Instance (Inst);
+ end if;
+ end Build_Structural_Instantiation;
+
-----------------------------------
-- Build_Subprogram_Decl_Wrapper --
-----------------------------------
end loop;
end Map_Formal_Package_Entities;
+ --------------------
+ -- Mark_Link_Once --
+ --------------------
+
+ procedure Mark_Link_Once (Decls : List_Id) is
+ procedure Mark_Link_Once (Ent : Entity_Id);
+
+ --------------------
+ -- Mark_Link_Once --
+ --------------------
+
+ procedure Mark_Link_Once (Ent : Entity_Id) is
+ begin
+ if Is_Public (Ent) then
+ Set_Is_Link_Once (Ent);
+ end if;
+
+ if Ekind (Ent) in E_Package | E_Package_Body
+ and then No (Renamed_Entity (Ent))
+ then
+ declare
+ Pack_Ent : Entity_Id;
+
+ begin
+ Pack_Ent := First_Entity (Ent);
+ while Present (Pack_Ent) loop
+ Mark_Link_Once (Pack_Ent);
+
+ Next_Entity (Pack_Ent);
+ end loop;
+ end;
+ end if;
+ end Mark_Link_Once;
+
+ Decl : Node_Id;
+ Spec : Node_Id;
+
+ begin
+ Decl := First (Decls);
+ while Present (Decl) loop
+ if Nkind (Decl) in N_Generic_Instantiation
+ and then Is_Structural (Decl)
+ then
+ Spec := Instance_Spec (Decl);
+
+ Mark_Link_Once (Defining_Entity (Specification (Spec)));
+
+ if Nkind (Decl) = N_Package_Instantiation
+ and then Present (Corresponding_Body (Spec))
+ then
+ Mark_Link_Once (Corresponding_Body (Spec));
+ end if;
+ end if;
+
+ Next (Decl);
+ end loop;
+ end Mark_Link_Once;
+
-----------------------
-- Move_Freeze_Nodes --
-----------------------
-- Must be invoked just at the end of the end of the processing of a
-- generic spec or body.
+ function Build_Structural_Instantiation
+ (N : Node_Id;
+ Gen_Unit : Entity_Id;
+ Actuals : List_Id) return Entity_Id;
+ -- Build a structural instantiation of Gen_Unit on Actuals at N and return
+ -- its defining entity, after either having inserted it at the appropriate
+ -- place in the tree or turned it into a renaming of a previous instance.
+
procedure Check_Generic_Child_Unit
(Gen_Id : Node_Id;
Parent_Installed : in out Boolean);
-- Return true if E is a package created for an abbreviated instantiation
-- to check conformance between formal package and corresponding actual.
+ procedure Mark_Link_Once (Decls : List_Id);
+ -- Mark all the structural instances present in Decls as Link Once
+
function Need_Subprogram_Instance_Body
(N : Node_Id;
Subp : Entity_Id) return Boolean;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
+with Sem_Ch12; use Sem_Ch12;
with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
No_Interpretation;
end if;
+ -- Or this may be a reference to a structural instantiation
+ -- with named associations if GNAT extensions are allowed.
+
+ elsif (Is_Generic_Subprogram (Nam_Ent)
+ or else Ekind (Nam_Ent) = E_Generic_Package)
+ and then All_Extensions_Allowed
+ and then not Is_Empty_List (Parameter_Associations (N))
+ then
+ declare
+ Act : Node_Id;
+ Act_List : List_Id;
+ Assoc : Node_Id;
+ Inst_Id : Entity_Id;
+
+ begin
+ Act_List := New_List;
+ Assoc := First (Parameter_Associations (N));
+ while Present (Assoc) loop
+ if Nkind (Assoc) = N_Parameter_Association then
+ Act :=
+ Make_Generic_Association (Sloc (Assoc),
+ Selector_Name =>
+ Relocate_Node (Selector_Name (Assoc)),
+ Explicit_Generic_Actual_Parameter =>
+ Relocate_Node
+ (Explicit_Actual_Parameter (Assoc)));
+ else
+ Act :=
+ Make_Generic_Association (Sloc (Assoc),
+ Explicit_Generic_Actual_Parameter =>
+ Relocate_Node (Assoc));
+ end if;
+
+ Append_To (Act_List, Act);
+ Next (Assoc);
+ end loop;
+
+ Inst_Id :=
+ Build_Structural_Instantiation (N, Nam_Ent, Act_List);
+ if Present (Inst_Id) then
+ Rewrite (N, New_Occurrence_Of (Inst_Id, Loc));
+ else
+ Rewrite (N,
+ Make_Raise_Program_Error (Loc,
+ Reason => PE_Explicit_Raise));
+ end if;
+ Analyze (N);
+ end;
+
else
No_Interpretation;
end if;
-- If the prefix of an indexed component is overloaded, the proper
-- interpretation is selected by the index types and the context.
+ procedure Process_Generic_Instantiation;
+ -- The prefix in indexed component form is a generic unit. This
+ -- routine processes it and builds the implicit instantiation.
+
---------------------------
-- Process_Function_Call --
---------------------------
end if;
end Process_Overloaded_Indexed_Component;
+ -----------------------------------
+ -- Process_Generic_Instantiation --
+ -----------------------------------
+
+ procedure Process_Generic_Instantiation is
+ Act_List : List_Id;
+ Expr : Node_Id;
+ Inst_Id : Entity_Id;
+
+ begin
+ Act_List := New_List;
+ Expr := First (Expressions (N));
+ while Present (Expr) loop
+ Append_To (Act_List,
+ Make_Generic_Association (Sloc (Expr),
+ Explicit_Generic_Actual_Parameter =>
+ Relocate_Node (Expr)));
+ Next (Expr);
+ end loop;
+
+ Inst_Id := Build_Structural_Instantiation (N, U_N, Act_List);
+ if Present (Inst_Id) then
+ Rewrite (N, New_Occurrence_Of (Inst_Id, Sloc (N)));
+ else
+ Rewrite (N,
+ Make_Raise_Program_Error (Sloc (N),
+ Reason => PE_Explicit_Raise));
+ end if;
+ Analyze (N);
+ end Process_Generic_Instantiation;
+
-- Start of processing for Analyze_Indexed_Component_Form
begin
-- A common beginner's (or C++ templates fan) error
- Error_Msg_N ("generic subprogram cannot be called", N);
- Set_Etype (N, Any_Type);
- return;
+ if All_Extensions_Allowed
+ and then not Is_Empty_List (Expressions (N))
+ then
+ Process_Generic_Instantiation;
+ else
+ Error_Msg_N ("generic subprogram cannot be called", N);
+ Set_Etype (N, Any_Type);
+ return;
+ end if;
+
+ elsif Ekind (U_N) = E_Generic_Package
+ and then All_Extensions_Allowed
+ and then not Is_Empty_List (Expressions (N))
+ then
+ Process_Generic_Instantiation;
else
Process_Indexed_Component_Or_Slice;
-- by inserting an extra with clause since redundant clauses don't
-- really matter.
- if All_Extensions_Allowed and then Is_In_Context_Clause (Clause) then
+ if All_Extensions_Allowed
+ and then Is_In_Context_Clause (Clause)
+ and then Nkind (Pack) in N_Expanded_Name
+ | N_Identifier
+ | N_Selected_Component
+ then
declare
Unum : Unit_Number_Type;
With_Clause : constant Node_Id :=
Id := Subtype_Mark (N);
Find_Type (Id);
+ if not Is_Entity_Name (Id) then
+ pragma Assert (Serious_Errors_Detected > 0);
+ return;
+ end if;
E := Base_Type (Entity (Id));
-- There are many cases where a use_type_clause may be reanalyzed due to
-----------------------------------
procedure Check_In_Previous_With_Clause (N, Nam : Node_Id) is
- Pack : constant Entity_Id := Entity (Original_Node (Nam));
+
+ function Get_Name (N : Node_Id) return Node_Id;
+ -- Return the name of a package that may be present in a clause
+
+ --------------
+ -- Get_Name --
+ --------------
+
+ function Get_Name (N : Node_Id) return Node_Id is
+ begin
+ case Nkind (N) is
+ when N_Indexed_Component =>
+ return Prefix (N);
+
+ when N_Function_Call =>
+ return Name (N);
+
+ when others =>
+ return N;
+ end case;
+ end Get_Name;
+
+ -- Local variables
+
+ Pack : constant Entity_Id := Entity (Get_Name (Original_Node (Nam)));
+
Item : Node_Id;
Par : Node_Id;
+ -- Start of processing for Check_In_Previous_With_Clause
+
begin
Item := First (Context_Items (Parent (N)));
while Present (Item) and then Item /= N loop
and then Nkind (Name (Item)) /= N_Selected_Component
and then Entity (Name (Item)) = Pack
then
- Par := Nam;
+ Par := Get_Name (Original_Node (Nam));
-- Find root library unit in with_clause
Par := Prefix (Par);
end loop;
- if Is_Child_Unit (Entity (Original_Node (Par))) then
+ if Is_Child_Unit (Entity (Par)) then
Error_Msg_NE ("& is not directly visible", Par, Entity (Par));
else
return;
if Nkind (Parent (N)) /= N_Compilation_Unit then
return;
+ -- Structural instances can always be renamed
+
+ elsif Is_Generic_Instance (Old_E)
+ and then Present (Get_Unit_Instantiation_Node (Old_E))
+ and then Is_Structural (Get_Unit_Instantiation_Node (Old_E))
+ then
+ return;
+
-- Check for library unit. Note that we used to check for the scope
-- being Standard here, but that was wrong for Standard itself.
end if;
end if;
- if Is_Empty_Elmt_List (Used_Operations (N)) then
- return;
-
- else
+ if Present (Used_Operations (N)) then
Elmt := First_Elmt (Used_Operations (N));
while Present (Elmt) loop
Set_Is_Potentially_Use_Visible (Node (Elmt), False);
Analyze (Decl);
end Add_Global_Declaration;
+ ---------------------------
+ -- Add_Local_Declaration --
+ ---------------------------
+
+ procedure Add_Local_Declaration
+ (Decl : Node_Id;
+ N : Node_Id;
+ Scop : Entity_Id)
+ is
+ function Find_Associated_Scope (N : Node_Id) return Scope_Kind_Id;
+ -- Return the scope associated with the declarative part of N
+
+ ---------------------------
+ -- Find_Associated_Scope --
+ ---------------------------
+
+ function Find_Associated_Scope (N : Node_Id) return Scope_Kind_Id is
+ begin
+ case Nkind (N) is
+ when N_Block_Statement =>
+ return Entity (Identifier (N));
+
+ when N_Compilation_Unit
+ | N_Compilation_Unit_Aux
+ =>
+ return Standard_Standard;
+
+ when N_Package_Specification
+ | N_Protected_Definition
+ | N_Task_Definition
+ =>
+ return Defining_Entity (Parent (N));
+
+ when N_Entry_Body
+ | N_Package_Body
+ | N_Protected_Body
+ | N_Task_Body
+ =>
+ return Corresponding_Spec (N);
+
+ when N_Subprogram_Body =>
+ if Acts_As_Spec (N) then
+ return Defining_Entity (N);
+ else
+ return Corresponding_Spec (N);
+ end if;
+
+ when others =>
+ raise Program_Error;
+ end case;
+ end Find_Associated_Scope;
+
+ -- Local variables
+
+ Nod : Node_Id;
+ Par : Node_Id;
+
+ -- Start of processing for Add_Local_Declaration
+
+ begin
+ Nod := N;
+ Par := Parent (Nod);
+
+ -- Look for the innermost enclosing construct with a declarative part
+
+ while Nkind (Par) not in N_Block_Statement
+ | N_Compilation_Unit
+ | N_Compilation_Unit_Aux
+ | N_Entry_Body
+ | N_Package_Body
+ | N_Package_Specification
+ | N_Protected_Body
+ | N_Protected_Definition
+ | N_Subprogram_Body
+ | N_Task_Body
+ | N_Task_Definition
+ or else (Present (Scop) and Find_Associated_Scope (Par) /= Scop)
+ loop
+ Nod := Par;
+ Par := Parent (Nod);
+ end loop;
+
+ -- Compilation units do not directly have a declarative part
+
+ if Nkind (Par) = N_Compilation_Unit then
+ Par := Aux_Decls_Node (Par);
+ end if;
+
+ -- Insert Decl before N or at the end of the declarative part
+
+ case Nkind (Par) is
+ when N_Block_Statement
+ | N_Compilation_Unit_Aux
+ | N_Entry_Body
+ | N_Package_Body
+ | N_Protected_Body
+ | N_Subprogram_Body
+ | N_Task_Body
+ =>
+ if Is_List_Member (Nod)
+ and then List_Containing (Nod) = Declarations (Par)
+ then
+ Insert_Before (Nod, Decl);
+
+ else
+ if No (Declarations (Par)) then
+ Set_Declarations (Par, New_List);
+ end if;
+
+ Append_To (Declarations (Par), Decl);
+ end if;
+
+ when N_Package_Specification
+ | N_Protected_Definition
+ | N_Task_Definition
+ =>
+ Insert_Before (Nod, Decl);
+
+ when others =>
+ raise Program_Error;
+ end case;
+
+ Push_Scope (Find_Associated_Scope (Par));
+ Analyze (Decl);
+ Pop_Scope;
+ end Add_Local_Declaration;
+
--------------------------------
-- Address_Integer_Convert_OK --
--------------------------------
end if;
end Defining_Entity;
+ ---------------------------------
+ -- Defining_Entity_Of_Instance --
+ ---------------------------------
+
+ function Defining_Entity_Of_Instance (N : Node_Id) return Entity_Id is
+ pragma Assert (Nkind (N) in N_Generic_Instantiation);
+ Spec : constant Node_Id := Instance_Spec (N);
+
+ begin
+ -- Fall back to Defining_Entity in case of previous errors
+
+ if No (Spec) then
+ return Defining_Entity (N);
+ end if;
+
+ if Nkind (N) = N_Package_Instantiation then
+ return Defining_Entity (Specification (Spec));
+ else
+ return Related_Instance (Defining_Entity (Specification (Spec)));
+ end if;
+ end Defining_Entity_Of_Instance;
+
------------------------------
-- Defining_Entity_Or_Empty --
------------------------------
-- for the current unit. The declared entity is added to current scope,
-- so the caller should push a new scope as required before the call.
+ procedure Add_Local_Declaration
+ (Decl : Node_Id;
+ N : Node_Id;
+ Scop : Entity_Id);
+ -- This procedure adds a declaration Decl to the innermost declarative
+ -- part that covers N, whose associated scope is Scop if Scop is present,
+ -- and before N if N is in this declarative part. The declared entity is
+ -- added to the scope associated with the declarative part.
+
function Add_Suffix (E : Entity_Id; Suffix : Character) return Name_Id;
-- Returns the name of E adding Suffix
-- This is equivalent to Defining_Entity but it returns Empty for nodes
-- without an entity instead of raising Program_Error.
+ function Defining_Entity_Of_Instance (N : Node_Id) return Entity_Id;
+ -- Given an N_Generic_Instantiation node, returns the defining entity of
+ -- the instance, that is to say the entity that is declared at N (which
+ -- is not the same as Defining_Entity (N), see Sem_Ch12).
+
function Denotes_Discriminant
(N : Node_Id;
Check_Concurrent : Boolean := False) return Boolean;
-- Indicates that an expression is a static expression according to the
-- rules in RM-4.9. See Sem_Eval for details.
+ -- Is_Structural
+ -- Present in N_Generic_Instantiation nodes. Set if the instantiation is
+ -- structural, that is to say, is the unique anonymous instantiation of
+ -- the generic unit on the actual parameters done in the outermost scope
+ -- where it would be legal to declare an identical named instantiation.
+
-- Is_Subprogram_Descriptor
-- Present in N_Object_Declaration, and set only for the object
-- declaration generated for a subprogram descriptor in fast exception
-- Is_Elaboration_Warnings_OK_Node
-- Is_Declaration_Level_Node
-- Is_Known_Guaranteed_ABE
+ -- Is_Structural
-- N_Procedure_Instantiation
-- Sloc points to PROCEDURE
-- Must_Override set if overriding indicator present
-- Must_Not_Override set if not_overriding indicator present
-- Is_Known_Guaranteed_ABE
+ -- Is_Structural
-- N_Function_Instantiation
-- Sloc points to FUNCTION
-- Must_Override set if overriding indicator present
-- Must_Not_Override set if not_overriding indicator present
-- Is_Known_Guaranteed_ABE
+ -- Is_Structural
-- Note: overriding indicator is an Ada 2005 feature
projects / thirdparty / gcc.git / commitdiff
