3 files changed, 46 insertions, 4 deletions
diff --git a/pmt/src/lib/pmt.cc b/pmt/src/lib/pmt.cc
index b896adaa2..b2c04b390 100644
--- a/pmt/src/lib/pmt.cc
+++ b/pmt/src/lib/pmt.cc
@@ -748,7 +748,19 @@ pmt_length(pmt_t x)
   if (x->is_uniform_vector())
     return _uniform_vector(x)->length();
 
-  // FIXME list length
+  if (x->is_pair() || x->is_null()) {
+    size_t length=0;
+    while (pmt_is_pair(x)){
+      length++;
+      x = pmt_cdr(x);
+    }
+    if (pmt_is_null(x))
+      return length;
+
+    // not a proper list
+    throw pmt_wrong_type("pmt_length", x);
+  }
+
   // FIXME dictionary length (number of entries)
 
   throw pmt_wrong_type("pmt_length", x);
@@ -938,6 +950,18 @@ pmt_list4(pmt_t x1, pmt_t x2, pmt_t x3, pmt_t x4)
 }
 
 pmt_t
+pmt_list5(pmt_t x1, pmt_t x2, pmt_t x3, pmt_t x4, pmt_t x5)
+{
+  return pmt_cons(x1, pmt_cons(x2, pmt_cons(x3, pmt_cons(x4, pmt_cons(x5, PMT_NIL)))));
+}
+
+pmt_t
+pmt_list6(pmt_t x1, pmt_t x2, pmt_t x3, pmt_t x4, pmt_t x5, pmt_t x6)
+{
+  return pmt_cons(x1, pmt_cons(x2, pmt_cons(x3, pmt_cons(x4, pmt_cons(x5, pmt_cons(x6, PMT_NIL))))));
+}
+
+pmt_t
 pmt_caar(pmt_t pair)
 {
   return (pmt_car(pmt_car(pair)));
diff --git a/pmt/src/lib/pmt.h b/pmt/src/lib/pmt.h
index 6aeae773b..fa368a6a1 100644
--- a/pmt/src/lib/pmt.h
+++ b/pmt/src/lib/pmt.h
@@ -598,6 +598,18 @@ pmt_t pmt_list3(pmt_t x1, pmt_t x2, pmt_t x3);
  */
 pmt_t pmt_list4(pmt_t x1, pmt_t x2, pmt_t x3, pmt_t x4);
 
+/*!
+ * \brief Return a list of length 5 containing \p x1, \p x2, \p x3, \p x4, \p x5
+ */
+pmt_t pmt_list5(pmt_t x1, pmt_t x2, pmt_t x3, pmt_t x4, pmt_t x5);
+
+/*!
+ * \brief Return a list of length 6 containing \p x1, \p x2, \p x3, \p x4, \p
+ * x5, \p x6
+ */
+pmt_t pmt_list6(pmt_t x1, pmt_t x2, pmt_t x3, pmt_t x4, pmt_t x5, pmt_t x6);
+
+
 /*
  * ------------------------------------------------------------------------
  *			     read / write
diff --git a/pmt/src/lib/qa_pmt_prims.cc b/pmt/src/lib/qa_pmt_prims.cc
index c36a5e972..26b3e26d3 100644
--- a/pmt/src/lib/qa_pmt_prims.cc
+++ b/pmt/src/lib/qa_pmt_prims.cc
@@ -138,11 +138,17 @@ qa_pmt_prims::test_pairs()
   pmt_t s2 = pmt_string_to_symbol("s2");
   pmt_t s3 = pmt_string_to_symbol("s3");
 
+
+  CPPUNIT_ASSERT_EQUAL((size_t)0, pmt_length(PMT_NIL));
+  CPPUNIT_ASSERT_THROW(pmt_length(s1), pmt_wrong_type);
+  CPPUNIT_ASSERT_THROW(pmt_length(pmt_from_double(42)), pmt_wrong_type);
+
   pmt_t c1 = pmt_cons(s1, PMT_NIL);
   CPPUNIT_ASSERT(pmt_is_pair(c1));
   CPPUNIT_ASSERT(!pmt_is_pair(s1));
   CPPUNIT_ASSERT_EQUAL(s1, pmt_car(c1));
   CPPUNIT_ASSERT_EQUAL(PMT_NIL, pmt_cdr(c1));
+  CPPUNIT_ASSERT_EQUAL((size_t) 1, pmt_length(c1));
 
   pmt_t c3 = pmt_cons(s3, PMT_NIL);
   pmt_t c2 = pmt_cons(s2, c3);
@@ -150,7 +156,9 @@ qa_pmt_prims::test_pairs()
   CPPUNIT_ASSERT_EQUAL(c2, pmt_cdr(c1));
   pmt_set_car(c1, s3);
   CPPUNIT_ASSERT_EQUAL(s3, pmt_car(c1));
-
+  CPPUNIT_ASSERT_EQUAL((size_t)1, pmt_length(c3));
+  CPPUNIT_ASSERT_EQUAL((size_t)2, pmt_length(c2));
+  
   CPPUNIT_ASSERT_THROW(pmt_cdr(PMT_NIL), pmt_wrong_type);
   CPPUNIT_ASSERT_THROW(pmt_car(PMT_NIL), pmt_wrong_type);
   CPPUNIT_ASSERT_THROW(pmt_set_car(s1, PMT_NIL), pmt_wrong_type);
@@ -228,8 +236,6 @@ qa_pmt_prims::test_equivalence()
 void
 qa_pmt_prims::test_misc()
 {
-  CPPUNIT_ASSERT_THROW(pmt_length(PMT_NIL), pmt_wrong_type);
-
   pmt_t k0 = pmt_string_to_symbol("k0");
   pmt_t k1 = pmt_string_to_symbol("k1");
   pmt_t k2 = pmt_string_to_symbol("k2");