gnucash master: [C++options] Correct handling of multichoice scheme option types.
John Ralls
jralls at code.gnucash.org
Mon May 2 14:28:40 EDT 2022
Updated via https://github.com/Gnucash/gnucash/commit/1a186b95 (commit)
from https://github.com/Gnucash/gnucash/commit/a8e6a59b (commit)
commit 1a186b953edf53789dac9462811eba33205e146d
Author: John Ralls <jralls at ceridwen.us>
Date: Mon May 2 11:28:28 2022 -0700
[C++options] Correct handling of multichoice scheme option types.
Includes tests for save-to-scheme for each type.
diff --git a/libgnucash/app-utils/gnc-optiondb.i b/libgnucash/app-utils/gnc-optiondb.i
index 4dde0c060..1eb7b2b61 100644
--- a/libgnucash/app-utils/gnc-optiondb.i
+++ b/libgnucash/app-utils/gnc-optiondb.i
@@ -944,12 +944,12 @@ wrap_unique_ptr(GncOptionDBPtr, GncOptionDB);
static const char* empty{""};
auto scm_to_str = [](auto item)->const char* {
if (scm_is_integer(item))
- scm_number_to_string(item, scm_from_uint(10u));
- if (scm_is_symbol(item))
- return scm_to_utf8_string(scm_symbol_to_string(item));
- else if (scm_is_string(item))
+ item = scm_number_to_string(item, scm_from_uint(10u));
+ else if (scm_is_symbol(item))
+ item = scm_symbol_to_string(item);
+ if (scm_is_string(item))
return scm_to_utf8_string(item);
- else return empty;
+ return empty;
};
GncMultichoiceOptionIndexVec vec;
auto choice_is_list{option.get_ui_type() == GncOptionUIType::LIST};
@@ -1141,7 +1141,8 @@ inline SCM return_scm_value(ValueType value)
SCM save_scm_value()
{
static const SCM plain_format_str{scm_from_utf8_string("~s")};
- static const SCM ticked_format_str{scm_from_utf8_string("'~s")};
+ static const SCM ticked_format_str{scm_from_utf8_string("'~a")};
+ static const SCM list_format_str{scm_from_utf8_string("'~s")};
//scm_simple_format needs a scheme list of arguments to match the format
//placeholders.
return std::visit([$self] (auto &option) -> SCM {
@@ -1149,7 +1150,6 @@ inline SCM return_scm_value(ValueType value)
if constexpr (is_same_decayed_v<decltype(option),
GncOptionAccountListValue>)
{
- static const SCM list_format_str{scm_from_utf8_string("'~s")};
auto guid_list{option.get_value()};
if (guid_list.empty())
return no_value;
@@ -1219,8 +1219,32 @@ inline SCM return_scm_value(ValueType value)
scm_list_1(gnc_query2scm(value)));
}
if constexpr (is_same_decayed_v<decltype(option),
- GncOptionMultichoiceValue> ||
- is_same_decayed_v<decltype(option),
+ GncOptionMultichoiceValue>)
+ {
+ auto serial{option.serialize()};
+ if (serial.empty())
+ {
+ return no_value;
+ }
+ else
+ {
+ auto keytype{option.get_keytype(option.get_index())};
+ auto scm_str{scm_from_utf8_string(serial.c_str())};
+ switch (keytype)
+ {
+ case GncOptionMultichoiceKeyType::SYMBOL:
+ return scm_simple_format(SCM_BOOL_F, list_format_str,
+ scm_list_1(scm_string_to_symbol(scm_str)));
+ case GncOptionMultichoiceKeyType::STRING:
+ return scm_simple_format(SCM_BOOL_F, list_format_str,
+ scm_list_1((scm_str)));
+ case GncOptionMultichoiceKeyType::NUMBER:
+ return scm_simple_format(SCM_BOOL_F, ticked_format_str,
+ scm_list_1(scm_str));
+ }
+ }
+ }
+ if constexpr (is_same_decayed_v<decltype(option),
GncOptionRangeValue<int>> ||
is_same_decayed_v<decltype(option),
GncOptionRangeValue<double>>)
@@ -1232,7 +1256,7 @@ inline SCM return_scm_value(ValueType value)
}
else
{
- auto scm_str{scm_list_1(scm_string_to_symbol(scm_from_utf8_string(serial.c_str())))};
+ auto scm_str{scm_list_1(scm_from_utf8_string(serial.c_str()))};
return scm_simple_format(SCM_BOOL_F, ticked_format_str, scm_str);
}
}
diff --git a/libgnucash/app-utils/test/test-gnc-option-scheme-output.scm b/libgnucash/app-utils/test/test-gnc-option-scheme-output.scm
index 8b070433f..dd32ea3c6 100644
--- a/libgnucash/app-utils/test/test-gnc-option-scheme-output.scm
+++ b/libgnucash/app-utils/test/test-gnc-option-scheme-output.scm
@@ -80,6 +80,17 @@
" value))
+(define (test-list-output-template value)
+ (format #f "
+; Section: foo
+
+(let ((option (gnc:lookup-option options
+ \"foo\"
+ \"bar\")))
+ ((lambda (o) (if o (gnc:option-set-value o '~s))) option))
+
+" value))
+
(define (test-currency-output-template value)
(format #f "
; Section: foo
@@ -99,7 +110,7 @@
(let ((option (gnc:lookup-option options
\"foo\"
\"bar\")))
- ((lambda (o) (if o (gnc:option-set-value o ~s ~s))) option))
+ ((lambda (o) (if o (gnc:option-set-value o '(commodity-scm ~s ~s)))) option))
" (car value-parts) (cadr value-parts))))
@@ -356,21 +367,41 @@ veritatis et quasi architecto beatae vitae dicta sunt, explicabo.")
(define (test-gnc-multichoice-option-to-scheme)
(test-begin "test-gnc-multichoice-option-to-scheme")
(let ((odb (gnc:new-options))
- (test-template test-literal-output-template)
- (value "5"))
+ (test-template test-list-output-template)
+ (valuenum 1)
+ (valuestr "two")
+ (valuelstr "two plus three")
+ (valuesym 'four)
+ (valuelsym (string->symbol "three plus three")))
(gnc:register-option
odb
(gnc:make-multichoice-option
"foo" "bar" "baz" "Phoney Option" 3
(list (vector 'all "All")
- (vector 1 "1") (vector 2 "2") (vector 3 "3")
- (vector 4 "4") (vector 5 "5") (vector 6 "6"))))
+ (vector 1 "1") (vector "two" "Two") (vector 3 "3")
+ (vector 'four "4") (vector "two plus three" "5")
+ (vector (string->symbol "three plus three") "6"))))
(test-equal "multichoice unchanged" test-unchanged-section-output-template
(gnc:generate-restore-forms odb "options"))
(let ((option (gnc:lookup-option odb "foo" "bar")))
- (gnc:option-set-value option value)
- (test-equal "multichoice form" (test-template (GncOption-serialize option))
- (gnc:generate-restore-forms odb "options"))))
+ (gnc:option-set-value option valuenum)
+ (test-equal "multichoice number key" (test-literal-output-template
+ (GncOption-serialize option))
+ (gnc:generate-restore-forms odb "options"))
+ (gnc:option-set-value option valuestr)
+ (test-equal "multichoice simple string key" (test-template (GncOption-serialize option))
+ (gnc:generate-restore-forms odb "options"))
+ (gnc:option-set-value option valuelstr)
+ (test-equal "multichoice long string key" (test-template (GncOption-serialize option))
+ (gnc:generate-restore-forms odb "options"))
+ (gnc:option-set-value option valuesym)
+ (test-equal "multichoice symbol key" (test-template
+ (string->symbol (GncOption-serialize option)))
+ (gnc:generate-restore-forms odb "options"))
+ (gnc:option-set-value option valuelsym)
+ (test-equal "multichoice long symbol key" (test-template
+ (string->symbol (GncOption-serialize option)))
+ (gnc:generate-restore-forms odb "options"))))
(test-end "test-gnc-multichoice-option-to-scheme"))
(define (test-gnc-list-option-to-scheme)
Summary of changes:
libgnucash/app-utils/gnc-optiondb.i | 44 +++++++++++++++-----
.../test/test-gnc-option-scheme-output.scm | 47 ++++++++++++++++++----
2 files changed, 73 insertions(+), 18 deletions(-)
More information about the gnucash-changes
mailing list