fix: Don't coerce default if callback action

* We no longer coerce the type of an option `default` to match that of
  its `type` argument when `action = "callback"`.
  Thanks husheng (@hs3434) for bug report.

closes #46, closes #47

.github/workflows/R-CMD-check.yaml

@@ -29,7 +29,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 

DESCRIPTION

@@ -2,7 +2,7 @@ Encoding: UTF-8
 Package: optparse
 Type: Package
 Title: Command Line Option Parser
-Version: 1.7.4
+Version: 1.7.5-0
 Authors@R: c(person("Trevor L", "Davis", role=c("aut", "cre"),
              email="[email protected]",
              comment = c(ORCID = "0000-0001-6341-4639")),
@@ -33,4 +33,4 @@ Suggests:
     testthat
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

NEWS.md

@@ -1,3 +1,10 @@
+optparse 1.7.5
+==============
+
+* We no longer coerce the type of an option `default` to match that of
+  its `type` argument when `action = "callback"`.
+  Thanks husheng (@hs3434) for bug report (#47).
+
 optparse 1.7.4
 ==============
 

R/optparse-package.R

@@ -24,8 +24,7 @@
 #'
 #'@name optparse-package
 #'@aliases optparse-package optparse
-#'@docType package
-#'@author Trevor Davis.
+#'@author Trevor L. Davis.
 #'
 #'Some documentation and unit tests ported from Allen Day's getopt package.
 #'
@@ -44,4 +43,4 @@
 #'        readLines(example_file_2)
 #'    }
 #'
-NULL
+"_PACKAGE"

R/optparse.R

@@ -1,4 +1,4 @@
-# Copyright (c) 2010-2022 Trevor L. Davis <[email protected]>
+# Copyright (c) 2010-2024 Trevor L. Davis <[email protected]>
 # Copyright (c) 2015 Rick FitzJohn https://github.com/richfitz
 # Copyright (c) 2013 Kirill Müller https://github.com/krlmlr
 # Copyright (c) 2011 Jim Nikelski <[email protected]>
@@ -262,12 +262,17 @@ make_option <- function(opt_str, action = NULL, type = NULL, dest = NULL, defaul
         type <- infer_type(action, default)
     }
     if (type == "numeric") type <- "double"
+
     # default
-    if ((type != typeof(default)) && !is.null(default)) {
+    if ((action != "callback") &&
+        (type != typeof(default)) &&
+        !is.null(default)) {
         storage.mode(default) <- type
     }
+
     # dest
     if (is.null(dest)) dest <- sub("^--", "", long_flag)
+
     # metavar
     if (is.null(metavar)) {
         if (option_needs_argument_helper(action, type)) {

inst/COPYRIGHTS

@@ -1,7 +1,7 @@
 Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
 
 Files: *
-Copyright: 2010-2022 Trevor L Davis 
+Copyright: 2010-2024 Trevor L Davis
 License: GPL-2+
 
 File: exec/example.R
@@ -33,7 +33,7 @@ License: GPL-2+
 
 File: R/optparse.R 
 Copyright: 1990-2009 Python Software Foundation
-           2011-2022 Trevor L Davis 
+           2011-2024 Trevor L Davis
            2010 Steve Lianoglou
            2011 Jim Nikelski
            2013 Kirill Müller

tests/testthat/test-optparse.R

@@ -33,8 +33,7 @@ option_list <- list(
 parser_ol <- OptionParser(option_list = option_list)
 
 
-context("Testing make_option")
-test_that("make_option works as expected", {
+test_that("`make_option()` works as expected", {
     expect_equal(make_option("--integer", type = "integer", default = 5),
                 make_option("--integer", default = as.integer(5)))
     expect_equal(make_option("--logical", type = "logical", default = "TRUE"),
@@ -47,17 +46,15 @@ test_that("make_option works as expected", {
 get_long_flags <- function(parser) {
     sort(sapply(parser@options, function(x) x@long_flag))
 }
-context("Test add_option")
-test_that("add_option works as expected", {
+test_that("`add_option()` works as expected", {
     parser1 <- OptionParser(option_list = list(make_option("--generator"), make_option("--count")))
     parser2 <- OptionParser()
     parser2 <- add_option(parser2, "--generator")
     parser2 <- add_option(parser2, "--count")
     expect_equal(get_long_flags(parser1), get_long_flags(parser2))
 })
 
-context("Testing parse_args")
-test_that("parse_args works as expected", {
+test_that("`parse_args()` works as expected", {
     # option_list took outside test_that
     option_list2 <- list(
         make_option(c("-n", "--add-numbers"), action = "store_true", default = FALSE,
@@ -241,7 +238,6 @@ test_that("test bug with a NA short flag option with positional_arguments = TRUE
                 sort_list(list(options = list(help = TRUE), args = "foo")))
 })
 
-context("print_help")
 test_that("description and epilogue work as expected", {
     parser <- OptionParser()
     expect_output(print_help(parser), "Usage:")
@@ -318,7 +314,6 @@ test_that("Can parse empty string", {
 # nolint end
 
 # Use h flag for non-help (Reported by Jeff Bruce)
-context("Use h option for non-help")
 test_that("Use h option for non-help", {
     option_list_neg <- list(make_option(c("-h", "--mean"), default = 0.0))
     parser <- OptionParser(usage = "\\%prog [options] file", option_list = option_list_neg)
@@ -329,3 +324,12 @@ test_that("Use h option for non-help", {
     args <- parse_args(parser, args = c("-h", "-5.0"))
     expect_equal(args, list(mean = -5.0))
 })
+
+# Bug found by @husheng (#47)
+test_that("Don't coerce `default` of callback action match that of `type`", {
+    parser <- OptionParser()
+    str2bool <- function(option, flag, option_value, parser) as.logical(option_value)
+    parser <- add_option(parser, "--bool", type = "character", default = FALSE, callback = str2bool)
+    expect_equal(parse_args(parser, c())$bool, FALSE)
+    expect_equal(parse_args(parser, "--bool=T")$bool, TRUE)
+})