aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

11
Task/Polymorphic-copy/Ada/polymorphic-copy.ada
View file

@ -3,6 +3,7 @@ with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Polymorphic_Copy is
package Base is
type T is tagged null record;
type T_ptr is access all T'Class;
function Name (X : T) return String;
end Base;
use Base;
@ -21,6 +22,12 @@ procedure Test_Polymorphic_Copy is
Put_Line ("Copied " & Duplicate.Name); -- Check the copy
end Copier;
-- The function knows nothing about S and creates a copy on the heap
function Clone (X : T'Class) return T_ptr is
begin
return new T'Class(X);
end Copier;
package Derived is
type S is new T with null record;
overriding function Name (X : S) return String;
@ -36,7 +43,11 @@ procedure Test_Polymorphic_Copy is
Object_1 : T;
Object_2 : S;
Object_3 : T_ptr := Clone(T);
Object_4 : T_ptr := Clone(S);
begin
Copier (Object_1);
Copier (Object_2);
Put_Line ("Cloned " & Object_3.all.Name);
Put_Line ("Cloned " & Object_4.all.Name);
end Test_Polymorphic_Copy;