Initial data commit

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