From 658ebdc4808a32741ff8aaf672eb154d99de9b6b Mon Sep 17 00:00:00 2001 From: apcraig Date: Wed, 13 Jul 2022 09:43:05 -0600 Subject: [PATCH 1/2] 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. --- cicecore/drivers/unittest/optargs/optargs.F90 | 227 ++++++++++++++++++ .../drivers/unittest/optargs/optargs_subs.F90 | 108 +++++++++ configuration/scripts/Makefile | 8 +- configuration/scripts/options/set_env.optargs | 2 + configuration/scripts/tests/unittest_suite.ts | 1 + 5 files changed, 344 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..af7dc7103 --- /dev/null +++ b/cicecore/drivers/unittest/optargs/optargs.F90 @@ -0,0 +1,227 @@ + + 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 + + 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 optional order + case(1) + 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(2) + result = -777.; resultV = -777. + ierrV = oa_OK + call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr) + case(3) + 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(4) + 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(5) + 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(6) + 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(7) + 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(11) + 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(12) + 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(13) + 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(14) + 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(21) + 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(22) + 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(23) + 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(24) + 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(25) + 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(26) + 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..907cfb60f --- /dev/null +++ b/cicecore/drivers/unittest/optargs/optargs_subs.F90 @@ -0,0 +1,108 @@ + + 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 + +!----------------------------------- +CONTAINS +!----------------------------------- + + 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 From 7d89041e5381de5239ac8ee9ab47465c1f810f1e Mon Sep 17 00:00:00 2001 From: apcraig Date: Wed, 13 Jul 2022 10:03:47 -0600 Subject: [PATCH 2/2] Add test to count optional arguments at 2nd level --- cicecore/drivers/unittest/optargs/optargs.F90 | 55 +++++++++++++------ .../drivers/unittest/optargs/optargs_subs.F90 | 42 +++++++++++++- 2 files changed, 78 insertions(+), 19 deletions(-) diff --git a/cicecore/drivers/unittest/optargs/optargs.F90 b/cicecore/drivers/unittest/optargs/optargs.F90 index af7dc7103..14c738d47 100644 --- a/cicecore/drivers/unittest/optargs/optargs.F90 +++ b/cicecore/drivers/unittest/optargs/optargs.F90 @@ -3,7 +3,7 @@ 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 + use optargs_subs, only: oa_layer1, oa_count1 implicit none @@ -48,22 +48,41 @@ program optargs ! ierrV = oa_OK ! call oa_layer1() - ! test optional order + ! 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(2) + case(12) result = -777.; resultV = -777. ierrV = oa_OK call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr) - case(3) + 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(4) + case(21) computeA = .true. computeB = .true. computeC = .true. @@ -72,7 +91,7 @@ program optargs 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(5) + case(22) computeA = .true. computeB = .true. computeC = .true. @@ -81,7 +100,7 @@ program optargs ierrV = oa_error ! all optional missing call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr) - case(6) + case(23) computeA = .true. computeB = .true. computeC = .true. @@ -90,7 +109,7 @@ program optargs ierrV = oa_error ! some optional missing call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,B=B,Ao=Ao,Di1=Di1) - case(7) + case(24) computeA = .true. computeB = .true. computeC = .true. @@ -101,28 +120,28 @@ program optargs call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Do=Do,ierr=ierr) ! test computations individually - case(11) + 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(12) + 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(13) + 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(14) + case(34) computeD = .true. ierrV = oa_D Di1 = 19; Di2=11. @@ -131,7 +150,7 @@ program optargs result = Do ! test computations individually - case(21) + case(41) computeA = .true. computeC = .true. ierrV = oa_A + oa_C @@ -140,7 +159,7 @@ program optargs 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(22) + case(42) computeB = .true. computeC = .true. ierrV = oa_B + oa_C @@ -149,7 +168,7 @@ program optargs 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(23) + case(43) computeB = .true. computeD = .true. ierrV = oa_B + oa_D @@ -158,7 +177,7 @@ program optargs 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(24) + case(44) computeC = .true. computeD = .true. ierrV = oa_C + oa_D @@ -167,7 +186,7 @@ program optargs 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(25) + case(45) computeA = .true. computeB = .true. computeC = .true. @@ -180,7 +199,7 @@ program optargs 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(26) + case(46) computeA = .true. computeB = .true. computeD = .true. diff --git a/cicecore/drivers/unittest/optargs/optargs_subs.F90 b/cicecore/drivers/unittest/optargs/optargs_subs.F90 index 907cfb60f..7469d6800 100644 --- a/cicecore/drivers/unittest/optargs/optargs_subs.F90 +++ b/cicecore/drivers/unittest/optargs/optargs_subs.F90 @@ -16,10 +16,50 @@ module optargs_subs oa_C = 4, & oa_D = 8 - public :: oa_layer1 + 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)