[C++options] Correct handling of multichoice scheme option types.

Includes tests for save-to-scheme for each type.
This commit is contained in:
John Ralls 2022-05-02 11:28:28 -07:00
parent a8e6a59bf8
commit 1a186b953e
2 changed files with 73 additions and 18 deletions

View File

@ -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);
}
}

View File

@ -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)