type Tag is private;
function External_Tag(T : Tag) return String;
function Internal_Tag(External : String) return Tag;
... -- not specified by the language
end Ada.Tags;
14 | S'Class | S'Class denotes a subtype of the class-wide type (called T'Class in this International Standard) for the class rooted at T (or if S already denotes a class-wide subtype, then S'Class is the same as S).
|
16 | S'Tag | S'Tag denotes the tag of the type T (or if T is class-wide, the tag of the root type of the corresponding class). The value of this attribute is of type Tag. |
18 | X'Tag | X'Tag denotes the tag of X. The value of this attribute is of type Tag. |
record
X, Y : Real := 0.0;
end record;
-- Components will be added by each extension
type T is tagged null record;
function F return T; --Inherited versions will be abstract.
end P;
type TT is tagged private;
package Gp is
type NT is abstract new TT with null record;
procedure Q(X : in NT) is abstract;
end Gp;
type NT2 is new NT with null record; --Illegal!
procedure Q(X : in NT2) is begin null; end Q;
--Is this legal or not? Can't decide because
--we don't know whether TT had any functions that go abstract
--on extension.
end Gp;
record
Paint : Color := White;
end record;
-- Components X and Y are inherited
record -- a leaf in an Expression tree
Value : Real;
end record;
-- see 3.10
record -- an internal node in an Expression tree
Left, Right : Expr_Ptr;
end record;
type Subtraction is new Binary_Operation with null record;
-- No additional components needed for these extensions
new Addition'(
Left => new Literal'(Value => 5.0),
Right => new Subtraction'(
Left => new Literal'(Value => 13.0),
Right => new Literal'(Value => 7.0)));
13.a Change: Rule moved here from 13.14, "Freezing Rules", as per WG9 resolution.
type T1 is tagged null record;
procedure Op_A(Arg : in T1);
procedure Op_B(Arg : in T1);
end P1;
package P2 is
type T2 is new T1 with null record;
procedure Op_A(Param : in T2);
private
procedure Op_B(Param : in T2);
end P2;
procedure Main is
X : T2;
Y : T1'Class := X;
begin
P2.Op_A(Param => X); --Nondispatching call.
P1.Op_A(Arg => Y); --Dispatching call.
P2.Op_B(Arg => X); --Nondispatching call.
P1.Op_B(Arg => Y); --Dispatching call.
end Main;
type T is abstract tagged private;
function Foo (X : T) return Boolean is abstract; --Illegal!
private
type T is tagged null record; --Illegal!
X : T;
Y : Boolean := Foo (T'Class (X));
end P;
type Field_Size is range 0..100;
type T is abstract tagged null record;
procedure Print(X : in T; F : in Field_Size := 0) is abstract;
. . .
package Q is
type My_Field_Size is new Field_Size;
--implicit declaration of Print(X : T; F : My_Field_Size := 0) is abstract;
end Q;
type Ancestor is abstract ...;
procedure Do_Something(X : in Ancestor) is abstract;
end Pack1;
package Pack2 is
type T1 is new Ancestor with record ...;
--A concrete type.
procedure Do_Something(X : in T1); --Have to override.
end Pack2;
with Pack2; use Pack2;
package Pack3 is
type T2 is new Ancestor with private;
--A concrete type.
private
type T2 is new T1 with --Parent different from ancestor.
record ... end record;
--Here, we inherit Pack2.Do_Something.
end Pack3;
type T is abstract new T1 with private;
private
type T is abstract new T2 with record ... end record;
...
end Pack;
subtype Element_Type is Natural;
type Set is abstract tagged null record;
function Empty return Set is abstract;
function Union(Left, Right : Set) return Set is abstract;
function Intersection(Left, Right : Set) return Set is abstract;
function Unit_Set(Element : Element_Type) return Set is abstract;
procedure Take(Element : out Element_Type; From : in out Set) is abstract;
end Sets;
type Public_Part is abstract tagged
record
...
end record;
type T is new Public_Part with private;
...
private
type T is new Public_Part with
record
...
end record;
end P;