Bug 797163 - qof_book_get_option segfaults when retrieving a non-leaf frame

returns a KvpFrame into a nested list of pairs
returns a KvpValue GLIST into a list

bindings/guile/gnc-kvp-guile.cpp

@@ -1,6 +1,7 @@
 #include <guid.hpp>
 #include <kvp-frame.hpp>
 #include <libguile.h>
+#include <numeric>
 
 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))
     {
-#define FUNC_NAME G_STRFUNC
+        auto frame = new KvpFrame;
-        auto vp_frame = SWIG_MustGetPtr(val,
+        for (; !scm_is_null (val); val = scm_cdr (val))
-                                        SWIG_TypeQuery("_p_KvpFrame"), 1, 0);
+        {
-        KvpFrame *frame = static_cast<KvpFrame*>(vp_frame);
+            auto key_str = scm_to_utf8_stringn (scm_caar (val), nullptr);
-#undef FUNC_NAME
+            auto val_scm = scm_cdar (val);
-        return new KvpValue{frame};
+            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))
+    {
+        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<KvpFrame*>();
+        auto frame { val->get<KvpFrame*>() };
-        if (frame != nullptr)
+        auto acc = [](const auto& rv, const auto& iter)
-            return SWIG_NewPointerObj(frame, SWIG_TypeQuery("_p_KvpFrame"), 0);
+        {
+            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<GList*>(); n; n = n->next)
+        {
+            auto elt = gnc_kvp_value_ptr_to_scm (static_cast<KvpValue*>(n->data));
+            lst = scm_cons (elt, lst);
+        }
+        return scm_reverse (lst);
+    }
     default:
 	break;
     }

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)

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