Skip to content

Added typed defaults, print_default/print_choices and tests #17

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
lukaswittmann wants to merge 7 commits into
base: main
Choose a base branch
from
Open

Added typed defaults, print_default/print_choices and tests #17

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
fe2376b
Added support for typed defaults, print_default/print_choices (print …
lukaswittmann Feb 13, 2026
55e5c5b
Fixed fpm bug
lukaswittmann Feb 13, 2026
8a35487
Update test/unit/main.f90
lukaswittmann Feb 13, 2026
79b612d
Update test/unit/main.f90
lukaswittmann Feb 13, 2026
72c31af
Added doc strings and formatting for very large numbers
lukaswittmann Feb 13, 2026
6568472
Removed sp conversion helpers
lukaswittmann Feb 14, 2026
50c5516
Fixed parser: prevent default leak after failed add_argument
lukaswittmann Feb 14, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion fpm.toml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,6 @@ test-drive.git = "https://github.com/fortran-lang/test-drive.git"

[install]
library = false
test = false

[fortran]
implicit-typing = false
Expand Down
2 changes: 2 additions & 0 deletions src/fclap.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@ module fclap
use fclap_actions, only: Action, not_less_than, not_bigger_than
use fclap_parser, only: ArgumentParser, ArgumentGroup, MutuallyExclusiveGroup, &
get_prog_name
use fclap_utils_accuracy, only: wp
use fclap_version, only: get_fclap_version, fclap_version_compact, &
fclap_version_string

Expand Down Expand Up @@ -117,5 +118,6 @@ module fclap
public :: get_fclap_version ! Get version components
public :: fclap_version_compact ! Compact version string
public :: fclap_version_string ! Full version string
public :: wp ! Working precision kind for reals

end module fclap
131 changes: 97 additions & 34 deletions src/fclap/fclap_actions.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,12 +86,16 @@ module fclap_actions
type(ValueContainer) :: default_value
!> Flag indicating whether a default value has been set
logical :: has_default = .false.
!> Whether default value should be shown in help text when set
logical :: print_default = .true.
!> Metavar for display in usage/help (e.g., "FILE" instead of "filename")
character(len=:), allocatable :: metavar
!> Array of valid choices that constrain acceptable values
character(len=MAX_ARG_LEN) :: choices(MAX_CHOICES)
!> Number of choices defined for this argument
integer :: num_choices = 0
!> Whether choices should be shown in help text
logical :: print_choices = .false.
!> Expected value type (TYPE_STRING, TYPE_INTEGER, TYPE_REAL, TYPE_LOGICAL)
integer :: value_type = TYPE_STRING
!> Whether this is a positional argument (vs optional/flag)
Expand Down Expand Up @@ -260,6 +264,19 @@ function action_check_status(self, error) result(can_proceed)
end select
end function action_check_status

!> @brief Add argument context to an error message.
!>
!> @param message Base error message
!> @param display_name Argument display name
!> @return Message including argument context
function with_argument_context(message, display_name) result(context_message)
character(len=*), intent(in) :: message
character(len=*), intent(in) :: display_name
character(len=:), allocatable :: context_message

context_message = trim(message) // " for argument '" // trim(display_name) // "'"
end function with_argument_context

!> @brief Execute action based on action type.
!>
!> @details Performs the action's behavior based on its action_type:
Expand All @@ -283,7 +300,9 @@ subroutine action_execute(self, args, values, num_values, error)
type(fclap_error), intent(inout) :: error
integer :: int_val, ios, i, int_bound, str_len
real(wp) :: real_val, real_bound
real :: store_real_val
character(len=:), allocatable :: display_name

display_name = self%get_display_name()

select case(self%action_type)
case(ACT_STORE)
Expand All @@ -294,15 +313,18 @@ subroutine action_execute(self, args, values, num_values, error)
! Store all values as a list
do i = 1, num_values
if (.not. self%is_valid_choice(values(i))) then
call error%init("invalid choice", values(i))
call error%init( &
with_argument_context("invalid choice", display_name), values(i))
return
end if

select case(self%value_type)
case(TYPE_INTEGER)
read(values(i), *, iostat=ios) int_val
if (ios /= 0) then
call error%init("invalid integer value", values(i))
call error%init( &
with_argument_context("invalid integer value", display_name), &
values(i))
return
end if
call args%append_integer(self%dest, int_val)
Expand All @@ -314,32 +336,35 @@ subroutine action_execute(self, args, values, num_values, error)
else
! Single-value storage
if (num_values < 1) then
call error%init("expected one argument", self%dest)
call error%init(with_argument_context("expected one argument", display_name))
return
end if

if (.not. self%is_valid_choice(values(1))) then
call error%init("invalid choice", values(1))
call error%init( &
with_argument_context("invalid choice", display_name), values(1))
return
end if

select case(self%value_type)
case(TYPE_INTEGER)
read(values(1), *, iostat=ios) int_val
if (ios /= 0) then
call error%init("invalid integer value", values(1))
call error%init( &
with_argument_context("invalid integer value", display_name), &
values(1))
return
end if
call args%set_integer(self%dest, int_val)

case(TYPE_REAL)
read(values(1), *, iostat=ios) real_val
if (ios /= 0) then
call error%init("invalid real value", values(1))
call error%init( &
with_argument_context("invalid real value", display_name), values(1))
return
end if
store_real_val = real(real_val)
call args%set_real(self%dest, store_real_val)
call args%set_real(self%dest, real_val)

case default
call args%set_string(self%dest, values(1))
Expand All @@ -357,21 +382,25 @@ subroutine action_execute(self, args, values, num_values, error)

case(ACT_APPEND)
if (num_values < 1) then
call error%init("expected at least one argument", self%dest)
call error%init( &
with_argument_context("expected at least one argument", display_name))
return
end if

do i = 1, num_values
if (.not. self%is_valid_choice(values(i))) then
call error%init("invalid choice", values(i))
call error%init( &
with_argument_context("invalid choice", display_name), values(i))
return
end if

select case(self%value_type)
case(TYPE_INTEGER)
read(values(i), *, iostat=ios) int_val
if (ios /= 0) then
call error%init("invalid integer value", values(i))
call error%init( &
with_argument_context("invalid integer value", display_name), &
values(i))
return
end if
call args%append_integer(self%dest, int_val)
Expand All @@ -393,56 +422,72 @@ subroutine action_execute(self, args, values, num_values, error)
case(ACT_NOT_LESS_THAN)
! Store value and validate it is >= bound
if (num_values < 1) then
call error%init("expected one argument", self%dest)
call error%init(with_argument_context("expected one argument", display_name))
return
end if

select case(self%value_type)
case(TYPE_INTEGER)
read(values(1), *, iostat=ios) int_val
if (ios /= 0) then
call error%init("invalid integer value", values(1))
call error%init( &
with_argument_context("invalid integer value", display_name), values(1))
return
end if
read(self%bound_str, *, iostat=ios) int_bound
if (ios /= 0) then
call error%init("invalid bound value", self%bound_str)
call error%init( &
with_argument_context("invalid bound value", display_name), &
self%bound_str)
return
end if
if (int_val < int_bound) then
call error%init("value must not be less than " // trim(self%bound_str), values(1))
call error%init( &
with_argument_context( &
"value must not be less than " // trim(self%bound_str), display_name), &
values(1))
return
end if
call args%set_integer(self%dest, int_val)

case(TYPE_REAL)
read(values(1), *, iostat=ios) real_val
if (ios /= 0) then
call error%init("invalid real value", values(1))
call error%init( &
with_argument_context("invalid real value", display_name), values(1))
return
end if
read(self%bound_str, *, iostat=ios) real_bound
if (ios /= 0) then
call error%init("invalid bound value", self%bound_str)
call error%init( &
with_argument_context("invalid bound value", display_name), &
self%bound_str)
return
end if
if (real_val < real_bound) then
call error%init("value must not be less than " // trim(self%bound_str), values(1))
call error%init( &
with_argument_context( &
"value must not be less than " // trim(self%bound_str), display_name), &
values(1))
return
end if
store_real_val = real(real_val)
call args%set_real(self%dest, store_real_val)
call args%set_real(self%dest, real_val)

case default
! String type: compare len(trim(value)) against integer bound
str_len = len(trim(values(1)))
read(self%bound_str, *, iostat=ios) int_bound
if (ios /= 0) then
call error%init("invalid bound value", self%bound_str)
call error%init( &
with_argument_context("invalid bound value", display_name), &
self%bound_str)
return
end if
if (str_len < int_bound) then
call error%init("string length must not be less than " // trim(self%bound_str), values(1))
call error%init( &
with_argument_context( &
"string length must not be less than " // trim(self%bound_str), &
display_name), values(1))
return
end if
call args%set_string(self%dest, values(1))
Expand All @@ -451,56 +496,74 @@ subroutine action_execute(self, args, values, num_values, error)
case(ACT_NOT_BIGGER_THAN)
! Store value and validate it is <= bound
if (num_values < 1) then
call error%init("expected one argument", self%dest)
call error%init(with_argument_context("expected one argument", display_name))
return
end if

select case(self%value_type)
case(TYPE_INTEGER)
read(values(1), *, iostat=ios) int_val
if (ios /= 0) then
call error%init("invalid integer value", values(1))
call error%init( &
with_argument_context("invalid integer value", display_name), values(1))
return
end if
read(self%bound_str, *, iostat=ios) int_bound
if (ios /= 0) then
call error%init("invalid bound value", self%bound_str)
call error%init( &
with_argument_context("invalid bound value", display_name), &
self%bound_str)
return
end if
if (int_val > int_bound) then
call error%init("value must not be bigger than " // trim(self%bound_str), values(1))
call error%init( &
with_argument_context( &
"value must not be bigger than " // &
trim(self%bound_str), display_name), &
values(1))
return
end if
call args%set_integer(self%dest, int_val)

case(TYPE_REAL)
read(values(1), *, iostat=ios) real_val
if (ios /= 0) then
call error%init("invalid real value", values(1))
call error%init( &
with_argument_context("invalid real value", display_name), values(1))
return
end if
read(self%bound_str, *, iostat=ios) real_bound
if (ios /= 0) then
call error%init("invalid bound value", self%bound_str)
call error%init( &
with_argument_context("invalid bound value", display_name), &
self%bound_str)
return
end if
if (real_val > real_bound) then
call error%init("value must not be bigger than " // trim(self%bound_str), values(1))
call error%init( &
with_argument_context( &
"value must not be bigger than " // &
trim(self%bound_str), display_name), &
values(1))
return
end if
store_real_val = real(real_val)
call args%set_real(self%dest, store_real_val)
call args%set_real(self%dest, real_val)

case default
! String type: compare len(trim(value)) against integer bound
str_len = len(trim(values(1)))
read(self%bound_str, *, iostat=ios) int_bound
if (ios /= 0) then
call error%init("invalid bound value", self%bound_str)
call error%init( &
with_argument_context("invalid bound value", display_name), &
self%bound_str)
return
end if
if (str_len > int_bound) then
call error%init("string length must not be bigger than " // trim(self%bound_str), values(1))
call error%init( &
with_argument_context( &
"string length must not be bigger than " // trim(self%bound_str), &
display_name), values(1))
return
end if
call args%set_string(self%dest, values(1))
Expand Down
Loading
Loading