From 64188edd8109a6debb30faa4e26d11978b6c14a0 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 15 Jul 2022 07:43:12 -0700 Subject: [PATCH] Add unit test for optional arguments, "optargs" (#730) * 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 --- cicecore/drivers/unittest/optargs/optargs.F90 | 246 ++++++++++++++++++ .../drivers/unittest/optargs/optargs_subs.F90 | 148 +++++++++++ configuration/scripts/Makefile | 8 +- configuration/scripts/options/set_env.optargs | 2 + configuration/scripts/tests/unittest_suite.ts | 1 + 5 files changed, 403 insertions(+), 2 deletions(-) create mode 100644 cicecore/drivers/unittest/optargs/optargs.F90 create mode 100644 cicecore/drivers/unittest/optargs/optargs_subs.F90 create mode 100644 configuration/scripts/options/set_env.optargs diff --git a/cicecore/drivers/unittest/optargs/optargs.F90 b/cicecore/drivers/unittest/optargs/optargs.F90 new file mode 100644 index 000000000..14c738d47 --- /dev/null +++ b/cicecore/drivers/unittest/optargs/optargs.F90 @@ -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 + diff --git a/cicecore/drivers/unittest/optargs/optargs_subs.F90 b/cicecore/drivers/unittest/optargs/optargs_subs.F90 new file mode 100644 index 000000000..7469d6800 --- /dev/null +++ b/cicecore/drivers/unittest/optargs/optargs_subs.F90 @@ -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 diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index 0322513d2..a2f17256f 100644 --- a/configuration/scripts/Makefile +++ b/configuration/scripts/Makefile @@ -74,7 +74,7 @@ AR := ar .SUFFIXES: -.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk sumchk bcstchk gridavgchk +.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk sumchk bcstchk gridavgchk optargs all: $(EXEC) cice: $(EXEC) @@ -93,7 +93,7 @@ targets: @echo " " @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean" @echo " Diagnostics: targets, db_files, db_flags" - @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk" + @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk, optargs" target: targets db_files: @@ -157,6 +157,10 @@ HWOBJS := helloworld.o helloworld: $(HWOBJS) $(LD) -o $(EXEC) $(LDFLAGS) $(HWOBJS) $(ULIBS) $(SLIBS) +OAOBJS := optargs.o optargs_subs.o +optargs: $(OAOBJS) + $(LD) -o $(EXEC) $(LDFLAGS) $(OAOBJS) $(ULIBS) $(SLIBS) + #------------------------------------------------------------------------------- # build rules: MACFILE, cmd-line, or env vars must provide the needed macros #------------------------------------------------------------------------------- diff --git a/configuration/scripts/options/set_env.optargs b/configuration/scripts/options/set_env.optargs new file mode 100644 index 000000000..84d48137f --- /dev/null +++ b/configuration/scripts/options/set_env.optargs @@ -0,0 +1,2 @@ +setenv ICE_DRVOPT unittest/optargs +setenv ICE_TARGET optargs diff --git a/configuration/scripts/tests/unittest_suite.ts b/configuration/scripts/tests/unittest_suite.ts index 76c9f4312..319c91aa6 100644 --- a/configuration/scripts/tests/unittest_suite.ts +++ b/configuration/scripts/tests/unittest_suite.ts @@ -1,5 +1,6 @@ # Test Grid PEs Sets BFB-compare unittest gx3 1x1 helloworld +unittest gx3 1x1 optargs unittest gx3 1x1 calchk,short unittest gx3 4x1x25x29x4 sumchk unittest gx3 1x1x25x29x16 sumchk