From 6c2cf0ccad14d097c70d99c0998d1ad4c66ba196 Mon Sep 17 00:00:00 2001 From: Stefano Zaghi Date: Tue, 25 Oct 2016 14:34:17 +0200 Subject: [PATCH] Fix bug #71 group default value for not invoked group Short description Querying the default values of CLAs belonging to not invoked group returns unpredictable results instead of the default value set initializing the CLI. Why: Sane fallback. This change addresses the need by: Eliminating the check if the group has been invoked or not. Side effects: Nothing, but a warning could be like to be added in the case a not invoked group is queried. --- .gitmodules | 4 + fobos | 2 +- src/lib/flap_command_line_interface_t.F90 | 5 +- src/tests/test_group.f90 | 103 ++++++++++++++++++++++ src/third_party/fortran_tester | 1 + 5 files changed, 113 insertions(+), 2 deletions(-) create mode 100644 src/tests/test_group.f90 create mode 160000 src/third_party/fortran_tester diff --git a/.gitmodules b/.gitmodules index b684f617..9bc0bedd 100644 --- a/.gitmodules +++ b/.gitmodules @@ -2,3 +2,7 @@ path = src/third_party/PENF url = https://github.com/szaghi/PENF branch = master +[submodule "src/third_party/fortran_tester"] + path = src/third_party/fortran_tester + url = https://github.com/pdebuyl/fortran_tester + branch = master diff --git a/fobos b/fobos index e5dfea88..81fb0694 100644 --- a/fobos +++ b/fobos @@ -13,7 +13,7 @@ $CSTATIC_INT = -cpp -c -assume realloc_lhs $DEBUG_GNU = -O0 -g3 -Warray-bounds -Wcharacter-truncation -Wline-truncation -Wimplicit-interface -Wimplicit-procedure -Wunderflow -fcheck=all -fmodule-private -ffree-line-length-132 -fimplicit-none -fbacktrace -fdump-core -finit-real=nan -std=f2008 -fall-intrinsics $DEBUG_INT = -O0 -debug all -check all -warn all -extend-source 132 -traceback -gen-interfaces#-fpe-all=0 -fp-stack-check -fstack-protector-all -ftrapuv -no-ftz -std08 $OPTIMIZE = -O2 -$EXDIRS = ./src/third_party/PENF/src/tests/ +$EXDIRS = ./src/third_party/fortran_tester/test/ ./src/third_party/PENF/src/tests/ # main modes # GNU diff --git a/src/lib/flap_command_line_interface_t.F90 b/src/lib/flap_command_line_interface_t.F90 index 6203a699..834a52d8 100644 --- a/src/lib/flap_command_line_interface_t.F90 +++ b/src/lib/flap_command_line_interface_t.F90 @@ -845,7 +845,7 @@ subroutine get_cla(self, val, pref, args, group, switch, position, error) else g = 0 endif - if (self%error==0.and.self%clasg(g)%is_called) then + if (self%error==0) then if (present(switch)) then ! search for the CLA corresponding to switch found = .false. @@ -868,6 +868,9 @@ subroutine get_cla(self, val, pref, args, group, switch, position, error) call self%errored(pref=pref, error=ERROR_MISSING_SELECTION_CLA) endif endif + if (self%error==0.and.(.not.self%clasg(g)%is_called)) then + ! TODO warn (if liked) for non invoked group querying + endif if (present(error)) error = self%error return !--------------------------------------------------------------------------------------------------------------------------------- diff --git a/src/tests/test_group.f90 b/src/tests/test_group.f90 new file mode 100644 index 00000000..c8d5cb92 --- /dev/null +++ b/src/tests/test_group.f90 @@ -0,0 +1,103 @@ +!< A testing program for FLAP, Fortran command Line Arguments Parser for poor people +program test_group +!< A testing program for FLAP, Fortran command Line Arguments Parser for poor people +!< +!<### Compile +!< See [compile instructions](https://github.com/szaghi/FLAP/wiki/Download-compile). +!< +!<###Usage Compile +!< See [usage instructions](https://github.com/szaghi/FLAP/wiki/Testing-Programs). +!----------------------------------------------------------------------------------------------------------------------------------- +use flap, only : command_line_interface +use penf +use tester +!----------------------------------------------------------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------------------------------------------------------- +implicit none +type(tester_t) :: crash_test_dummy !< Tests handler. +logical :: switch_value_domain !< Switch sentinel. +logical :: switch_value_grid !< Switch sentinel. +logical :: switch_value_spectrum !< Switch sentinel. +!----------------------------------------------------------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------------------------------------------------------- +call crash_test_dummy%init + +call fake_call(args='', spectrum=switch_value_spectrum, domain=switch_value_domain, grid=switch_value_grid) +print*, 'test_group' +print*, 'spectrum = ', switch_value_spectrum +print*, 'domain = ', switch_value_domain +print*, 'grid = ', switch_value_grid +call crash_test_dummy%assert_equal(switch_value_spectrum, .false.) +call crash_test_dummy%assert_equal(switch_value_domain, .false.) +call crash_test_dummy%assert_equal(switch_value_grid , .false.) + +call fake_call(args='new -s', spectrum=switch_value_spectrum, domain=switch_value_domain, grid=switch_value_grid) +print*, 'test_group new -s' +print*, 'spectrum = ', switch_value_spectrum +print*, 'domain = ', switch_value_domain +print*, 'grid = ', switch_value_grid +call crash_test_dummy%assert_equal(switch_value_spectrum, .true.) +call crash_test_dummy%assert_equal(switch_value_domain, .false.) +call crash_test_dummy%assert_equal(switch_value_grid , .false.) + +call fake_call(args='new -d', spectrum=switch_value_spectrum, domain=switch_value_domain, grid=switch_value_grid) +print*, 'test_group new -d' +print*, 'spectrum = ', switch_value_spectrum +print*, 'domain = ', switch_value_domain +print*, 'grid = ', switch_value_grid +call crash_test_dummy%assert_equal(switch_value_spectrum, .false.) +call crash_test_dummy%assert_equal(switch_value_domain, .true.) +call crash_test_dummy%assert_equal(switch_value_grid , .false.) + +call fake_call(args='new -g', spectrum=switch_value_spectrum, domain=switch_value_domain, grid=switch_value_grid) +print*, 'test_group new -g' +print*, 'spectrum = ', switch_value_spectrum +print*, 'domain = ', switch_value_domain +print*, 'grid = ', switch_value_grid +call crash_test_dummy%assert_equal(switch_value_spectrum, .false.) +call crash_test_dummy%assert_equal(switch_value_domain, .false.) +call crash_test_dummy%assert_equal(switch_value_grid , .true.) + +call crash_test_dummy%print +!----------------------------------------------------------------------------------------------------------------------------------- +contains + subroutine fake_call(args, spectrum, domain, grid) + !--------------------------------------------------------------------------------------------------------------------------------- + !< Wrapper for fake calls. + !--------------------------------------------------------------------------------------------------------------------------------- + character(*), intent(in) :: args !< Fake arguments. + logical, intent(out) :: spectrum !< Spectrum value. + logical, intent(out) :: domain !< Domain value. + logical, intent(out) :: grid !< Grid value. + type(command_line_interface) :: cli !< Command Line Interface (CLI). + integer(I4P) :: error !< Error trapping flag. + !--------------------------------------------------------------------------------------------------------------------------------- + + !--------------------------------------------------------------------------------------------------------------------------------- + call cli%init + call cli%add_group(group='new', description='create new instance') + call cli%add(group='new', switch='--spectrum', switch_ab='-s', & + help='Create new spectrum', required=.false., def='.false.', & + act='store_true', error=error) + if (error/=0) stop + call cli%add(group='new', switch='--domain', switch_ab='-d', & + help='Create new domain', required=.false., def='.false.', & + act='store_true', error=error) + if (error/=0) stop + call cli%add(group='new', switch='--grid', switch_ab='-g', & + help='Create new grid', required=.false., def='.false.', & + act='store_true', error=error) + if (error/=0) stop + call cli%parse(args=args, error=error) + if (error/=0) stop + call cli%get(group='new', switch='--spectrum', val=spectrum, error=error) + if (error/=0) stop + call cli%get(group='new', switch='--domain', val=domain, error=error) + if (error/=0) stop + call cli%get(group='new', switch='--grid', val=grid, error=error) + if (error/=0) stop + !--------------------------------------------------------------------------------------------------------------------------------- + endsubroutine fake_call +endprogram test_group diff --git a/src/third_party/fortran_tester b/src/third_party/fortran_tester new file mode 160000 index 00000000..fd607cb7 --- /dev/null +++ b/src/third_party/fortran_tester @@ -0,0 +1 @@ +Subproject commit fd607cb7c35db2bc8a67673aada276c61cc0b1be