diff --git a/bindings/guile/gnc-kvp-guile.cpp b/bindings/guile/gnc-kvp-guile.cpp index e9748ebbf1f..33c04cf335c 100644 --- a/bindings/guile/gnc-kvp-guile.cpp +++ b/bindings/guile/gnc-kvp-guile.cpp @@ -1,6 +1,7 @@ #include #include #include +#include extern "C" { @@ -21,6 +22,17 @@ extern "C" * types based only on the scheme type. */ +static bool scm_is_list_of_string_pairs (SCM val) +{ + for (; !scm_is_null (val); val = scm_cdr (val)) + { + if (!(scm_is_pair (val) && scm_is_pair (scm_car (val)) && + scm_is_string (scm_caar (val)))) + return false; + } + return true; +} + KvpValue * gnc_scm_to_kvp_value_ptr(SCM val) { @@ -59,16 +71,31 @@ gnc_scm_to_kvp_value_ptr(SCM val) { return new KvpValue{gnc_scm_to_utf8_string(val)}; } - else if (SWIG_IsPointerOfType(val, SWIG_TypeQuery("_p_KvpFrame"))) + else if (!scm_is_null (val) && scm_is_list_of_string_pairs (val)) + { + auto frame = new KvpFrame; + for (; !scm_is_null (val); val = scm_cdr (val)) + { + auto key_str = scm_to_utf8_stringn (scm_caar (val), nullptr); + auto val_scm = scm_cdar (val); + auto prev = frame->set ({key_str}, gnc_scm_to_kvp_value_ptr (val_scm)); + g_free (key_str); + // there is a pre-existing key-value + if (prev) + delete prev; + } + return new KvpValue (frame); + } + else if (!scm_is_null (val) && scm_is_list (val)) { -#define FUNC_NAME G_STRFUNC - auto vp_frame = SWIG_MustGetPtr(val, - SWIG_TypeQuery("_p_KvpFrame"), 1, 0); - KvpFrame *frame = static_cast(vp_frame); -#undef FUNC_NAME - return new KvpValue{frame}; + GList *kvplist = nullptr; + for (; !scm_is_null (val); val = scm_cdr (val)) + { + auto elt = gnc_scm_to_kvp_value_ptr (scm_car (val)); + kvplist = g_list_prepend (kvplist, elt); + } + return new KvpValue (g_list_reverse (kvplist)); } - /* FIXME: add list handler here */ return NULL; } @@ -102,12 +129,26 @@ gnc_kvp_value_ptr_to_scm(KvpValue* val) break; case KvpValue::Type::FRAME: { - auto frame = val->get(); - if (frame != nullptr) - return SWIG_NewPointerObj(frame, SWIG_TypeQuery("_p_KvpFrame"), 0); + auto frame { val->get() }; + auto acc = [](const auto& rv, const auto& iter) + { + auto key_scm { scm_from_utf8_string (iter.first) }; + auto val_scm { gnc_kvp_value_ptr_to_scm (iter.second) }; + return scm_acons (key_scm, val_scm, rv); + }; + return scm_reverse (std::accumulate (frame->begin(), frame->end(), SCM_EOL, acc)); } break; case KvpValue::Type::GLIST: + { + SCM lst = SCM_EOL; + for (GList *n = val->get(); n; n = n->next) + { + auto elt = gnc_kvp_value_ptr_to_scm (static_cast(n->data)); + lst = scm_cons (elt, lst); + } + return scm_reverse (lst); + } default: break; } diff --git a/bindings/guile/test/CMakeLists.txt b/bindings/guile/test/CMakeLists.txt index ee48e6f49fc..75e792795a2 100644 --- a/bindings/guile/test/CMakeLists.txt +++ b/bindings/guile/test/CMakeLists.txt @@ -61,6 +61,7 @@ set (scm_tests_with_srfi64_SOURCES test-core-utils.scm test-business-core.scm test-scm-engine.scm + test-scm-kvpvalue.scm ) if (HAVE_SRFI64) diff --git a/bindings/guile/test/test-scm-kvpvalue.scm b/bindings/guile/test/test-scm-kvpvalue.scm new file mode 100644 index 00000000000..a8d36b80150 --- /dev/null +++ b/bindings/guile/test/test-scm-kvpvalue.scm @@ -0,0 +1,68 @@ +(use-modules (srfi srfi-64)) +(use-modules (tests srfi64-extras)) +(use-modules (gnucash engine)) +(use-modules (gnucash app-utils)) + +(define (run-test) + (test-runner-factory gnc:test-runner) + (test-begin "test-app-utils") + (test-kvp-access) + (test-end "test-app-utils")) + +(define (setup book) + (qof-book-set-option book "bla" '("top" "lvl1a")) + (qof-book-set-option book "arg" '("top" "lvl1b")) + (qof-book-set-option book "baf" '("top" "lvl1c" "lvl2" "lvl3"))) + +(define (teardown) + (gnc-clear-current-session)) + +(define (test-kvp-access) + (define book (gnc-get-current-book)) + (test-begin "kvp-access from guile") + + (setup book) + + (test-equal "top/lvl1a" + "bla" + (qof-book-get-option book '("top" "lvl1a"))) + + (test-equal "top/lvl1b" + "arg" + (qof-book-get-option book '("top" "lvl1b"))) + + (test-equal "top/lvl1c/lvl2/lvl3" + "baf" + (qof-book-get-option book '("top" "lvl1c" "lvl2" "lvl3"))) + + (test-equal "top/lvl1c/lvl2" + '(("lvl3" . "baf")) + (qof-book-get-option book '("top" "lvl1c" "lvl2"))) + + (test-equal "top/lvl1c" + '(("lvl2" ("lvl3" . "baf"))) + (qof-book-get-option book '("top" "lvl1c"))) + + ;; this tests the reading & writing of KvpFrame, copying branch + ;; from top/lvl1c to top/lvl1d + (qof-book-set-option book + (qof-book-get-option book '("top" "lvl1c")) + '("top" "lvl1d")) + + (test-equal "top/lvl1d, after copying from top/lvl1c" + '(("lvl2" ("lvl3" . "baf"))) + (qof-book-get-option book '("top" "lvl1d"))) + + (test-equal "top/lvl1c/lvl2/error" + #f + (qof-book-get-option book '("top" "lvl1c" "lvl2" "error"))) + + (test-equal "top" + '(("lvl1a" . "bla") + ("lvl1b" . "arg") + ("lvl1c" ("lvl2" ("lvl3" . "baf"))) + ("lvl1d" ("lvl2" ("lvl3" . "baf")))) + (qof-book-get-option book '("top"))) + + (test-end "kvp-access from guile") + (teardown)) diff --git a/libgnucash/engine/kvp-frame.cpp b/libgnucash/engine/kvp-frame.cpp index 74d33b8fa1c..56be042d4cc 100644 --- a/libgnucash/engine/kvp-frame.cpp +++ b/libgnucash/engine/kvp-frame.cpp @@ -78,6 +78,8 @@ KvpFrame::get_child_frame_or_nullptr (Path const & path) noexcept if (map_iter == m_valuemap.end ()) return nullptr; auto child = map_iter->second->get (); + if (!child) + return nullptr; Path send; std::copy (path.begin () + 1, path.end (), std::back_inserter (send)); return child->get_child_frame_or_nullptr (send); diff --git a/libgnucash/engine/kvp-frame.hpp b/libgnucash/engine/kvp-frame.hpp index 253eec31878..704d5a3d7b4 100644 --- a/libgnucash/engine/kvp-frame.hpp +++ b/libgnucash/engine/kvp-frame.hpp @@ -226,6 +226,9 @@ struct KvpFrameImpl bool empty() const noexcept { return m_valuemap.empty(); } friend int compare(const KvpFrameImpl&, const KvpFrameImpl&) noexcept; + map_type::iterator begin() { return m_valuemap.begin(); } + map_type::iterator end() { return m_valuemap.end(); } + private: map_type m_valuemap;