Another update from ingydotnet^djgoku

Task/Polymorphic-copy/00DESCRIPTION

@@ -1,8 +1,15 @@
-An object is [[polymorphism|polymorphic]] when its specific type may vary. The types a specific value may take, is called ''class''.
+An object is [[polymorphism|polymorphic]] when its specific type may vary.
+The types a specific value may take, is called ''class''.
 
 It is trivial to copy an object if its type is known:
 <lang c>int x;
 int y = x;</lang>
-Here x is not polymorphic, so y is declared of same type (''int'') as x. But if the specific type of x were unknown, then y could not be declared of any specific type.
+Here x is not polymorphic, so y is declared of same type (''int'') as x.
+But if the specific type of x were unknown, then y could not be declared of any specific type.
 
-The task: let a polymorphic object contain an instance of some specific type S derived from a type T. The type T is known. The type S is possibly unknown until [[run time]]. The objective is to create an exact copy of such polymorphic object (not to create a [[reference]], nor a pointer to). Let further the type T have a method overridden by S. This method is to be called on the copy to demonstrate that the specific type of the copy is indeed S.
+The task: let a polymorphic object contain an instance of some specific type S derived from a type T.
+The type T is known.
+The type S is possibly unknown until [[run time]].
+The objective is to create an exact copy of such polymorphic object (not to create a [[reference]], nor a pointer to).
+Let further the type T have a method overridden by S.
+This method is to be called on the copy to demonstrate that the specific type of the copy is indeed S.

Task/Polymorphic-copy/Delphi/polymorphic-copy-1.delphi

@@ -0,0 +1,33 @@
+program PolymorphicCopy;
+
+type
+  T = class
+    function Name:String; virtual;
+    function Clone:T; virtual;
+  end;
+
+  S = class(T)
+    function Name:String; override;
+    function Clone:T; override;
+  end;
+
+function T.Name :String; begin Exit('T')     end;
+function T.Clone:T;      begin Exit(T.Create)end;
+
+function S.Name :String; begin Exit('S')     end;
+function S.Clone:T;      begin Exit(S.Create)end;
+
+procedure Main;
+var
+  Original, Clone :T;
+begin
+  Original := S.Create;
+  Clone    := Original.Clone;
+
+  WriteLn(Original.Name);
+  WriteLn(Clone.Name);
+end;
+
+begin
+  Main;
+end.

Task/Polymorphic-copy/Delphi/polymorphic-copy-2.delphi

@@ -0,0 +1,2 @@
+S
+S

Task/Polymorphic-copy/Forth/polymorphic-copy-2.fth

@@ -0,0 +1,25 @@
+include FMS-SI.f
+
+:class T
+ ivar container  \ can contain an object of any type
+ :m put ( obj -- ) container ! ;m
+ :m init: self self put ;m \ initially container holds self
+ :m print ." class is T" ;m
+ :m print-container container @ print ;m
+;class
+
+:class S <super T    \ subclass S from T
+ :m print ." class is S" ;m \ override T's print method
+;class
+
+: ecopy {: obj1 -- obj2 :} \ make an exact copy of obj
+  obj1 dup >class dfa @
+  obj1 heap: dup >r swap move r> ;
+
+T obj-t  \ instantiate a T object
+obj-t print-container \ class is T
+
+S obj-s  \ instantiate an S object
+obj-s ecopy obj-t put  \ make an exact copy of S object and store in T object
+
+obj-t print-container \ class is S

Task/Polymorphic-copy/Fortran/polymorphic-copy.f

@@ -0,0 +1,66 @@
+!-----------------------------------------------------------------------
+!Module polymorphic_copy_example_module
+!-----------------------------------------------------------------------
+module polymorphic_copy_example_module
+   implicit none
+   private ! all by default
+   public :: T,S
+
+   type, abstract :: T
+   contains
+      procedure (T_procedure1), deferred, pass :: identify
+      procedure (T_procedure2), deferred, pass :: duplicate
+   end type T
+
+
+   abstract interface
+      subroutine T_procedure1(this)
+         import  :: T
+         class(T), intent(inout) :: this
+      end subroutine T_procedure1
+      function T_procedure2(this) result(Tobj)
+         import  :: T
+         class(T), intent(inout) :: this
+         class(T), allocatable :: Tobj
+      end function T_procedure2
+   end interface
+
+   type, extends(T) :: S
+   contains
+      procedure, pass :: identify
+      procedure, pass :: duplicate
+   end type S
+
+ contains
+
+   subroutine  identify(this)
+      implicit none
+      class(S), intent(inout) :: this
+      write(*,*) "S"
+   end subroutine identify
+
+   function duplicate(this) result(obj)
+      class(S), intent(inout) :: this
+      class(T), allocatable :: obj
+      allocate(obj, source = S())
+   end function duplicate
+
+end module polymorphic_copy_example_module
+
+!-----------------------------------------------------------------------
+!Main program test
+!-----------------------------------------------------------------------
+program    test
+   use polymorphic_copy_example_module
+   implicit none
+
+   class(T), allocatable :: Sobj
+   class(T), allocatable :: Sclone
+
+   allocate(Sobj, source = S())
+   allocate(Sclone, source = Sobj % duplicate())
+
+   call Sobj % identify()
+   call Sclone % identify()
+
+end program test

Task/Polymorphic-copy/Go/polymorphic-copy.go

@@ -37,8 +37,8 @@ func (x t) identify() string {
 }
 
 // the same method on s.  although s already satisfied i, calls to identify
-// will now find this method rather than the one defined on t.  in a sense
-// it "overrides" the method of the "base class."
+// will now find this method rather than the one defined on t.
+// in a sense it "overrides" the method of the "base class."
 func (x s) identify() string {
     return "I'm an s!"
 }