From 03bf2bd2a2da6105140a2b48118f3a9fda86b501 Mon Sep 17 00:00:00 2001 From: vsande Date: Thu, 22 Oct 2015 16:22:24 +0200 Subject: [PATCH] Add WrapperFactoryListSingleton and the root of the hierarchy. Test modified acording to this changes --- src/lib/FPL.f90 | 26 ++++ src/lib/ParameterListEntryContainer.f90 | 40 +++--- src/lib/Wrapper/WrapperFactoryList.f90 | 115 ++++++++---------- src/lib/WrapperFactoryListSingleton.f90 | 41 +++++++ .../ParameterListEntryContainer_Test.f90 | 71 ++++++++--- src/tests/WrapperFactoryList_DLCA_Test.f90 | 29 +++-- src/tests/WrapperFactoryList_I1P_Test.f90 | 25 ++-- src/tests/WrapperFactoryList_I2P_Test.f90 | 25 ++-- src/tests/WrapperFactoryList_I4P_Test.f90 | 25 ++-- src/tests/WrapperFactoryList_I8P_Test.f90 | 25 ++-- src/tests/WrapperFactoryList_L_Test.f90 | 25 ++-- src/tests/WrapperFactoryList_R4P_Test.f90 | 25 ++-- src/tests/WrapperFactoryList_R8P_Test.f90 | 25 ++-- 13 files changed, 289 insertions(+), 208 deletions(-) create mode 100644 src/lib/FPL.f90 create mode 100644 src/lib/WrapperFactoryListSingleton.f90 diff --git a/src/lib/FPL.f90 b/src/lib/FPL.f90 new file mode 100644 index 0000000..bae6d6b --- /dev/null +++ b/src/lib/FPL.f90 @@ -0,0 +1,26 @@ +module FPL + +USE IR_Precision, only: I4P +USE ParameterListEntryContainer +USE WrapperFactoryListSingleton + +public :: ParameterListEntryContainer_t + +contains + + subroutine FPL_Init() + !----------------------------------------------------------------- + !< Initialize FPL + !----------------------------------------------------------------- + call TheWrapperFactoryList_Init() + end subroutine FPL_Init + + + subroutine FPL_Finalize() + !----------------------------------------------------------------- + !< Finalize FPL + !----------------------------------------------------------------- + call TheWrapperFactoryList%Free() + end subroutine FPL_Finalize + +end module FPL diff --git a/src/lib/ParameterListEntryContainer.f90 b/src/lib/ParameterListEntryContainer.f90 index 6ba7e82..451d7ad 100644 --- a/src/lib/ParameterListEntryContainer.f90 +++ b/src/lib/ParameterListEntryContainer.f90 @@ -14,7 +14,7 @@ module ParameterListEntryContainer USE IR_Precision USE ParameterListEntry -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper @@ -26,7 +26,6 @@ module ParameterListEntryContainer type, public:: ParameterListEntryContainer_t private - type(WrapperFactoryList_t) :: WrapperFactoryList type(ParameterListEntry_t), allocatable :: DataBase(:) integer(I4P) :: Size = 0_I4P contains @@ -67,7 +66,7 @@ module ParameterListEntryContainer ParameterListEntryContainer_Get5D, & ParameterListEntryContainer_Get6D, & ParameterListEntryContainer_Get7D -! procedure, public :: isPresent => ParameterListEntryContainer_isPresent + procedure, public :: isPresent => ParameterListEntryContainer_isPresent ! procedure, public :: isOfDataType => ParameterListEntryContainer_isOfDataType ! procedure, public :: isSubList => ParameterListEntryContainer_isSubList procedure, public :: Del => ParameterListEntryContainer_RemoveEntry @@ -110,7 +109,6 @@ subroutine ParameterListEntryContainer_Init(this,Size) this%Size = DefaultDataBaseSize endif allocate(this%DataBase(0:this%Size-1)) - call this%WrapperFactoryList%Init() end subroutine ParameterListEntryContainer_Init @@ -121,7 +119,6 @@ subroutine ParameterListEntryContainer_Free(this) class(ParameterListEntryContainer_t), intent(INOUT) :: this !< Parameter List Entry Containter type integer(I4P) :: DBIterator !< Database Iterator index !----------------------------------------------------------------- - call this%WrapperFactoryList%Free() if (allocated(this%DataBase)) THEN do DBIterator=lbound(this%DataBase,dim=1),ubound(this%DataBase,dim=1) call this%DataBase(DBIterator)%Free() @@ -152,7 +149,7 @@ subroutine ParameterListEntryContainer_Set0D(this,Key,Value) class(WrapperFactory_t), pointer :: WrapperFactory class(DimensionsWrapper_t), allocatable :: Wrapper !----------------------------------------------------------------- - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%Wrap(Value=Value, Wrapper=Wrapper) if(allocated(Wrapper)) then call this%DataBase(this%Hash(Key=Key))%AddNode(Key=Key,Value=Wrapper) @@ -172,7 +169,7 @@ subroutine ParameterListEntryContainer_Set1D(this,Key,Value) class(WrapperFactory_t), pointer :: WrapperFactory class(DimensionsWrapper_t), allocatable :: Wrapper !----------------------------------------------------------------- - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%Wrap(Value=Value, Wrapper=Wrapper) if(allocated(Wrapper)) then call this%DataBase(this%Hash(Key=Key))%AddNode(Key=Key,Value=Wrapper) @@ -192,7 +189,7 @@ subroutine ParameterListEntryContainer_Set2D(this,Key,Value) class(WrapperFactory_t), pointer :: WrapperFactory class(DimensionsWrapper_t), allocatable :: Wrapper !----------------------------------------------------------------- - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%Wrap(Value=Value, Wrapper=Wrapper) if(allocated(Wrapper)) then call this%DataBase(this%Hash(Key=Key))%AddNode(Key=Key,Value=Wrapper) @@ -212,7 +209,7 @@ subroutine ParameterListEntryContainer_Set3D(this,Key,Value) class(WrapperFactory_t), pointer :: WrapperFactory class(DimensionsWrapper_t), allocatable :: Wrapper !----------------------------------------------------------------- - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%Wrap(Value=Value, Wrapper=Wrapper) if(allocated(Wrapper)) then call this%DataBase(this%Hash(Key=Key))%AddNode(Key=Key,Value=Wrapper) @@ -232,7 +229,7 @@ subroutine ParameterListEntryContainer_Set4D(this,Key,Value) class(WrapperFactory_t), pointer :: WrapperFactory class(DimensionsWrapper_t), allocatable :: Wrapper !----------------------------------------------------------------- - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%Wrap(Value=Value, Wrapper=Wrapper) if(allocated(Wrapper)) then call this%DataBase(this%Hash(Key=Key))%AddNode(Key=Key,Value=Wrapper) @@ -252,7 +249,7 @@ subroutine ParameterListEntryContainer_Set5D(this,Key,Value) class(WrapperFactory_t), pointer :: WrapperFactory class(DimensionsWrapper_t), allocatable :: Wrapper !----------------------------------------------------------------- - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%Wrap(Value=Value, Wrapper=Wrapper) if(allocated(Wrapper)) then call this%DataBase(this%Hash(Key=Key))%AddNode(Key=Key,Value=Wrapper) @@ -272,7 +269,7 @@ subroutine ParameterListEntryContainer_Set6D(this,Key,Value) class(WrapperFactory_t), pointer :: WrapperFactory class(DimensionsWrapper_t), allocatable :: Wrapper !----------------------------------------------------------------- - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%Wrap(Value=Value, Wrapper=Wrapper) if(allocated(Wrapper)) then call this%DataBase(this%Hash(Key=Key))%AddNode(Key=Key,Value=Wrapper) @@ -292,7 +289,7 @@ subroutine ParameterListEntryContainer_Set7D(this,Key,Value) class(WrapperFactory_t), pointer :: WrapperFactory class(DimensionsWrapper_t), allocatable :: Wrapper !----------------------------------------------------------------- - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%Wrap(Value=Value, Wrapper=Wrapper) if(allocated(Wrapper)) then call this%DataBase(this%Hash(Key=Key))%AddNode(Key=Key,Value=Wrapper) @@ -319,7 +316,7 @@ subroutine ParameterListEntryContainer_Get0D(this,Key,Value) type is (ParameterListEntry_t) call Node%GetValue(Value=Wrapper) if(allocated(Wrapper)) then - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value) endif end select @@ -344,7 +341,7 @@ subroutine ParameterListEntryContainer_Get1D(this,Key,Value) type is (ParameterListEntry_t) call Node%GetValue(Value=Wrapper) if(allocated(Wrapper)) then - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value) endif end select @@ -369,7 +366,7 @@ subroutine ParameterListEntryContainer_Get2D(this,Key,Value) type is (ParameterListEntry_t) call Node%GetValue(Value=Wrapper) if(allocated(Wrapper)) then - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value) endif end select @@ -394,7 +391,7 @@ subroutine ParameterListEntryContainer_Get3D(this,Key,Value) type is (ParameterListEntry_t) call Node%GetValue(Value=Wrapper) if(allocated(Wrapper)) then - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value) endif end select @@ -419,7 +416,7 @@ subroutine ParameterListEntryContainer_Get4D(this,Key,Value) type is (ParameterListEntry_t) call Node%GetValue(Value=Wrapper) if(allocated(Wrapper)) then - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value) endif end select @@ -444,7 +441,7 @@ subroutine ParameterListEntryContainer_Get5D(this,Key,Value) type is (ParameterListEntry_t) call Node%GetValue(Value=Wrapper) if(allocated(Wrapper)) then - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value) endif end select @@ -469,7 +466,7 @@ subroutine ParameterListEntryContainer_Get6D(this,Key,Value) type is (ParameterListEntry_t) call Node%GetValue(Value=Wrapper) if(allocated(Wrapper)) then - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value) endif end select @@ -494,7 +491,7 @@ subroutine ParameterListEntryContainer_Get7D(this,Key,Value) type is (ParameterListEntry_t) call Node%GetValue(Value=Wrapper) if(allocated(Wrapper)) then - WrapperFactory => this%WrapperFactoryList%GetFactory(Value=Value) + WrapperFactory => TheWrapperFactoryList%GetFactory(Value=Value) if(associated(WrapperFactory)) call WrapperFactory%UnWrap(Wrapper=Wrapper, Value=Value) endif end select @@ -569,6 +566,7 @@ subroutine ParameterListEntryContainer_Print(this, unit, prefix, iostat, iomsg) endif if (present(iostat)) iostat = iostatd if (present(iomsg)) iomsg = iomsgd + call TheWrapperFactoryList%Print(unit=unit) end subroutine ParameterListEntryContainer_Print diff --git a/src/lib/Wrapper/WrapperFactoryList.f90 b/src/lib/Wrapper/WrapperFactoryList.f90 index f307c39..66ec0e8 100644 --- a/src/lib/Wrapper/WrapperFactoryList.f90 +++ b/src/lib/Wrapper/WrapperFactoryList.f90 @@ -2,70 +2,54 @@ module WrapperFactoryList USE LinkedList USE WrapperFactory -USE DLCAWrapperFactory -USE I1PWrapperFactory -USE I2PWrapperFactory -USE I4PWrapperFactory -USE I8PWrapperFactory -USE LWrapperFactory -USE R4PWrapperFactory -USE R8PWrapperFactory -USE UPWrapperFactory - implicit none private type, extends(LinkedList_t), public :: WrapperFactoryList_t private - class(WrapperFactory_t), pointer :: Value + class(WrapperFactory_t), pointer :: Value => null() + class(WrapperFactory_t), pointer :: DefaultFactory => null() contains private - procedure :: WrapperFactoryList_AddNode - procedure :: WrapperFactoryList_GetFactory0D - procedure :: WrapperFactoryList_GetFactory1D - procedure :: WrapperFactoryList_GetFactory2D - procedure :: WrapperFactoryList_GetFactory3D - procedure :: WrapperFactoryList_GetFactory4D - procedure :: WrapperFactoryList_GetFactory5D - procedure :: WrapperFactoryList_GetFactory6D - procedure :: WrapperFactoryList_GetFactory7D - procedure, public :: Init => WrapperFactoryList_Init - procedure, public :: Free => WrapperFactoryList_Free - procedure, public :: HasValue => WrapperFactoryList_HasValue - procedure, public :: SetValue => WrapperFactoryList_SetValue - procedure, public :: GetValue => WrapperFactoryList_GetValue - procedure, public :: RemoveNode => WrapperFactoryList_RemoveNode - generic, public :: GetFactory => WrapperFactoryList_GetFactory0D, & - WrapperFactoryList_GetFactory1D, & - WrapperFactoryList_GetFactory2D, & - WrapperFactoryList_GetFactory3D, & - WrapperFactoryList_GetFactory4D, & - WrapperFactoryList_GetFactory5D, & - WrapperFactoryList_GetFactory6D, & - WrapperFactoryList_GetFactory7D - generic, public :: AddNode => WrapperFactoryList_AddNode - final :: WrapperFactoryList_Finalize + procedure :: WrapperFactoryList_AddNode + procedure :: WrapperFactoryList_GetFactory0D + procedure :: WrapperFactoryList_GetFactory1D + procedure :: WrapperFactoryList_GetFactory2D + procedure :: WrapperFactoryList_GetFactory3D + procedure :: WrapperFactoryList_GetFactory4D + procedure :: WrapperFactoryList_GetFactory5D + procedure :: WrapperFactoryList_GetFactory6D + procedure :: WrapperFactoryList_GetFactory7D + procedure, public :: SetDefaultFactory => WrapperFactoryList_SetDefaultFactory + procedure, public :: Free => WrapperFactoryList_Free + procedure, public :: HasValue => WrapperFactoryList_HasValue + procedure, public :: SetValue => WrapperFactoryList_SetValue + procedure, public :: GetValue => WrapperFactoryList_GetValue + procedure, public :: RemoveNode => WrapperFactoryList_RemoveNode + generic, public :: GetFactory => WrapperFactoryList_GetFactory0D, & + WrapperFactoryList_GetFactory1D, & + WrapperFactoryList_GetFactory2D, & + WrapperFactoryList_GetFactory3D, & + WrapperFactoryList_GetFactory4D, & + WrapperFactoryList_GetFactory5D, & + WrapperFactoryList_GetFactory6D, & + WrapperFactoryList_GetFactory7D + generic, public :: AddNode => WrapperFactoryList_AddNode + final :: WrapperFactoryList_Finalize end type WrapperFactoryList_t contains - subroutine WrapperFactoryList_Init(this) + subroutine WrapperFactoryList_SetDefaultFactory(this, DefaultFactory) !----------------------------------------------------------------- - !< WrapperFactory default initialization + !< Set Default Factory !----------------------------------------------------------------- - class(WrapperFactoryList_t), intent(INOUT) :: this !< Wrapper Factory List - + class(WrapperFactoryList_t), intent(INOUT) :: this !< Wrapper Factory List + class(WrapperFactory_T), target, intent(IN) :: DefaultFactory !< Default factory !----------------------------------------------------------------- - call this%AddNode(key='I1P', WrapperFactory=WrapperFactoryI1P) - call this%AddNode(key='I2P', WrapperFactory=WrapperFactoryI2P) - call this%AddNode(key='I4P', WrapperFactory=WrapperFactoryI4P) - call this%AddNode(key='I8P', WrapperFactory=WrapperFactoryI8P) - call this%AddNode(key='R4P', WrapperFactory=WrapperFactoryR4P) - call this%AddNode(key='R8P', WrapperFactory=WrapperFactoryR8P) - call this%AddNode(key='L', WrapperFactory=WrapperFactoryL) - call this%AddNode(key='DLCA', WrapperFactory=WrapperFactoryDLCA) - end subroutine WrapperFactoryList_Init + this%DefaultFactory => DefaultFactory + end subroutine WrapperFactoryList_SetDefaultFactory function WrapperFactoryList_HasValue(this) result(hasValue) @@ -110,6 +94,7 @@ recursive subroutine WrapperFactoryList_Free(this) !----------------------------------------------------------------- call this%LinkedList_t%Free() nullify(this%Value) + nullify(this%DefaultFactory) end subroutine WrapperFactoryList_Free @@ -210,8 +195,8 @@ recursive function WrapperFactoryList_GetFactory0D(this, Value) result(WrapperFa WrapperFactory => Next%GetFactory(Value=Value) end select else - ! Default case: Return an Unlimited Polymorphic Wrapper Factory - WrapperFactory => WrapperFactoryUP + ! Default case: Return the DefaultFactory + WrapperFactory => this%DefaultFactory endif endif end function WrapperFactoryList_GetFactory0D @@ -234,8 +219,8 @@ recursive function WrapperFactoryList_GetFactory1D(this, Value) result(WrapperFa WrapperFactory => Next%GetFactory(Value=Value) end select else - ! Default case: Return an Unlimited Polymorphic Wrapper Factory - WrapperFactory => WrapperFactoryUP + ! Default case: Return the DefaultFactory + WrapperFactory => this%DefaultFactory endif endif end function WrapperFactoryList_GetFactory1D @@ -258,8 +243,8 @@ recursive function WrapperFactoryList_GetFactory2D(this, Value) result(WrapperFa WrapperFactory => Next%GetFactory(Value=Value) end select else - ! Default case: Return an Unlimited Polymorphic Wrapper Factory - WrapperFactory => WrapperFactoryUP + ! Default case: Return the DefaultFactory + WrapperFactory => this%DefaultFactory endif endif end function WrapperFactoryList_GetFactory2D @@ -282,8 +267,8 @@ recursive function WrapperFactoryList_GetFactory3D(this, Value) result(WrapperFa WrapperFactory => Next%GetFactory(Value=Value) end select else - ! Default case: Return an Unlimited Polymorphic Wrapper Factory - WrapperFactory => WrapperFactoryUP + ! Default case: Return the DefaultFactory + WrapperFactory => this%DefaultFactory endif endif end function WrapperFactoryList_GetFactory3D @@ -307,8 +292,8 @@ recursive function WrapperFactoryList_GetFactory4D(this, Value) result(WrapperFa end select endif else - ! Default case: Return an Unlimited Polymorphic Wrapper Factory - WrapperFactory => WrapperFactoryUP + ! Default case: Return the DefaultFactory + WrapperFactory => this%DefaultFactory endif end function WrapperFactoryList_GetFactory4D @@ -330,8 +315,8 @@ recursive function WrapperFactoryList_GetFactory5D(this, Value) result(WrapperFa WrapperFactory => Next%GetFactory(Value=Value) end select else - ! Default case: Return an Unlimited Polymorphic Wrapper Factory - WrapperFactory => WrapperFactoryUP + ! Default case: Return the DefaultFactory + WrapperFactory => this%DefaultFactory endif endif end function WrapperFactoryList_GetFactory5D @@ -354,8 +339,8 @@ recursive function WrapperFactoryList_GetFactory6D(this, Value) result(WrapperFa WrapperFactory => Next%GetFactory(Value=Value) end select else - ! Default case: Return an Unlimited Polymorphic Wrapper Factory - WrapperFactory => WrapperFactoryUP + ! Default case: Return the DefaultFactory + WrapperFactory => this%DefaultFactory endif endif end function WrapperFactoryList_GetFactory6D @@ -378,8 +363,8 @@ recursive function WrapperFactoryList_GetFactory7D(this, Value) result(WrapperFa WrapperFactory => Next%GetFactory(Value=Value) end select else - ! Default case: Return an Unlimited Polymorphic Wrapper Factory - WrapperFactory => WrapperFactoryUP + ! Default case: Return the DefaultFactory + WrapperFactory => this%DefaultFactory endif endif end function WrapperFactoryList_GetFactory7D diff --git a/src/lib/WrapperFactoryListSingleton.f90 b/src/lib/WrapperFactoryListSingleton.f90 new file mode 100644 index 0000000..109b72a --- /dev/null +++ b/src/lib/WrapperFactoryListSingleton.f90 @@ -0,0 +1,41 @@ +module WrapperFactoryListSingleton + +USE WrapperFactoryList +USE DLCAWrapperFactory +USE I1PWrapperFactory +USE I2PWrapperFactory +USE I4PWrapperFactory +USE I8PWrapperFactory +USE LWrapperFactory +USE R4PWrapperFactory +USE R8PWrapperFactory +USE UPWrapperFactory + +implicit none +private + + type(WrapperFactoryList_t) :: TheWrapperFactoryList + +public :: TheWrapperFactoryList +public :: TheWrapperFactoryList_Init + +contains + + subroutine TheWrapperFactoryList_Init() + !----------------------------------------------------------------- + !< Set the dimensions of the Value contained in the wrapper + !----------------------------------------------------------------- + ! Add some Wrapper Factories to the list + call TheWrapperFactoryList%AddNode(key='I1P', WrapperFactory=WrapperFactoryI1P) + call TheWrapperFactoryList%AddNode(key='I2P', WrapperFactory=WrapperFactoryI2P) + call TheWrapperFactoryList%AddNode(key='I4P', WrapperFactory=WrapperFactoryI4P) + call TheWrapperFactoryList%AddNode(key='I8P', WrapperFactory=WrapperFactoryI8P) + call TheWrapperFactoryList%AddNode(key='R4P', WrapperFactory=WrapperFactoryR4P) + call TheWrapperFactoryList%AddNode(key='R8P', WrapperFactory=WrapperFactoryR8P) + call TheWrapperFactoryList%AddNode(key='L', WrapperFactory=WrapperFactoryL) + call TheWrapperFactoryList%AddNode(key='DLCA', WrapperFactory=WrapperFactoryDLCA) + ! Add Unlimited Polymorphic WrapperFactory as default + call TheWrapperFactoryList%SetDefaultFactory(DefaultFactory=WrapperFactoryUP) + end subroutine TheWrapperFactoryList_Init + +end module WrapperFactoryListSingleton diff --git a/src/tests/ParameterListEntryContainer_Test.f90 b/src/tests/ParameterListEntryContainer_Test.f90 index b0dcabd..011f096 100644 --- a/src/tests/ParameterListEntryContainer_Test.f90 +++ b/src/tests/ParameterListEntryContainer_Test.f90 @@ -1,22 +1,61 @@ Program ParameterListEntryContainer_Test -USE ParameterListEntryContainer +USE iso_fortran_env, only: OUTPUT_UNIT +USE IR_Precision, only: I4P, R4P, str +USE FPL type(ParameterListEntryContainer_t) :: Parameters -integer :: i = -1 -real, allocatable :: r(:) - -allocate(r(2)) - -call Parameters%Init() -call Parameters%Set(Key='Integer_scalar', Value=1) -call Parameters%Set(Key='Real_1D_array', Value=(/1.0,-2.0/)) -call Parameters%Set(Key='Logical', Value=.true.) -call Parameters%Set(Key='Character', Value='Parameter') -print*, '----------------------------------------------' -!call Parameters%Get(Key='Integer_scalar', Value=i) -!print*, i -call Parameters%Get(Key='Real_1D_array', Value=r) -print*, r +integer(I4P),allocatable :: array(:) +integer :: iter, numiters + +numiters = 7 + +call FPL_Init() + +call Parameters%Init(Size=3) + +do iter = 1, numiters + if(allocated(array)) deallocate(array); allocate(array(iter)); array = iter + write(unit=OUTPUT_UNIT, fmt='(A)') 'Setting: "'//'I4P_1D'//trim(str(no_sign=.true., n=iter))//'" ... Ok!' + call Parameters%Set(Key='I4P_1D'//trim(str(no_sign=.true., n=iter)), Value=array) +enddo + +write(unit=OUTPUT_UNIT, fmt='(A)') '' +call Parameters%Print(unit=OUTPUT_UNIT) +write(unit=OUTPUT_UNIT, fmt='(A)') '' + +do iter = 1, numiters + if(allocated(array)) deallocate(array); allocate(array(iter)) + write(unit=OUTPUT_UNIT, fmt='(A,$)') 'Getting: "'//'I4P_1D'//trim(str(no_sign=.true., n=iter))//'" ... ' + call Parameters%Get(Key='I4P_1D'//trim(str(no_sign=.true., n=iter)), Value=array) + if(all(array == iter)) then + write(unit=OUTPUT_UNIT, fmt='(A)') ' Ok!' + else + write(unit=OUTPUT_UNIT, fmt= '(A)') ' FAIL!!!!' + stop -1 + endif +enddo + +write(unit=OUTPUT_UNIT, fmt='(A)') '' + +do iter = numiters, 1, -1 + if(allocated(array)) deallocate(array); allocate(array(iter)); array = iter + if(Parameters%isPresent(Key='I4P_1D'//trim(str(no_sign=.true., n=iter)))) then + write(unit=OUTPUT_UNIT, fmt='(A,$)') 'Removing: "'//'I4P_1D'//trim(str(no_sign=.true., n=iter))//'" ... ' + call Parameters%Del(Key='I4P_1D'//trim(str(no_sign=.true., n=iter))) + if(Parameters%isPresent(Key='I4P_1D'//trim(str(no_sign=.true., n=iter)))) then + write(unit=OUTPUT_UNIT, fmt= '(A)') ' FAIL!!!!' + stop -1 + else + write(unit=OUTPUT_UNIT, fmt='(A)') ' Ok!' + endif + endif +enddo + +call Parameters%Free() + +call FPL_Finalize() + +if(allocated(array)) deallocate(array) end Program diff --git a/src/tests/WrapperFactoryList_DLCA_Test.f90 b/src/tests/WrapperFactoryList_DLCA_Test.f90 index 4c1ef55..ec3c439 100644 --- a/src/tests/WrapperFactoryList_DLCA_Test.f90 +++ b/src/tests/WrapperFactoryList_DLCA_Test.f90 @@ -1,14 +1,13 @@ -program WrapperFactoryList_Test +program WrapperTheWrapperFactoryList_Test USE iso_fortran_env, only: OUTPUT_UNIT USE IR_Precision, only: I4P -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper implicit none -type(WrapperFactoryList_t) :: factorylist class(WrapperFactory_t), pointer :: factory class(DimensionsWrapper_t), allocatable :: wrapper character(len=1) :: val0D = 'A' @@ -21,55 +20,55 @@ program WrapperFactoryList_Test character(len=1) :: val7D(1,1,1,1,1,1,1) = 'A' -call factorylist%Init() -call factorylist%Print(unit=OUTPUT_UNIT) +call TheWrapperFactoryList_Init() +call TheWrapperFactoryList%Print(unit=OUTPUT_UNIT) -factory => factorylist%GetFactory(Value=val0D) +factory => TheWrapperFactoryList%GetFactory(Value=val0D) if(associated(factory)) call factory%Wrap(Value=val0D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val1D) +factory => TheWrapperFactoryList%GetFactory(Value=val1D) if(associated(factory)) call factory%Wrap(Value=val1D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val2D) +factory => TheWrapperFactoryList%GetFactory(Value=val2D) if(associated(factory)) call factory%Wrap(Value=val2D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val3D) +factory => TheWrapperFactoryList%GetFactory(Value=val3D) if(associated(factory)) call factory%Wrap(Value=val3D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val4D) +factory => TheWrapperFactoryList%GetFactory(Value=val4D) if(associated(factory)) call factory%Wrap(Value=val4D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val5D) +factory => TheWrapperFactoryList%GetFactory(Value=val5D) if(associated(factory)) call factory%Wrap(Value=val5D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val6D) +factory => TheWrapperFactoryList%GetFactory(Value=val6D) if(associated(factory)) call factory%Wrap(Value=val6D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val7D) +factory => TheWrapperFactoryList%GetFactory(Value=val7D) if(associated(factory)) call factory%Wrap(Value=val7D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) call wrapper%Free() -call factorylist%Free() +call TheWrapperFactoryList%Free() nullify(factory) if(allocated(wrapper)) deallocate(wrapper) -end program WrapperFactoryList_Test +end program WrapperTheWrapperFactoryList_Test diff --git a/src/tests/WrapperFactoryList_I1P_Test.f90 b/src/tests/WrapperFactoryList_I1P_Test.f90 index 05554a8..bc0d5a5 100644 --- a/src/tests/WrapperFactoryList_I1P_Test.f90 +++ b/src/tests/WrapperFactoryList_I1P_Test.f90 @@ -2,13 +2,12 @@ program WrapperFactoryList_I1P_Test USE iso_fortran_env, only: OUTPUT_UNIT USE IR_Precision, only: I1P -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper implicit none -type(WrapperFactoryList_t) :: factorylist class(WrapperFactory_t), pointer :: factory class(DimensionsWrapper_t), allocatable :: wrapper integer(I1P) :: val0D = 9 @@ -21,51 +20,51 @@ program WrapperFactoryList_I1P_Test integer(I1P) :: val7D(1,1,1,1,1,1,1) = 9 -call factorylist%Init() -call factorylist%Print(unit=OUTPUT_UNIT) +call TheWrapperFactoryList_Init() +call TheWrapperFactoryList%Print(unit=OUTPUT_UNIT) -factory => factorylist%GetFactory(Value=val0D) +factory => TheWrapperFactoryList%GetFactory(Value=val0D) if(associated(factory)) call factory%Wrap(Value=val0D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val1D) +factory => TheWrapperFactoryList%GetFactory(Value=val1D) if(associated(factory)) call factory%Wrap(Value=val1D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val2D) +factory => TheWrapperFactoryList%GetFactory(Value=val2D) if(associated(factory)) call factory%Wrap(Value=val2D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val3D) +factory => TheWrapperFactoryList%GetFactory(Value=val3D) if(associated(factory)) call factory%Wrap(Value=val3D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val4D) +factory => TheWrapperFactoryList%GetFactory(Value=val4D) if(associated(factory)) call factory%Wrap(Value=val4D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val5D) +factory => TheWrapperFactoryList%GetFactory(Value=val5D) if(associated(factory)) call factory%Wrap(Value=val5D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val6D) +factory => TheWrapperFactoryList%GetFactory(Value=val6D) if(associated(factory)) call factory%Wrap(Value=val6D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val7D) +factory => TheWrapperFactoryList%GetFactory(Value=val7D) if(associated(factory)) call factory%Wrap(Value=val7D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) call wrapper%Free() -call factorylist%Free() +call TheWrapperFactoryList%Free() nullify(factory) if(allocated(wrapper)) deallocate(wrapper) diff --git a/src/tests/WrapperFactoryList_I2P_Test.f90 b/src/tests/WrapperFactoryList_I2P_Test.f90 index ef9e591..796925c 100644 --- a/src/tests/WrapperFactoryList_I2P_Test.f90 +++ b/src/tests/WrapperFactoryList_I2P_Test.f90 @@ -2,13 +2,12 @@ program WrapperFactoryList_I2P_Test USE iso_fortran_env, only: OUTPUT_UNIT USE IR_Precision, only: I2P -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper implicit none -type(WrapperFactoryList_t) :: factorylist class(WrapperFactory_t), pointer :: factory class(DimensionsWrapper_t), allocatable :: wrapper integer(I2P) :: val0D = 9 @@ -21,51 +20,51 @@ program WrapperFactoryList_I2P_Test integer(I2P) :: val7D(1,1,1,1,1,1,1) = 9 -call factorylist%Init() -call factorylist%Print(unit=OUTPUT_UNIT) +call TheWrapperFactoryList_Init() +call TheWrapperFactoryList%Print(unit=OUTPUT_UNIT) -factory => factorylist%GetFactory(Value=val0D) +factory => TheWrapperFactoryList%GetFactory(Value=val0D) if(associated(factory)) call factory%Wrap(Value=val0D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val1D) +factory => TheWrapperFactoryList%GetFactory(Value=val1D) if(associated(factory)) call factory%Wrap(Value=val1D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val2D) +factory => TheWrapperFactoryList%GetFactory(Value=val2D) if(associated(factory)) call factory%Wrap(Value=val2D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val3D) +factory => TheWrapperFactoryList%GetFactory(Value=val3D) if(associated(factory)) call factory%Wrap(Value=val3D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val4D) +factory => TheWrapperFactoryList%GetFactory(Value=val4D) if(associated(factory)) call factory%Wrap(Value=val4D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val5D) +factory => TheWrapperFactoryList%GetFactory(Value=val5D) if(associated(factory)) call factory%Wrap(Value=val5D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val6D) +factory => TheWrapperFactoryList%GetFactory(Value=val6D) if(associated(factory)) call factory%Wrap(Value=val6D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val7D) +factory => TheWrapperFactoryList%GetFactory(Value=val7D) if(associated(factory)) call factory%Wrap(Value=val7D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) call wrapper%Free() -call factorylist%Free() +call TheWrapperFactoryList%Free() nullify(factory) if(allocated(wrapper)) deallocate(wrapper) diff --git a/src/tests/WrapperFactoryList_I4P_Test.f90 b/src/tests/WrapperFactoryList_I4P_Test.f90 index 7dccdb3..3b29421 100644 --- a/src/tests/WrapperFactoryList_I4P_Test.f90 +++ b/src/tests/WrapperFactoryList_I4P_Test.f90 @@ -2,13 +2,12 @@ program WrapperFactoryList_I4P_Test USE iso_fortran_env, only: OUTPUT_UNIT USE IR_Precision, only: I4P -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper implicit none -type(WrapperFactoryList_t) :: factorylist class(WrapperFactory_t), pointer :: factory class(DimensionsWrapper_t), allocatable :: wrapper integer(I4P) :: val0D = 9 @@ -22,51 +21,51 @@ program WrapperFactoryList_I4P_Test integer :: i -call factorylist%Init() -call factorylist%Print(unit=OUTPUT_UNIT) +call TheWrapperFactoryList_Init() +call TheWrapperFactoryList%Print(unit=OUTPUT_UNIT) -factory => factorylist%GetFactory(Value=val0D) +factory => TheWrapperFactoryList%GetFactory(Value=val0D) if(associated(factory)) call factory%Wrap(Value=val0D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val1D) +factory => TheWrapperFactoryList%GetFactory(Value=val1D) if(associated(factory)) call factory%Wrap(Value=val1D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val2D) +factory => TheWrapperFactoryList%GetFactory(Value=val2D) if(associated(factory)) call factory%Wrap(Value=val2D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val3D) +factory => TheWrapperFactoryList%GetFactory(Value=val3D) if(associated(factory)) call factory%Wrap(Value=val3D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val4D) +factory => TheWrapperFactoryList%GetFactory(Value=val4D) if(associated(factory)) call factory%Wrap(Value=val4D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val5D) +factory => TheWrapperFactoryList%GetFactory(Value=val5D) if(associated(factory)) call factory%Wrap(Value=val5D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val6D) +factory => TheWrapperFactoryList%GetFactory(Value=val6D) if(associated(factory)) call factory%Wrap(Value=val6D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val7D) +factory => TheWrapperFactoryList%GetFactory(Value=val7D) if(associated(factory)) call factory%Wrap(Value=val7D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) call wrapper%Free() -call factorylist%Free() +call TheWrapperFactoryList%Free() nullify(factory) if(allocated(wrapper)) deallocate(wrapper) diff --git a/src/tests/WrapperFactoryList_I8P_Test.f90 b/src/tests/WrapperFactoryList_I8P_Test.f90 index 74fa9be..b0c8fc5 100644 --- a/src/tests/WrapperFactoryList_I8P_Test.f90 +++ b/src/tests/WrapperFactoryList_I8P_Test.f90 @@ -2,13 +2,12 @@ program WrapperFactoryList_I8P_Test USE iso_fortran_env, only: OUTPUT_UNIT USE IR_Precision, only: I8P -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper implicit none -type(WrapperFactoryList_t) :: factorylist class(WrapperFactory_t), pointer :: factory class(DimensionsWrapper_t), allocatable :: wrapper integer(I8P) :: val0D = 9 @@ -21,51 +20,51 @@ program WrapperFactoryList_I8P_Test integer(I8P) :: val7D(1,1,1,1,1,1,1) = 9 -call factorylist%Init() -call factorylist%Print(unit=OUTPUT_UNIT) +call TheWrapperFactoryList_Init() +call TheWrapperFactoryList%Print(unit=OUTPUT_UNIT) -factory => factorylist%GetFactory(Value=val0D) +factory => TheWrapperFactoryList%GetFactory(Value=val0D) if(associated(factory)) call factory%Wrap(Value=val0D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val1D) +factory => TheWrapperFactoryList%GetFactory(Value=val1D) if(associated(factory)) call factory%Wrap(Value=val1D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val2D) +factory => TheWrapperFactoryList%GetFactory(Value=val2D) if(associated(factory)) call factory%Wrap(Value=val2D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val3D) +factory => TheWrapperFactoryList%GetFactory(Value=val3D) if(associated(factory)) call factory%Wrap(Value=val3D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val4D) +factory => TheWrapperFactoryList%GetFactory(Value=val4D) if(associated(factory)) call factory%Wrap(Value=val4D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val5D) +factory => TheWrapperFactoryList%GetFactory(Value=val5D) if(associated(factory)) call factory%Wrap(Value=val5D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val6D) +factory => TheWrapperFactoryList%GetFactory(Value=val6D) if(associated(factory)) call factory%Wrap(Value=val6D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val7D) +factory => TheWrapperFactoryList%GetFactory(Value=val7D) if(associated(factory)) call factory%Wrap(Value=val7D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) call wrapper%Free() -call factorylist%Free() +call TheWrapperFactoryList%Free() nullify(factory) if(allocated(wrapper)) deallocate(wrapper) diff --git a/src/tests/WrapperFactoryList_L_Test.f90 b/src/tests/WrapperFactoryList_L_Test.f90 index b749f63..27b2a6d 100644 --- a/src/tests/WrapperFactoryList_L_Test.f90 +++ b/src/tests/WrapperFactoryList_L_Test.f90 @@ -1,13 +1,12 @@ program WrapperFactoryList_Test USE iso_fortran_env, only: OUTPUT_UNIT -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper implicit none -type(WrapperFactoryList_t) :: factorylist class(WrapperFactory_t), pointer :: factory class(DimensionsWrapper_t), allocatable :: wrapper logical :: val0D = .true. @@ -20,51 +19,51 @@ program WrapperFactoryList_Test logical :: val7D(1,1,1,1,1,1,1) = .true. -call factorylist%Init() -call factorylist%Print(unit=OUTPUT_UNIT) +call TheWrapperFactoryList_Init() +call TheWrapperFactoryList%Print(unit=OUTPUT_UNIT) -factory => factorylist%GetFactory(Value=val0D) +factory => TheWrapperFactoryList%GetFactory(Value=val0D) if(associated(factory)) call factory%Wrap(Value=val0D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val1D) +factory => TheWrapperFactoryList%GetFactory(Value=val1D) if(associated(factory)) call factory%Wrap(Value=val1D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val2D) +factory => TheWrapperFactoryList%GetFactory(Value=val2D) if(associated(factory)) call factory%Wrap(Value=val2D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val3D) +factory => TheWrapperFactoryList%GetFactory(Value=val3D) if(associated(factory)) call factory%Wrap(Value=val3D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val4D) +factory => TheWrapperFactoryList%GetFactory(Value=val4D) if(associated(factory)) call factory%Wrap(Value=val4D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val5D) +factory => TheWrapperFactoryList%GetFactory(Value=val5D) if(associated(factory)) call factory%Wrap(Value=val5D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val6D) +factory => TheWrapperFactoryList%GetFactory(Value=val6D) if(associated(factory)) call factory%Wrap(Value=val6D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val7D) +factory => TheWrapperFactoryList%GetFactory(Value=val7D) if(associated(factory)) call factory%Wrap(Value=val7D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) call wrapper%Free() -call factorylist%Free() +call TheWrapperFactoryList%Free() nullify(factory) if(allocated(wrapper)) deallocate(wrapper) diff --git a/src/tests/WrapperFactoryList_R4P_Test.f90 b/src/tests/WrapperFactoryList_R4P_Test.f90 index 49f068c..6b4db7d 100644 --- a/src/tests/WrapperFactoryList_R4P_Test.f90 +++ b/src/tests/WrapperFactoryList_R4P_Test.f90 @@ -2,13 +2,12 @@ program WrapperFactoryList_R4P_Test USE iso_fortran_env, only: OUTPUT_UNIT USE IR_Precision, only: R4P -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper implicit none -type(WrapperFactoryList_t) :: factorylist class(WrapperFactory_t), pointer :: factory class(DimensionsWrapper_t), allocatable :: wrapper real(R4P) :: val0D = 9 @@ -21,51 +20,51 @@ program WrapperFactoryList_R4P_Test real(R4P) :: val7D(1,1,1,1,1,1,1) = 9 -call factorylist%Init() -call factorylist%Print(unit=OUTPUT_UNIT) +call TheWrapperFactoryList_Init() +call TheWrapperFactoryList%Print(unit=OUTPUT_UNIT) -factory => factorylist%GetFactory(Value=val0D) +factory => TheWrapperFactoryList%GetFactory(Value=val0D) if(associated(factory)) call factory%Wrap(Value=val0D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val1D) +factory => TheWrapperFactoryList%GetFactory(Value=val1D) if(associated(factory)) call factory%Wrap(Value=val1D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val2D) +factory => TheWrapperFactoryList%GetFactory(Value=val2D) if(associated(factory)) call factory%Wrap(Value=val2D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val3D) +factory => TheWrapperFactoryList%GetFactory(Value=val3D) if(associated(factory)) call factory%Wrap(Value=val3D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val4D) +factory => TheWrapperFactoryList%GetFactory(Value=val4D) if(associated(factory)) call factory%Wrap(Value=val4D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val5D) +factory => TheWrapperFactoryList%GetFactory(Value=val5D) if(associated(factory)) call factory%Wrap(Value=val5D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val6D) +factory => TheWrapperFactoryList%GetFactory(Value=val6D) if(associated(factory)) call factory%Wrap(Value=val6D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val7D) +factory => TheWrapperFactoryList%GetFactory(Value=val7D) if(associated(factory)) call factory%Wrap(Value=val7D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) call wrapper%Free() -call factorylist%Free() +call TheWrapperFactoryList%Free() nullify(factory) if(allocated(wrapper)) deallocate(wrapper) diff --git a/src/tests/WrapperFactoryList_R8P_Test.f90 b/src/tests/WrapperFactoryList_R8P_Test.f90 index 7d23859..2f1c4e6 100644 --- a/src/tests/WrapperFactoryList_R8P_Test.f90 +++ b/src/tests/WrapperFactoryList_R8P_Test.f90 @@ -2,13 +2,12 @@ program WrapperFactoryList_R8P_Test USE iso_fortran_env, only: OUTPUT_UNIT USE IR_Precision, only: R8P -USE WrapperFactoryList +USE WrapperFactoryListSingleton USE WrapperFactory USE DimensionsWrapper implicit none -type(WrapperFactoryList_t) :: factorylist class(WrapperFactory_t), pointer :: factory class(DimensionsWrapper_t), allocatable :: wrapper real(R8P) :: val0D = 9 @@ -21,51 +20,51 @@ program WrapperFactoryList_R8P_Test real(R8P) :: val7D(1,1,1,1,1,1,1) = 9 -call factorylist%Init() -call factorylist%Print(unit=OUTPUT_UNIT) +call TheWrapperFactoryList_Init() +call TheWrapperFactoryList%Print(unit=OUTPUT_UNIT) -factory => factorylist%GetFactory(Value=val0D) +factory => TheWrapperFactoryList%GetFactory(Value=val0D) if(associated(factory)) call factory%Wrap(Value=val0D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val1D) +factory => TheWrapperFactoryList%GetFactory(Value=val1D) if(associated(factory)) call factory%Wrap(Value=val1D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val2D) +factory => TheWrapperFactoryList%GetFactory(Value=val2D) if(associated(factory)) call factory%Wrap(Value=val2D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val3D) +factory => TheWrapperFactoryList%GetFactory(Value=val3D) if(associated(factory)) call factory%Wrap(Value=val3D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val4D) +factory => TheWrapperFactoryList%GetFactory(Value=val4D) if(associated(factory)) call factory%Wrap(Value=val4D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val5D) +factory => TheWrapperFactoryList%GetFactory(Value=val5D) if(associated(factory)) call factory%Wrap(Value=val5D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val6D) +factory => TheWrapperFactoryList%GetFactory(Value=val6D) if(associated(factory)) call factory%Wrap(Value=val6D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) -factory => factorylist%GetFactory(Value=val7D) +factory => TheWrapperFactoryList%GetFactory(Value=val7D) if(associated(factory)) call factory%Wrap(Value=val7D, Wrapper=wrapper) if(allocated(wrapper)) call Wrapper%Print(unit=OUTPUT_UNIT) nullify(factory) call wrapper%Free() -call factorylist%Free() +call TheWrapperFactoryList%Free() nullify(factory) if(allocated(wrapper)) deallocate(wrapper)