Skip to content

Commit

Permalink
Add unit test for optional arguments, "optargs" (CICE-Consortium#730)
Browse files Browse the repository at this point in the history 
* Add optargs "optional arguments" unit test.  This tests the ability
to pass optional arguments down the calling tree robustly whether they are
present or not.

* Add test to count optional arguments at 2nd level
  • Loading branch information
@apcraig @dabail10
apcraig authored and dabail10 committed Oct 4, 2022
1 parent df3efd7 commit 64188ed
Show file tree
Hide file tree
Showing 5 changed files with 403 additions and 2 deletions.
246 changes: 246 additions & 0 deletions cicecore/drivers/unittest/optargs/optargs.F90
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,246 @@

program optargs

use optargs_subs, only: computeA, computeB, computeC, computeD
use optargs_subs, only: oa_error, oa_OK, oa_A, oa_B, oa_C, oa_D
use optargs_subs, only: oa_layer1, oa_count1

implicit none

real*8 :: Ai1, Ao
real*8 :: B
real*8 :: Ci1, Co
real*8 :: Di1, Di2, Do
integer :: ierr, ierrV

integer :: n
integer, parameter :: ntests = 100
integer :: iresult
real*8 :: result, resultV
real*8, parameter :: errtol = 1.0e-12

!----------------------

write(6,*) 'RunningUnitTest optargs'
write(6,*) ' '

iresult = 0
do n = 1,ntests

Ai1 = -99.; Ao = -99.
B = -99.
Ci1 = -99.; Co = -99.
Di1 = -99.; Di2 = -99.; Do = -99.

ierr = oa_error
result = -888.
resultV = -999.

computeA = .false.
computeB = .false.
computeC = .false.
computeD = .false.

select case (n)

! fails to compile as it should
! case(0)
! ierrV = oa_OK
! call oa_layer1()

! test counts of present optional arguments at 2nd level
! result should be number of arguments
case(1)
result = -777.; resultV = -777.
ierrV = 9
call oa_count1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
case(2)
result = -777.; resultV = -777.
ierrV = 9
call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
case(3)
result = -777.; resultV = -777.
ierrV = 3
call oa_count1(Ci1=Ci1,Co=Co,ierr=ierr)
case(4)
result = -777.; resultV = -777.
ierrV = 5
call oa_count1(Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1)

! test optional order
case(11)
result = -777.; resultV = -777.
ierrV = oa_OK
call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
case(12)
result = -777.; resultV = -777.
ierrV = oa_OK
call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr)
case(13)
result = -777.; resultV = -777.
ierrV = oa_OK
call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1)

! test optional argument checking
case(21)
computeA = .true.
computeB = .true.
computeC = .true.
computeD = .true.
result = -777.; resultV = -777.
ierrV = oa_error
! B missing
call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
case(22)
computeA = .true.
computeB = .true.
computeC = .true.
computeD = .true.
result = -777.; resultV = -777.
ierrV = oa_error
! all optional missing
call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr)
case(23)
computeA = .true.
computeB = .true.
computeC = .true.
computeD = .true.
result = -777.; resultV = -777.
ierrV = oa_error
! some optional missing
call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,B=B,Ao=Ao,Di1=Di1)
case(24)
computeA = .true.
computeB = .true.
computeC = .true.
computeD = .true.
result = -777.; resultV = -777.
ierrV = oa_error
! one optional missing
call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Do=Do,ierr=ierr)

! test computations individually
case(31)
computeA = .true.
ierrV = oa_A
Ai1 = 5.
resultV = 4.
call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
result = Ao
case(32)
computeB = .true.
ierrV = oa_B
B = 15.
resultV = 20.
call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do)
result = B
case(33)
computeC = .true.
ierrV = oa_C
Ci1 = 7.
resultV = 14.
call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr)
result = Co
case(34)
computeD = .true.
ierrV = oa_D
Di1 = 19; Di2=11.
resultV = 30.
call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr)
result = Do

! test computations individually
case(41)
computeA = .true.
computeC = .true.
ierrV = oa_A + oa_C
Ai1 = 6.
Ci1 = 8.
resultV = 21.
call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
result = Ao + Co
case(42)
computeB = .true.
computeC = .true.
ierrV = oa_B + oa_C
B = -20.
Ci1 = 2.
resultV = -11.
call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do)
result = B + Co
case(43)
computeB = .true.
computeD = .true.
ierrV = oa_B + oa_D
B = 4.
Di1 = 3; Di2=19.
resultV = 31.
call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr)
result = B + Do
case(44)
computeC = .true.
computeD = .true.
ierrV = oa_C + oa_D
Ci1 = 7.
Di1 = 6; Di2=7.
resultV = 27.
call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr)
result = Co + Do
case(45)
computeA = .true.
computeB = .true.
computeC = .true.
computeD = .true.
ierrV = oa_A + oa_B + oa_C + oa_D
Ai1 = 7.
B = 9.
Ci1 = 7.
Di1 = 12; Di2=3.
resultV = 49.
call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,ierr=ierr)
result = Ao + B + Co + Do
case(46)
computeA = .true.
computeB = .true.
computeD = .true.
ierrV = oa_A + oa_B + oa_D
Ai1 = 10.
B = 11.
Di1 = 12; Di2=3.
resultV = 40.
call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,ierr=ierr)
result = Ao + B + Do

case DEFAULT
ierr = -1234

end select

! skip -1234
if (ierr /= -1234) then
if (ierr == ierrV .and. abs(result-resultV) < errtol ) then
write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do
! write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV
else
write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do
! write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV
iresult = 1
endif
endif

enddo

101 format(1x,a,1x,a,1x,i2.2,2i6,3x,6g11.4)

write(6,*) ' '
write(6,*) 'optargs COMPLETED SUCCESSFULLY'
if (iresult == 1) then
write(6,*) 'optargs TEST FAILED'
else
write(6,*) 'optargs TEST COMPLETED SUCCESSFULLY'
endif

!----------------------

end program

148 changes: 148 additions & 0 deletions cicecore/drivers/unittest/optargs/optargs_subs.F90
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,148 @@

module optargs_subs

implicit none
private

logical, public :: computeA = .false., &
computeB = .false., &
computeC = .false., &
computeD = .false.

integer, public :: oa_error = -99, &
oa_OK = 0, &
oa_A = 1, &
oa_B = 2, &
oa_C = 4, &
oa_D = 8

public :: oa_layer1, oa_count1

!-----------------------------------
CONTAINS
!-----------------------------------

subroutine oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)

real*8 , intent(in) , optional :: Ai1, Di1, Di2
real*8 , intent(out) , optional :: Ao, Do
real*8 , intent(inout), optional :: B
real*8 , intent(in) :: Ci1
real*8 , intent(out) :: Co
integer, intent(inout) :: ierr

call oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)

! write(6,*) 'debug oa_count1 ',ierr

end subroutine oa_count1

!-----------------------------------

subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)

real*8 , intent(in) , optional :: Ai1, Di1, Di2
real*8 , intent(out) , optional :: Ao, Do
real*8 , intent(inout), optional :: B
real*8 , intent(in) :: Ci1
real*8 , intent(out) :: Co
integer, intent(inout) :: ierr

ierr = 3 ! Ci1, Co, ierr have to be passed
if (present(Ai1)) ierr = ierr + 1
if (present(Ao) ) ierr = ierr + 1
if (present(B) ) ierr = ierr + 1
if (present(Di1)) ierr = ierr + 1
if (present(Di2)) ierr = ierr + 1
if (present(Do) ) ierr = ierr + 1

! write(6,*) 'debug oa_count2 ',ierr

end subroutine oa_count2

!-----------------------------------

subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)

real*8 , intent(in) , optional :: Ai1, Di1, Di2
real*8 , intent(out) , optional :: Ao, Do
real*8 , intent(inout), optional :: B
real*8 , intent(in) :: Ci1
real*8 , intent(out) :: Co
integer, intent(inout) :: ierr

ierr = oa_OK
if (computeA) then
if (.not.(present(Ai1).and.present(Ao))) then
ierr = oa_error
endif
endif
if (computeB) then
if (.not.(present(B))) then
ierr = oa_error
endif
endif
if (computeD) then
if (.not.(present(Di1).and.present(Di2).and.present(Do))) then
ierr = oa_error
endif
endif

if (ierr == oa_OK) then
call oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
endif

end subroutine oa_layer1

!-----------------------------------

subroutine oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)

real*8 , intent(in) , optional :: Ai1, Di1, Di2
real*8 , intent(out) , optional :: Ao, Do
real*8 , intent(inout), optional :: B
real*8 , intent(in) :: Ci1
real*8 , intent(out) :: Co
integer, intent(inout) :: ierr

call oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)

end subroutine oa_layer2

!-----------------------------------

subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)

real*8 , intent(in) , optional :: Ai1, Di1, Di2
real*8 , intent(out) , optional :: Ao, Do
real*8 , intent(inout), optional :: B
real*8 , intent(in) :: Ci1
real*8 , intent(out) :: Co
integer, intent(inout) :: ierr

if (computeA) then
Ao = Ai1 - 1.
ierr = ierr + oa_A
endif

if (computeB) then
B = B + 5.
ierr = ierr + oa_B
endif

if (computeC) then
Co = Ci1 * (2.)
ierr = ierr + oa_C
endif

if (computeD) then
Do = Di1 + Di2
ierr = ierr + oa_D
endif

return
end subroutine oa_compute

!-----------------------------------

end module optargs_subs
Loading

0 comments on commit 64188ed

Please sign in to comment.