Merge pull request #10 from CMB/kwargs-etc

Tests, build process, method kwargs handling.

build.scm

@@ -1,6 +1,6 @@
 
 (import (chicken base) (chicken format) (chicken process)
-        (chicken process-context) srfi-13 compile-file)
+        (chicken process-context) srfi-1 srfi-13 compile-file pkg-config)
 
 (define args (command-line-arguments))
 
@@ -19,15 +19,23 @@
      (condition-case (python-try-compile flags ...)
 		     (t ()    #f)))))
 
+(define (python-pkg-config-test package)
+  (and-let* ((cflags (pkg-config:cflags package))
+	     (libs (pkg-config:libs package)))
+    (python-test ("<python.h>" cflags libs))))
+
 (define cpp+ld-options
   (let ((cflags (get-environment-variable "PYTHON_CFLAGS"))
 	(lflags (get-environment-variable "PYTHON_LFLAGS"))
 	(libs   (get-environment-variable "PYTHON_LIBS")))
     (if (and cflags lflags libs)
 	(python-test ("<Python.h>" cflags (string-append lflags " " libs)))
-	(or (python-test ("<Python.h>"
-                          "-I/System/Library/Frameworks/Python.framework/Headers"
-                          "-framework Python"))
+	(or
+	 (any python-pkg-config-test '("python3-embed" "python3" "python"))
+	 (python-test ("<Python.h>"
+			  "-I/System/Library/Frameworks/Python.framework/Headers"
+			  "-framework Python"))
+	    (python-test ("<Python.h>" "-I/usr/include/python3.10" "-lpython3.10"))
 	    (python-test ("<Python.h>" "-I/usr/include/python3.9m" "-lpython3.9m"))
 	    (python-test ("<Python.h>" "-I/usr/include/python3.9" "-lpython3.9"))
 	    (python-test ("<Python.h>" "-I/usr/include/python3.8m" "-lpython3.8m"))

build.sh

@@ -1,3 +1,4 @@
+#!/bin/sh
 # -*- sh -*-
 
 "$CHICKEN_CSI" -q -s build.scm "$CHICKEN_CSC $@"

pyffi.egg

@@ -5,8 +5,8 @@
  (license "GPL-3")
  (category ffi)
  (dependencies srfi-1 srfi-69 bind utf8)
- (build-dependencies compile-file srfi-13)
- (test-dependencies test)
+ (build-dependencies compile-file pkg-config srfi-13)
+ (test-dependencies brev-separate test)
  (author "Ivan Raikov")
  (components (extension pyffi (custom-build "build.sh") (csc-options "-d2" "-O0")))
  )

pyffi.scm

@@ -25,17 +25,17 @@
 	     *py-functions* 
 	     (define-pyfun PyCallable_Check Py_DecRef)
 	     (define-pyslot PyObject_GetAttrString PyObject_SetAttrString )
-	     (define-pymethod PyObject_GetAttrString PyObject_CallObject PyObject_Call ))
+	     (define-pymethod PyObject_GetAttrString PyObject_CallObject PyObject_Call parse-argument-list ))
 
 
-   (import scheme (chicken base) (chicken foreign) (chicken syntax) 
+   (import scheme (chicken base) (chicken foreign) (chicken keyword) (chicken syntax) 
            (chicken blob) (chicken locative) (chicken string) (chicken condition)
            (only (chicken memory) pointer?) (only (chicken port) port-name)
-           (only srfi-1 first second every filter take-while)
+           (only srfi-1 first second every break)
            srfi-4 srfi-69 bind utf8 utf8-lolevel utf8-srfi-13 utf8-srfi-14)
 
-   (import-for-syntax (chicken base) (chicken string)
-                      (only srfi-1 first second every filter take-while)
+   (import-for-syntax (chicken base) (chicken keyword) (chicken string)
+                      (only srfi-1 first second every break)
                       srfi-69)
 
 (define (pyffi:error x . rest)
@@ -623,6 +623,20 @@ EOF
                                          (,PyObject_SetAttrString ,obj ,(->string name)
                                                                   (,%car ,rest))))))))))
 
+(define (alistify-kwargs lst accepted-keywords)
+  (let loop ((lst lst) (kwargs '()))
+    (cond
+     ((null? lst) kwargs)
+     ((null? (cdr lst)) (pyffi:error 'alistify-kwargs "Bad keyword argument."))
+     ((not (keyword? (car lst))) (pyffi:error 'alistify-kwargs "Not a keyword: " (car lst)))
+     ((not (member (car lst) accepted-keywords)) (pyffi:error 'alistify-kwargs "Unexpected keyword argument: " (car lst)))
+     (#t
+      (loop (cddr lst) (cons (list (keyword->string (car lst)) (cadr lst)) kwargs))))))
+
+(define (parse-argument-list args accepted-keywords)
+  (receive (args* kwargs*)
+      (break keyword? args)
+    (values args* (alistify-kwargs kwargs* accepted-keywords))))
 
 (define-syntax define-pymethod
   (er-macro-transformer
@@ -635,17 +649,16 @@ EOF
 	     (%quote           (r 'quote))
 	     (%cons            (r 'cons))
 	     (%list            (r 'list))
-	     (%identity        (r 'identity))
-	     (%filter          (r 'filter))
-	     (%take-while      (r 'take-while))
+	     (%break          (r 'break))
 	     (%lambda          (r 'lambda))
-	     (%symbol?         (r 'symbol?))
+	     (%keyword?         (r 'keyword?))
 	     (%null?           (r 'null?))
 	     (%and             (r 'and))
 	     (%not             (r 'not))
 	     (%if              (r 'if))
 	     (%list->vector     (r 'list->vector))
 	     (%->string         (r '->string))
+	     (parse-argument-list         (r 'parse-argument-list))
 	     (PyObject_GetAttrString     (r 'PyObject_GetAttrString))
 	     (PyObject_CallObject        (r 'PyObject_CallObject))
 	     (PyObject_Call              (r 'PyObject_Call))
@@ -658,14 +671,14 @@ EOF
                         (,PyObject_CallObject
                          (,PyObject_GetAttrString ,obj ,(->string name) )
                          (,%list->vector ,rest)))
-             (let ((kwargs (cadr kw)))
-               `(,%define (,proc-name ,obj #!rest ,rest #!key ,@(map (lambda (x) (list x #f)) kwargs))
-                          (let ((kwargs (,%filter ,%identity 
-                                                  (,%list 
-                                                   ,@(map (lambda (k x) `(,%and ,x (,%list (,%->string (quote ,k)) ,x))) kwargs kwargs)))))
+             (let ((kwargs (map (compose string->keyword symbol->string) (cadr kw))))
+               `(,%define (,proc-name ,obj #!rest ,rest)
+			  (receive
+			      (args kwargs)
+			      (,parse-argument-list ,rest ',kwargs)
                             (,PyObject_Call 
                              (,PyObject_GetAttrString ,obj ,(->string name) )
-                             (,%list->vector (,%take-while (,%lambda (x) (,%not (,%symbol? x))) ,rest))
+			     (list->vector args)
                              (,%if (,%null? kwargs) #f kwargs))
                             ))
                ))

tests/run.scm

@@ -1,11 +1,110 @@
-(import pyffi)
+(import (chicken condition) (chicken format) (chicken sort) brev-separate pyffi test)
+
+(define-ir-syntax*
+  ((test-signals-condition test-name kind body ...)
+`(test-assert ,test-name (handle-exceptions exn ((condition-predicate ,kind) exn) (begin ,@body #f)))))
 
 (py-start)
-(py-eval "print(open)")
 (py-import "sys")
-(assert (string? (py-eval "sys.version")))
+(define-pyfun ("lambda x: (x.real, x.imag)" complex->tuple) x)
+(define-pyfun ("lambda x: sorted(list(x.items()))" dict-items) x)
+(define-pyfun "repr" obj)
+(define-pyfun ("lambda r, obj: eval(r) == obj and type(eval(r)) == type(obj)" repr-compare) r obj)
+
+(test-begin "basic tests")
+(test-assert "major version is either 3 or 2" (member (py-eval "sys.version_info[0]") '(3 2)))
+(test-assert "sys.version is a string" (string? (py-eval "sys.version")))
 (print "Python version: " (py-eval "sys.version"))
-(print (py-eval "1"))
-(print (py-eval "1.0"))
-(print (py-eval "float('-inf')"))
-(print (py-eval "complex(1.0, 2.0)"))
+(test-end "basic tests")
+
+(test-begin "python->scheme type conversion")
+(test "python integer converted to scheme" 12345 (py-eval "12345"))
+;; Pick a number that has an exact binary floating point representation.
+(test "python float converts to scheme" 0.25 (py-eval "0.25"))
+(test "python inf converts to scheme" +inf.0 (py-eval "float('inf')"))
+(test "python -inf converts to scheme" -inf.0 (py-eval "float('-inf')"))
+(test-assert "python nan converts to scheme" (nan? (py-eval "float('nan')")))
+(test "python string converts to scheme" "hello world" (py-eval "'hello ' + 'world'"))
+(test "python complex converts to scheme" 1.0+2.0i (py-eval "complex(1.0, 2.0)"))
+(test "python tuple converts to scheme vector" #(10 20 30) (py-eval "(10, 20, 30)"))
+(test "python list converts to scheme" '(10 20 30) (py-eval "[10, 20, 30]"))
+
+(test "python dict converts to scheme alist"
+'(("a" 1) ("b" 2) ("c" 3))
+(sort (py-eval "{'a': 1, 'b': 2, 'c': 3}") (lambda (x y) (string<? (car x) (car y)))))
+
+(test-end "python->scheme type conversion")
+
+(test-begin "scheme->python type conversion")
+(test-assert "scheme integer converted to python" (repr-compare "12345" 12345))
+;; Pick a number that has an exact binary floating point representation.
+(test-assert "Scheme float converts to python" (repr-compare "0.25" 0.25))
+(test-assert "scheme inf converts to python" (repr-compare "float('inf')" +inf.0))
+(test-assert "scheme inf converts to python" (repr-compare "float('-inf')" -inf.0))
+(test "scheme nan converts to python" "nan" (repr +nan.0))
+(test-assert "scheme string converts to python" (repr-compare "'hello'" "hello"))
+(test-assert "scheme complex converts to python" (repr-compare "2.0+4.0j" 2.0+4.0i))
+(test-assert "scheme vector converts to python tuple" (repr-compare "(10, 20, 30)" #(10 20 30)))
+(test-assert "scheme list converts to python" (repr-compare "[10, 20, 30]" '(10 20 30)))
+(test-assert "scheme alist converts to python dict"
+  (repr-compare "{'a': 1, 'b': 2, 'c': 3}" '(("a" 1) ("b" 2) ("c" 3))))
+(test-end "scheme->python type conversion")
+
+(py-eval  #<<EOP
+exec('''
+class Foo:
+  def bar(self, a1, a2=None, a3=None, a4=None, a5=None):
+    return (self, a1, a2, a3, a4, a5)
+
+  def kwo(self, a=None, b=None):
+    return (self, a, b)
+
+  def baz(self, x, y):
+    return x + y
+
+  def with_rest(self, *args):
+    return list(reversed(args))
+
+''')
+EOP
+)
+
+(define test-object (py-eval "Foo()"))
+(define-pymethod "bar" kw: (a2 a3 a4 a5))
+(define-pymethod "kwo" kw: (a b))
+(define-pymethod "baz")
+(define-pymethod "with_rest")
+(define py-none (py-eval "None"))
+
+(test-begin "method parameter handling")
+(test "rest without keyword arguments" '(5 4 3 2 1) (with_rest test-object 1 2 3 4 5))
+(test-assert "rest parameter, no arguments passed" (null? (with_rest test-object)))
+(test "fixed arity, correct number of arguments passed"
+8 (baz test-object 3 5))
+(test-signals-condition "fixed arity, too many arguments passed" 'pyerror
+(baz test-object 3 4 5))
+(test-signals-condition "fixed arity, too few arguments passed" 'pyerror
+(baz test-object 3))
+(test-signals-condition "one fixed parameter many keywords, no args passed" 'pyerror
+(bar test-object))
+(test "1+kwargs method gets no kwargs"
+(vector test-object 5 py-none py-none py-none py-none) (bar test-object 5))
+(test "1+kwargs method gets one kwarg"
+(vector test-object 5 py-none py-none 7 py-none) (bar test-object 5 a4: 7))
+(test "kwargs-only method gets no kwargs"
+(vector test-object py-none py-none) (kwo test-object))
+(test "kwargs-only method gets one kwarg"
+(vector test-object py-none 4) (kwo test-object b: 4))
+(test-signals-condition "unexpected keyword" 'exn
+(kwo test-object surprise: 3))
+(test-signals-condition "keyword passed without value" 'exn (kwo test-object a:))
+(test-signals-condition "non-keyword passed after keyword" 'exn (kwo test-object a: 7 9))
+(test-end "method parameter handling")
+
+(unless (zero? (test-failure-count))
+  (print "=====")
+  (printf "===== ~a ~a failed!\n"
+          (test-failure-count)
+          (if (> (test-failure-count) 1) "tests" "test"))
+  (print "====="))
+(test-exit)