From 37c44c05743785459d3ead6cedaefbf39c474695 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Mon, 27 Mar 2017 11:49:02 -0400 Subject: [PATCH 01/30] Build with ASDF 3.3 Cleanup the .asd file so it doesn't issue warnings or errors with ASDF 3.3 (NB: it should still work with ASDF 3.0 or later). --- clpython.asd | 177 ++++++++++++++++++--------------------------------- 1 file changed, 61 insertions(+), 116 deletions(-) diff --git a/clpython.asd b/clpython.asd index 5239949..5bf8fc4 100644 --- a/clpython.asd +++ b/clpython.asd @@ -9,23 +9,33 @@ ;;;; ASDF System Definitions -(in-package #:cl-user) - (eval-when (:compile-toplevel) (error "This ASDF file should be run interpreted.")) -;;; CL-Python is split into several ASDF systems, to make it possible to load +;;; CL-Python is split into several ASDF systems, to make it possible to load ;;; specific components -- in particular, to load the compiler or parser without ;;; the runtime environment. -;;; +;;; ;;; The main system :CLPYTHON is the sum of all components, including contributions. -(asdf:defsystem :clpython.basic +;;; Suppress some warnings about package trickery + +(defun call-with-suppressed-clpython-package-warnings (thunk) + (handler-bind (#+sbcl + (sb-int:package-at-variance #'muffle-warning) + #+lispworks + (simple-warning (lambda (c) + (let ((fmt (slot-value c 'conditions::format-string))) + (when (search "Using DEFPACKAGE" fmt) + (muffle-warning c)))))) + (funcall thunk))) + +(defsystem "clpython/basic" :description "CLPython package and utils" - :depends-on (:closer-mop) + :depends-on ("closer-mop") :serial t - :components ((:file "package") + :components ((:file "package" :around-compile call-with-suppressed-clpython-package-warnings) (:module "util" :components ((:file "utils") (:file "readtable") @@ -38,25 +48,29 @@ (:file "errors") (:file "aupprint"))))) -(asdf:defsystem :clpython.parser +;;; In Allegro, which provides its own Yacc, CL-Yacc can optionally be used. +;;; In other implementations, Allegro Yacc is unavailable +(when (asdf:find-system "yacc" nil) + (pushnew :use-cl-yacc *features*)) + +(defsystem "clpython/parser" :description "Python parser, code walker, and pretty printer" - :depends-on - #.`(:clpython.basic :closer-mop - #-allegro :yacc - #+allegro ,@(when (asdf:find-system :yacc nil) `(:yacc))) + :depends-on ("clpython/basic" + "closer-mop" + (:feature (:or :allegro :use-cl-yacc) "yacc")) :components ((:module "parser" :components ((:file "grammar" ) (:file "lexer" :depends-on ("grammar")) (:file "parser" :depends-on ("grammar" "lexer")) - (:file "grammar-aclyacc" :depends-on ("grammar" "lexer" "parser")) - (:file "grammar-clyacc" :depends-on ("grammar" "lexer" "parser")) + (:file "grammar-aclyacc" :depends-on ("grammar" "lexer" "parser") :if-feature :allegro) + (:file "grammar-clyacc" :depends-on ("grammar" "lexer" "parser") :if-feature :use-cl-yacc) (:file "ast-util" :depends-on ("grammar")) (:file "walk" ) (:file "pprint" ))))) -(asdf:defsystem :clpython.compiler +(defsystem "clpython/compiler" :description "Python compiler" - :depends-on (:clpython.basic :clpython.parser :clpython.runtime :closer-mop) + :depends-on ("clpython/basic" "clpython/parser" "clpython/runtime" "closer-mop") :serial t :components ((:module "compiler" :serial t @@ -64,12 +78,12 @@ (:file "pydecl" ) (:file "namespace" ) (:file "compiler" ) - (:file "generator" ) + (:file "generator" ) (:file "optimize" ))))) -(asdf:defsystem :clpython.runtime +(defsystem "clpython/runtime" :description "Python runtime environment" - :depends-on (:clpython.basic :closer-mop #+ecl :cl-custom-hash-table :cl-fad) + :depends-on ("clpython/basic" "closer-mop" #+ecl "cl-custom-hash-table" "cl-fad") :components ((:module "runtime" :serial t :components ((:file "rsetup" ) @@ -82,12 +96,12 @@ (:file "run" ) (:file "import" ))))) -(asdf:defsystem :clpython.lib +(defsystem "clpython/lib" :description "Python module library" - :depends-on (:clpython.basic :clpython.runtime :clpython.compiler #| TODO: remove compiler dep |#) + :depends-on ("clpython/basic" "clpython/runtime" "clpython/compiler" #| TODO: remove compiler dep |#) :components ((:module "lib" :serial t - :components ((:file "lsetup") + :components ((:file "lsetup" :around-compile call-with-suppressed-clpython-package-warnings) (:file "builtins-file" :depends-on ("lsetup")) (:file "builtins-set" :depends-on ("lsetup")) (:file "builtins-buffer" :depends-on ("lsetup")) @@ -127,9 +141,9 @@ (:file "time" :depends-on ("lsetup")) (:file "_weakref" :depends-on ("lsetup")))))) -(asdf:defsystem :clpython.contrib +(defsystem "clpython/contrib" :description "CLPython contributions and experiments" - :depends-on (:clpython.basic :clpython.runtime :clpython.compiler) + :depends-on ("clpython/basic" "clpython/runtime" "clpython/compiler") :components ((:module "contrib" :components ((:file "repl") (:file "lispy") @@ -138,18 +152,34 @@ ;; #+(and allegro allegro-version>= (version>= 8 2)) (:file "source" ))))) +;;; Show usage after loading the system + +(defun show-clpython-quick-start () + (format t "~%CLPython quick start guide:~%") + (format t " Run a string of Python code: (~S \"for i in range(4): print i\")~%" + (find-symbol* '#:run :clpython)) + (format t " Run a Python file: (~S #p\"~~/example/foo.py\")~%" + (find-symbol* '#:run :clpython)) + (format t " Start the Python \"interpreter\" (REPL): (~S)~%" + (find-symbol* '#:repl :clpython.app.repl)) + (format t " To start mixed Python/Lisp input mode: (~S)~%" + (find-symbol* '#:enter-mixed-lisp-python-syntax :clpython)) + (format t " Run the test suite: ~S~%~%" + '(asdf:test-system "clpython"))) + ;;; The main system -(asdf:defsystem :clpython +(defsystem "clpython" :description "CLPython - an implementation of Python in Common Lisp" - :depends-on (:clpython.basic :clpython.parser :clpython.runtime :clpython.compiler :clpython.lib :clpython.contrib) - :in-order-to ((asdf:test-op (asdf:load-op :clpython.test)))) + :depends-on ("clpython/basic" "clpython/parser" "clpython/runtime" "clpython/compiler" "clpython/lib" "clpython/contrib") + :in-order-to ((test-op (test-op "clpython/test"))) + :perform (load-op :after (o c) (show-clpython-quick-start))) ;;; Unit test, linked to asdf operation "test-op" on the CL-Python system -(asdf:defsystem :clpython.test +(defsystem "clpython/test" :description "CLPython tests" - :depends-on (:clpython #-allegro :ptester) + :depends-on ("clpython" #-allegro "ptester") :components ((:module "test" :serial t :components ((:file "tsetup") @@ -160,90 +190,5 @@ (:file "mod-builtins-test") (:file "mod-string-test") (:file "mod-math-test") - (:file "mod-operator-test"))))) - - -(defmethod asdf:perform :after ((op asdf:test-op) (c (eql (asdf:find-system :clpython)))) - (funcall (find-symbol (string '#:run-tests) :clpython.test))) - -(defmethod asdf:operation-done-p ((o asdf:test-op) - (c (eql (asdf:find-system :clpython)))) - "Testing is never finished." - nil) - - -;;; In Allegro, which provides its own Yacc, CL-Yacc can optionally be used. -;;; In other implementations, Allegro Yacc is unavailable - -(let* ((parser-mod (let ((sys (asdf:find-system :clpython.parser))) - (car (asdf:module-components sys))))) - - #+allegro - (let ((cl-yacc-grammar (asdf:find-component parser-mod "grammar-clyacc"))) - - (defmethod asdf:perform :around ((op asdf:load-op) (c (eql cl-yacc-grammar))) - (when (asdf:find-system :yacc nil) - (call-next-method))) - - (defmethod asdf:perform :around ((op asdf:compile-op) (c (eql cl-yacc-grammar))) - (when (asdf:find-system :yacc nil) - (call-next-method)))) - - #-allegro - (let ((allegro-yacc-grammar (asdf:find-component parser-mod "grammar-aclyacc"))) - (defmethod asdf:perform :around ((op asdf:load-op) (c (eql allegro-yacc-grammar))) - nil) - (defmethod asdf:perform :around ((op asdf:compile-op) (c (eql allegro-yacc-grammar))) - nil))) - - -;;; Suppress some warnings about package trickery - -(defmacro suppress-package-warnings (&body body) - `(handler-bind (#+sbcl - (sb-int:package-at-variance #'muffle-warning) - #+lispworks - (simple-warning (lambda (c) - (let ((fmt (slot-value c 'conditions::format-string))) - (when (search "Using DEFPACKAGE" fmt) - (muffle-warning c)))))) - ,@body)) - -(let* ((package-file (let ((sys (asdf:find-system :clpython.basic))) - (car (asdf:module-components sys)))) - (lib-mod (let ((sys (asdf:find-system :clpython.lib))) - (car (asdf:module-components sys)))) - (lib-pkg-file (asdf:find-component lib-mod "psetup")) - (pkg-files (list package-file lib-pkg-file))) - - (#+allegro without-redefinition-warnings ;; invalid complaint about method redefinition - #-allegro progn - - (dolist (pkg-file pkg-files) - - (defmethod asdf:perform :around ((op asdf:compile-op) (c (eql pkg-file))) - (suppress-package-warnings - (call-next-method))) - - (defmethod asdf:perform :around ((op asdf:load-op) (c (eql pkg-file))) - (suppress-package-warnings - (call-next-method)))))) - - -;;; Show usage after loading the system - -(defun show-clpython-quick-start () - (format t "~%CLPython quick start guide:~%") - (format t " Run a string of Python code: (~S \"for i in range(4): print i\")~%" - (find-symbol (string '#:run) :clpython)) - (format t " Run a Python file: (~S #p\"~~/example/foo.py\")~%" - (find-symbol (string '#:run) :clpython)) - (format t " Start the Python \"interpreter\" (REPL): (~S)~%" - (find-symbol (string '#:repl) :clpython.app.repl)) - (format t " To start mixed Python/Lisp input mode: (~S)~%" - (find-symbol (string '#:enter-mixed-lisp-python-syntax) :clpython)) - (format t " Run the test suite: ~S~%~%" - '(asdf:operate 'asdf:test-op :clpython))) - -(defmethod asdf:perform :after ((op asdf:load-op) (c (eql (asdf:find-system :clpython)))) - (show-clpython-quick-start)) + (:file "mod-operator-test")))) + :perform (test-op (o c) (symbol-call :clpython.test :run-tests))) From 11c4ea8c560e5793af819f2656c8549145c84fea Mon Sep 17 00:00:00 2001 From: "Neil T. Dantam" Date: Thu, 22 Sep 2016 17:31:17 -0500 Subject: [PATCH 02/30] Do not derive pathname of module source --- compiler/compiler.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/compiler.lisp b/compiler/compiler.lisp index 0480d54..9600f47 100644 --- a/compiler/compiler.lisp +++ b/compiler/compiler.lisp @@ -1629,7 +1629,7 @@ LOCALS shares share tail structure with input arg locals." :current-module-name ,*current-module-name* :defun-wrappers ',(mapcar #'second defun-wrappers) :source ,(when *compile-file-truename* - (slurp-file (derive-pathname *compile-file-truename*))) + (slurp-file *compile-file-truename*)) :source-func ',module-function-name :compiler-id ,*clpython-compiler-version-id* :is-compiled ,(not (null *compile-file-truename*)))) From 48d3808d58086a62a36a31628f1001b8bdc49146 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Tue, 28 Mar 2017 15:21:52 +0200 Subject: [PATCH 03/30] Fix importing on SBCL by using :CASE :LOCAL instead of :COMMON --- compiler/compiler.lisp | 12 ++++++------ runtime/import.lisp | 25 +++++++++++++++++++------ util/utils.lisp | 13 +++++++------ 3 files changed, 32 insertions(+), 18 deletions(-) diff --git a/compiler/compiler.lisp b/compiler/compiler.lisp index 9600f47..ee46a49 100644 --- a/compiler/compiler.lisp +++ b/compiler/compiler.lisp @@ -1348,7 +1348,7 @@ LOCALS shares share tail structure with input arg locals." `(let ((*module-namespace* nil)) ;; hack (values ,@(loop for (mod-name-as-list bind-name) in items for top-name = (car mod-name-as-list) - collect `(let* ((args (list :within-mod-path ',(careful-derive-pathname *compile-file-truename* nil) + collect `(let* ((args (list :within-mod-path ,*compile-file-truename* :within-mod-name ',*current-module-name*)) (top-module (apply #'py-import '(,top-name) args)) (deep-module ,(if (cdr mod-name-as-list) @@ -1363,7 +1363,7 @@ LOCALS shares share tail structure with input arg locals." (defmacro [import-from-stmt] (mod-name-as-list items) `(let* ((*module-namespace* nil) ;; hack - (args (list :within-mod-path ',(careful-derive-pathname *compile-file-truename* nil) + (args (list :within-mod-path ,*compile-file-truename* :within-mod-name ',*current-module-name*)) (m (apply #'py-import '(,(car mod-name-as-list)) args))) (declare (ignorable m)) ;; Ensure topleve module is imported relative to current mod @@ -1508,9 +1508,9 @@ LOCALS shares share tail structure with input arg locals." (setf *habitat* (make-habitat)))) ||# -(defun careful-derive-pathname (pathname default) +(defun careful-derive-pathname (pathname default &rest options) (if pathname - (derive-pathname pathname) + (apply #'derive-pathname pathname options) default)) (defmacro with-module-toplevel-context (() &body body) @@ -1624,8 +1624,8 @@ LOCALS shares share tail structure with input arg locals." #+clpython-source-level-debugging ,(create-python-source-location-table-pydecl suite) - (module-init :src-pathname ,(careful-derive-pathname *compile-file-truename* nil) - :bin-pathname (load-time-value (careful-derive-pathname *load-truename* #P"__main__")) + (module-init :src-pathname ,*compile-file-truename* + :bin-pathname (load-time-value (careful-derive-pathname *load-truename* #P"__main__" :case #+sbcl :local #-sbcl :common)) :current-module-name ,*current-module-name* :defun-wrappers ',(mapcar #'second defun-wrappers) :source ,(when *compile-file-truename* diff --git a/runtime/import.lisp b/runtime/import.lisp index 28436d6..e70780d 100644 --- a/runtime/import.lisp +++ b/runtime/import.lisp @@ -25,17 +25,30 @@ ;; Pathname handling is as suggested by Kent Pitman on comp.lang.lisp ;; -(defun %get-py-file-name (kind modname filepath type) +(defun %get-py-file-name (kind modname filepath type &key (case :common)) + #+sbcl + (when (member type *py-source-file-types*) + ;; For SBCL don't use :COMMON as that gives case problems; use :LOCAL instead. + ;; https://github.com/metawilm/cl-python/issues/1 + ;; https://github.com/metawilm/cl-python/pull/20 + ;; https://bugs.launchpad.net/sbcl/+bug/695486 + (setf case :local + type (string-downcase type))) + (ecase kind (:module (derive-pathname filepath - :name (pathname-name modname :case :common) - :type type)) + :name (pathname-name modname :case case) + :type type + :case case)) (:package (merge-pathnames - (make-pathname :directory `(:relative ,(pathname-name modname :case :common)) - :case :common) + (make-pathname :directory `(:relative ,(pathname-name modname :case case)) + :case case) (derive-pathname filepath :type type - :name *package-indicator-filename*))))) + :name + #+sbcl (string-downcase *package-indicator-filename*) + #-sbcl *package-indicator-filename* + :case case))))) (defun source-file-names (kind modname filepath) (check-type modname string) diff --git a/util/utils.lisp b/util/utils.lisp index 1686f77..c5afbca 100644 --- a/util/utils.lisp +++ b/util/utils.lisp @@ -326,14 +326,15 @@ See function ALIST-VS-HT.") always (loop for slot in (closer-mop:class-slots class) thereis (member initarg (closer-mop:slot-definition-initargs slot))))) -(defun derive-pathname (pathname &key (type (pathname-type pathname :case :common)) - (name (pathname-name pathname :case :common)) - (host (pathname-host pathname :case :common)) - (device (pathname-device pathname :case :common)) - (directory (pathname-directory pathname :case :common)) +(defun derive-pathname (pathname &key (case :common) + (type (pathname-type pathname :case case)) + (name (pathname-name pathname :case case)) + (host (pathname-host pathname :case case)) + (device (pathname-device pathname :case case)) + (directory (pathname-directory pathname :case case)) (version (pathname-version pathname))) (make-pathname :type type :name name :host host :device device - :directory directory :version version :case :common)) + :directory directory :version version :case case)) (defun ensure-path-is-directory (path) (let* ((truename (truename path)) From ac27ec0ebc22417ae42a9d3f2f9d0290ff8c9ab6 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Tue, 28 Mar 2017 16:15:51 +0200 Subject: [PATCH 04/30] Add :author and :license to ASDF system --- clpython.asd | 2 ++ 1 file changed, 2 insertions(+) diff --git a/clpython.asd b/clpython.asd index 5bf8fc4..bc2ab21 100644 --- a/clpython.asd +++ b/clpython.asd @@ -171,6 +171,8 @@ (defsystem "clpython" :description "CLPython - an implementation of Python in Common Lisp" + :author "Willem Broekema " + :license "LLGPL (Lisp Lesser GNU Public License)" :depends-on ("clpython/basic" "clpython/parser" "clpython/runtime" "clpython/compiler" "clpython/lib" "clpython/contrib") :in-order-to ((test-op (test-op "clpython/test"))) :perform (load-op :after (o c) (show-clpython-quick-start))) From c1187c7dfc399419920f6c02b44e9b1c8a135c3e Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 16 Apr 2017 12:47:27 +0200 Subject: [PATCH 05/30] Fix string.endswith --- runtime/classes.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/runtime/classes.lisp b/runtime/classes.lisp index 03ff2de..3fc8077 100644 --- a/runtime/classes.lisp +++ b/runtime/classes.lisp @@ -3099,7 +3099,8 @@ invocation form.\"") (def-py-method py-string.endswith (x^ suffix &optional start end) (when (or start end) (error "todo")) - (py-bool (string= (subseq x (- (length x) (length suffix))) suffix))) + (py-bool (and (>= (length x) (length suffix)) + (string= (subseq x (- (length x) (length suffix))) suffix)))) (def-py-method py-string.find (x^ item &rest args) (warn "todo :string.find") From e5e3517799e0e565bc3bd9ad9c5feecc3b2fbd04 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sat, 22 Apr 2017 11:46:05 +0200 Subject: [PATCH 06/30] Grammar support for trailing comma in "from sys import (path, argv,)" --- parser/grammar.lisp | 2 +- test/parser-test.lisp | 17 +++++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/parser/grammar.lisp b/parser/grammar.lisp index 24df2fa..0f0f390 100644 --- a/parser/grammar.lisp +++ b/parser/grammar.lisp @@ -352,7 +352,7 @@ Value should be a (weak) EQ hash table: (make-weak-key-hash-table :test 'eq).") (p import-from-2 :or (([*]) $1) ((import-as-name comma--import-as-name*) (cons $1 $2)) - (([(] import-as-name comma--import-as-name* [)]) (cons $2 $3))) + (([(] import-as-name comma--import-as-name* comma? [)]) (cons $2 $3))) (gp comma--import-as-name+) (p comma--import-as-name ([,] import-as-name) $2) diff --git a/test/parser-test.lisp b/test/parser-test.lisp index 4109227..44628d9 100644 --- a/test/parser-test.lisp +++ b/test/parser-test.lisp @@ -85,6 +85,23 @@ (invoke-restart (find-restart 'continue))))) (ps s t)) `([literal-expr] :number ,(expt 10 n-expt))))) + + ;; import + (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import path" t)) + (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import (path)" t)) + (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import (path,)" t)) + + (test-equal '([import-from-stmt] ({sys}) (({path} nil) ({exit} nil))) (ps "from sys import path, exit" t)) + (test-error (ps "from sys import path exit" t) :condition-type '{SyntaxError}) + + (test-equal '([import-from-stmt] ({sys}) (({path} {p}) ({exit} nil))) (ps "from sys import path as p, exit" t)) + (test-equal '([import-from-stmt] ({sys}) (({path} nil) ({exit} {e}))) (ps "from sys import path, exit as e" t)) + + (test-equal '([import-from-stmt] ({sys}) (({path} {p}) ({exit} {e}))) (ps "from sys import path as p, exit as e" t)) + (test-equal '([import-from-stmt] ({sys}) (({path} {p}) ({exit} {e}))) (ps "from sys import (path as p, exit as e)" t)) + (test-equal '([import-from-stmt] ({sys}) (({path} {p}) ({exit} {e}))) (ps "from sys import (path as p, exit as e,)" t)) + (test-equal '([import-from-stmt] ({sys}) (({path} nil) ({exit} {e}))) (ps "from sys import (path, exit as e,)" t)) + (test-error (ps "from sys import (path exit)" t) :condition-type '{SyntaxError}) ;; suffix operations (test-equal '([attributeref-expr] From 9b188ce3c8bf090ed30a6d7b75c6a7912f95dab2 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Fri, 10 Mar 2017 00:03:19 +0100 Subject: [PATCH 07/30] Remove EVAL-WHEN --- runtime/metaclass.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/runtime/metaclass.lisp b/runtime/metaclass.lisp index ed38f8c..c56e422 100644 --- a/runtime/metaclass.lisp +++ b/runtime/metaclass.lisp @@ -13,7 +13,7 @@ ;; Different implementations have different requirements, so let's ;; make everything available all the time. -(eval-when (:compile-toplevel :load-toplevel :execute) + (defclass dict-mixin () ((dict :initarg :dict @@ -135,4 +135,4 @@ (defclass py-notimplemented (object) () (:metaclass py-type)) (defvar *the-notimplemented* (make-instance 'py-notimplemented)) -) ;; eval-when + From f886460363e34c3e21ceef7b3e552ce2cb355366 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Thu, 9 Mar 2017 02:31:10 +0100 Subject: [PATCH 08/30] Work around CCL bug. It's fixed in their code, but not part of CCL 1.11 --- contrib/repl.lisp | 2 +- lib/_collections.lisp | 8 ++++---- runtime/classes.lisp | 36 +++++++++++++++++++++++++----------- test/lang-test.lisp | 1 - 4 files changed, 30 insertions(+), 17 deletions(-) diff --git a/contrib/repl.lisp b/contrib/repl.lisp index 8826311..3927108 100644 --- a/contrib/repl.lisp +++ b/contrib/repl.lisp @@ -434,6 +434,6 @@ Useful when re-parsing copied interpreter input." (let ((prompt (concatenate 'string (string eol-ch) (string p)))) (loop for ix = (search prompt new :test 'string=) while ix do (setf changed t) - (replace new new :start1 (1+ ix) :start2 (+ ix (length prompt))) + (clpython::my-replace new new :start1 (1+ ix) :start2 (+ ix (length prompt))) (setf new (subseq new 0 (1+ (- (length new) (length prompt))))))))) (values new changed))) diff --git a/lib/_collections.lisp b/lib/_collections.lisp index 0967069..60a79c9 100644 --- a/lib/_collections.lisp +++ b/lib/_collections.lisp @@ -28,7 +28,7 @@ (def-py-method deque.append (deque x) (with-slots (max-length vector) deque (if (and max-length (= (length vector) max-length)) - (progn (replace vector vector :start1 0 :end1 (1- (length vector)) :start2 1) ;; shift 1 left + (progn (clpython::my-replace vector vector :start1 0 :end1 (1- (length vector)) :start2 1) ;; shift 1 left (setf (aref vector (1- max-length)) x)) (vector-push-extend x vector))) (load-time-value *the-none*)) @@ -37,7 +37,7 @@ (with-slots (max-length vector) deque (unless (and max-length (= (length vector) max-length)) (vector-push-extend nil vector)) - (replace vector vector :start1 1 :end1 (length vector) :start2 0) ;; shift 1 right + (clpython::my-replace vector vector :start1 1 :end1 (length vector) :start2 0) ;; shift 1 right (setf (aref vector 0) x)) (load-time-value *the-none*)) @@ -72,14 +72,14 @@ (when (zerop (length vector)) (py-raise '{IndexError} "Can't popleft from empty deque.")) (prog1 (aref vector 0) - (replace vector vector :start1 0 :end1 (1- (length vector)) :start2 1) + (clpython::my-replace vector vector :start1 0 :end1 (1- (length vector)) :start2 1) (decf (fill-pointer vector))))) (def-py-method deque.remove (deque val) (with-slots (vector) deque (dotimes (i (length vector)) (when (py-==->lisp-val (aref vector i) val) - (replace vector vector :start1 i :end1 (1- (length vector)) :start2 (1+ i)) + (clpython::my-replace vector vector :start1 i :end1 (1- (length vector)) :start2 (1+ i)) (decf (fill-pointer vector)) (return-from deque.remove (load-time-value *the-none*))))) (py-raise '{ValueError} "Value ~A not found in deque." val)) diff --git a/runtime/classes.lisp b/runtime/classes.lisp index 3fc8077..d72709f 100644 --- a/runtime/classes.lisp +++ b/runtime/classes.lisp @@ -2639,6 +2639,20 @@ invocation form.\"") (1 (return 1))) finally (return 0)))))) +(defmacro my-replace (&rest args) + #-ccl `(cl:replace ,@args) + #+ccl `(my-replace-1 ,@args)) ;; http://trac.clozure.com/ccl/ticket/1412 + +#+ccl +(defun my-replace-1 (sequence1 sequence2 &key (start1 0) (end1 (length sequence1)) (start2 0) (end2 (length sequence2))) + (let* ((copy-length (min (- end1 start1) (- end2 start2))) + (tmp (subseq sequence2 start2 (+ start2 copy-length)))) + (loop for seq1-ix from start1 + for tmp-ix from 0 + repeat copy-length + do (setf (elt sequence1 seq1-ix) (elt tmp tmp-ix))) + sequence1)) + (def-py-method py-list.__delitem__ (x^ item) (typecase item (integer (when (minusp item) @@ -2647,7 +2661,7 @@ invocation form.\"") (py-raise '{ValueError} "del [i] : i outside range (got ~A, length list = ~A)" item (length x))) - (replace x x :start1 item :start2 (1+ item)) + (my-replace x x :start1 item :start2 (1+ item)) (decf (fill-pointer x))) (py-slice (with-slots (start stop step) item (cond ((and (none-p start) (none-p stop) (none-p step)) ;; del x[:] @@ -2660,7 +2674,7 @@ invocation form.\"") ;; nothing to do (:nonempty-slice (destructuring-bind (start-incl stop-incl num) args - (replace x x :start1 start-incl :start2 (1+ stop-incl)) + (my-replace x x :start1 start-incl :start2 (1+ stop-incl)) (decf (fill-pointer x) num))) (:nonempty-stepped-slice (destructuring-bind (start-incl stop-incl step times) args @@ -2670,7 +2684,7 @@ invocation form.\"") (rotatef start-incl stop-incl)) (dotimes (i times) (let ((start-ix (- (+ start-incl (* step i)) i))) - (replace x x :start1 start-ix :start2 (1+ start-ix)))) + (my-replace x x :start1 start-ix :start2 (1+ start-ix)))) (decf (fill-pointer x) times))))))))))) (def-py-method py-list.__eq__ (x^ y^) @@ -2742,7 +2756,7 @@ invocation form.\"") (aref x 0))))) (unless (= x.len 1) (dotimes (i n) - (replace res x :start1 (* i x.len)))) + (my-replace res x :start1 (* i x.len)))) res)) (def-py-method py-list.__repr__ (x^) @@ -2854,7 +2868,7 @@ invocation form.\"") (let ((ix (if (< index 0) (+ index x.len) index))) (if (<= 0 ix (1- x.len)) (prog1 (aref x ix) - (replace x x :start1 ix :start2 (1+ ix)) + (my-replace x x :start1 ix :start2 (1+ ix)) (decf (fill-pointer x))) (py-raise '{IndexError} "list.pop(x, i): ix wrong (got: ~A; x.len: ~A)" @@ -2871,7 +2885,7 @@ invocation form.\"") ;; It's not guaranteed by ANSI that (eq res x). (unless (eq res x) - (replace x res)) + (my-replace x res)) (load-time-value *the-none*))) @@ -2887,7 +2901,7 @@ invocation form.\"") (defun make-py-list-from-list (list) (let* ((len (length list)) (vec (make-array len :adjustable t :fill-pointer t))) - (replace vec list) + (my-replace vec list) vec)) (defun make-py-list-from-vec (vec) @@ -3073,7 +3087,7 @@ invocation form.\"") "" (let ((res (make-array (* n x.len) :element-type 'character))) (dotimes (i n) - (replace res x :start1 (* i x.len))) + (my-replace res x :start1 (* i x.len))) res)))) (def-py-method py-string.__nonzero__ (x^) (py-bool (> (length x) 0))) @@ -3129,12 +3143,12 @@ invocation form.\"") :key #'length :initial-value (* (length x) (1- num-strings)))) (res (make-array tot-num-chars :element-type 'character))) - (replace res (car strings)) + (my-replace res (car strings)) (loop with ix = (length (car strings)) for s in (cdr strings) - do (replace res x :start1 ix) + do (my-replace res x :start1 ix) (incf ix (length x)) - (replace res s :start1 ix) + (my-replace res s :start1 ix) (incf ix (length s))) res))))) diff --git a/test/lang-test.lisp b/test/lang-test.lisp index 1f064e4..4c73792 100644 --- a/test/lang-test.lisp +++ b/test/lang-test.lisp @@ -163,7 +163,6 @@ b = AnotherDoubler(3) assert a * b == 12" :fail-info "Wrong lookup logic for __r...__ methods" ) - (run-no-error "[1,2,3] * 2 == [1,2,3,1,2,3]") (run-no-error "(1,2,3) * 2 == (1,2,3,1,2,3)")) (defmethod test-lang ((kind (eql :binary-lazy-expr))) From b889dd9fbd35d27fe6c371870291a5b1123838df Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Thu, 9 Mar 2017 00:13:50 +0100 Subject: [PATCH 09/30] Fix error when calling RUN-PYTHON-AST during loading of a Lisp file --- compiler/compiler.lisp | 4 ++++ runtime/classes.lisp | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/compiler/compiler.lisp b/compiler/compiler.lisp index ee46a49..0304a4a 100644 --- a/compiler/compiler.lisp +++ b/compiler/compiler.lisp @@ -157,6 +157,10 @@ HABITAT is the execution environment; a fresh one will be used otherwie. If COMPILE is true, the AST is compiled into a function before running. MODULE-RUN-ARGS is a list with options passed on to the module-function; e.g. %module-globals, module-name, src-module-path. ARGS are the command-line args, available as `sys.argv'; can be a string (which will be splitted on spaces) or a list of strings." + + (unless (and (listp ast) (eq (car ast) '[module-stmt])) + (error "Not an AST: ~S" ast)) + ;; At the moment there are only hashtable or package module namespaces: (with-compiler-generated-syntax-errors () (handler-bind (#+sbcl diff --git a/runtime/classes.lisp b/runtime/classes.lisp index d72709f..3d1446d 100644 --- a/runtime/classes.lisp +++ b/runtime/classes.lisp @@ -1543,7 +1543,8 @@ but the latter two classes are not in CPython.") ;; REPL (setf packagep nil)) (t - (error "Can't determine :packagep for ~S: no src-pathname" m)))) + ;; This can happen when loading a Lisp file that calls RUN-PYTHON-AST during load. + ))) (check-type (module-ht m) hash-table) ;; XXX or custom ht (setf (gethash m *all-modules*) t)) From f27379387b98117cc7a0910e3de515f7754bf3f9 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 12 Mar 2017 19:21:25 +0100 Subject: [PATCH 10/30] Fix warning --- util/utils.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/util/utils.lisp b/util/utils.lisp index c5afbca..5de3426 100644 --- a/util/utils.lisp +++ b/util/utils.lisp @@ -106,7 +106,7 @@ If the stream length can not be determined (e.g. for standard input), all availa ((equal array-element-type '(unsigned-byte 8)) (map 'string #'code-char vec)))))) -(defmacro checking-reader-conditionals (&whole whole &body body) +(defmacro checking-reader-conditionals (&body body) "Break unless the body contains exactly one form. Based on idea from Steve Haflich." (let ((num (length body))) (unless (= num 1) From b1953120cb5704e1ae3c56b530fba18b629a7141 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 5 Mar 2017 21:28:52 +0100 Subject: [PATCH 11/30] Fixes for ABCL and CLISP. Report build status and coverage in README using Travis CI. --- .travis.yml | 70 ++++++++++++++++++++++++++++++++++++++++++ README.md | 39 +++++++++-------------- clpython.asd | 2 +- compiler/compiler.lisp | 1 - parser/lexer.lisp | 5 +-- runtime/classes.lisp | 15 ++++----- runtime/dictattr.lisp | 12 +++++--- runtime/metaclass.lisp | 2 +- test/parser-test.lisp | 8 +++-- test/tsetup.lisp | 8 +++-- util/utils.lisp | 4 +-- 11 files changed, 116 insertions(+), 50 deletions(-) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..710dc28 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,70 @@ +language: common-lisp +sudo: required + +env: + matrix: + - LISP=abcl CATCH=1 + - LISP=abcl NOCATCH=1 + + - LISP=allegro CATCH=1 + - LISP=allegro NOCATCH=1 + + # Error outside our control: + # The command "curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash" failed and exited with 1 during . + # - LISP=allegromodern + + # Error outside our control: CCL 1.10 and cl-coveralls don't work together (see also cl-coveralls README): + # [package cl-coveralls] Not supported implementation: Clozure Common Lisp Version 1.10-r16196 (LinuxX8664) + # Therefore use CCL without coverage + #- LISP=ccl COVERALLS=true + - LISP=ccl + + - LISP=clisp + + # Error outside our control: + # /home/travis/.cim/bin/cl: 9: .: Can't open /home/travis/.cim/config/current.7469 + #- LISP=cmucl + + - LISP=ecl CATCH=1 + - LISP=ecl NOCATCH=1 + + - LISP=sbcl COVERALLS=true + +install: + # Install cl-travis + - curl https://raw.githubusercontent.com/metawilm/cl-travis/dev/install.sh | bash + #- curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash + # Newest Dexador needed for cl-coveralls -- https://github.com/fukamachi/cl-coveralls/issues/10 + - git clone https://github.com/fukamachi/dexador.git ~/lisp/dexador + # Our project + - git clone https://github.com/metawilm/cl-python.git ~/lisp/cl-python + +script: + # Use SBCL for coverage + # Let CLISP print a backtrace, because it errs + + - cl -e '(in-package :cl-user)' + -e '(print *package*)' + -e '(ql:quickload :ptester)' + -e '#+sbcl (ql:quickload :cl-coveralls)' + -e '#+sbcl (defmacro outer (&body body) `(coveralls:with-coveralls () ,@body))' + -e '#-sbcl (defmacro outer (&body body) `(progn ,@body))' + -e '(defun do-test () + (ql:quickload :clpython) + (ql:quickload :clpython/test) + (funcall (read-from-string "clpython.test:run-tests")))' + -e '(when (asdf/os:getenv "NOCATCH") + (do-test))' + -e '(unless (asdf/os:getenv "NOCATCH") + (let (ret normal-exit) + (unwind-protect + (outer + (setf ret (do-test)) + (setf normal-exit t)) + (cond ((and normal-exit (eq ret t)) (warn "Test suite SUCCESS") (uiop:quit 0)) + (normal-exit (warn "Test suite FAIL") (uiop:quit -1)) + (t (warn "Unexpected abort during test suite") (uiop:quit -1))))))' + +notifications: + email: + - metawilm@gmail.com \ No newline at end of file diff --git a/README.md b/README.md index fe033a7..071f77f 100644 --- a/README.md +++ b/README.md @@ -6,34 +6,23 @@ With CLPython you can run Python programs in a Lisp environment. Libraries writt in Lisp are available to Python code, and Python libraries can be accessed by Lisp code. Also Python and Lisp code can be mixed. -CLPython is developed by Willem Broekema and is released as open source under the -[LLGPL](http://opensource.franz.com/preamble.html). - -The project was started in 2006, and is currently (2013) not under active development anymore. - -The git address changed on Feb 4, 2014 from: github.com/franzinc/cl-python.git to: github.com/metawilm/cl-python.git - -Documentation -------------- - -Please see the [Introduction](http://common-lisp.net/project/clpython/index.html) and +For rough documentation, please see the [Introduction](http://common-lisp.net/project/clpython/index.html) and [Manual](http://common-lisp.net/project/clpython/manual.html) on *common-lisp.net*. -Requirements ------------- - -CLPython runs successfully on: +To install using QuickLisp: `(ql:quickload "clpython")` -* [Allegro CL 8.2 (ANSI and Modern)](http://franz.com/products/allegrocl/) -* [Clozure CL 1.5-r13651](http://clozure.com/clozurecl.html) -* [CMUCL 20b-pre2](http://www.cons.org/cmucl/) -* [ECL (git: 2011.02.11)](http://ecls.sourceforge.net/) -* [LispWorks 6.0](http://www.lispworks.com/) -* [SBCL 1.0.45](http://sbcl.sourceforge.net/) +CLPython is developed by Willem Broekema and is released as open source under the [LLGPL](http://opensource.franz.com/preamble.html). +The project was started in 2006, and is since 2013 not under active development anymore. -Install -------- +| Common Lisp Implementation | Build + Test Status | | +|:-:|:-:|:-:| +| [ABCL](https://common-lisp.net/project/armedbear/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=abcl+CATCH&label=ABCL)](https://travis-ci.org/metawilm/cl-python) | Fails due to NullPointerException | +| [Allegro CL](http://franz.com/products/allegrocl/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=allegro+CATCH&label=Allegro+CL)](https://travis-ci.org/metawilm/cl-python) | | +| [Clozure CL](http://clozure.com/clozurecl.html) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=ccl&label=Clozure+CL)](https://travis-ci.org/metawilm/cl-python) | | +| [CLISP](http://clisp.sourceforge.net) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=clisp&label=CLISP)](https://travis-ci.org/metawilm/cl-python) | Fails due to stack overflow | +| [CMUCL](http://www.cons.org/cmucl/) | ? | | +| [ECL](http://ecls.sourceforge.net/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=ecl+CATCH&label=ECL)](https://travis-ci.org/metawilm/cl-python) | | +| [LispWorks](http://www.lispworks.com/) | ? | | +| [SBCL](http://sbcl.sourceforge.net/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=sbcl&label=SBCL)](https://travis-ci.org/metawilm/cl-python) [![Coverage Status](https://coveralls.io/repos/metawilm/cl-python/badge.svg?branch=dev)](https://coveralls.io/r/metawilm/cl-python?branch=dev) | | -Using QuickLisp: - (ql:quickload "clpython") diff --git a/clpython.asd b/clpython.asd index bc2ab21..7813bc7 100644 --- a/clpython.asd +++ b/clpython.asd @@ -83,7 +83,7 @@ (defsystem "clpython/runtime" :description "Python runtime environment" - :depends-on ("clpython/basic" "closer-mop" #+ecl "cl-custom-hash-table" "cl-fad") + :depends-on ("clpython/basic" "closer-mop" #+(or abcl clisp ecl) "cl-custom-hash-table" "cl-fad") :components ((:module "runtime" :serial t :components ((:file "rsetup" ) diff --git a/compiler/compiler.lisp b/compiler/compiler.lisp index 0304a4a..8f2ee52 100644 --- a/compiler/compiler.lisp +++ b/compiler/compiler.lisp @@ -179,7 +179,6 @@ ARGS are the command-line args, available as `sys.argv'; can be a string (which (warn "Compilation failed: ~S" c) (return-from compilation nil)))) (compile nil get-module-f))) - (declare (ignore warnings-p)) (cond (func (setf fc func)) (t diff --git a/parser/lexer.lisp b/parser/lexer.lisp index bed055a..48a548c 100644 --- a/parser/lexer.lisp +++ b/parser/lexer.lisp @@ -603,9 +603,10 @@ Used by compiler to generate 'forbidden' identfiers.") Returns character or NIL." (when (plusp (length python-name)) (let* ((division-char (checking-reader-conditionals - #+(or allegro ccl sbcl) #\_ + #+(or allegro ccl clisp sbcl) #\_ #+(or ecl cmu) nil - #+lispworks #\- )) + #+lispworks #\- + #+abcl (error "Looking up Unicode character by name is not supported on ABCL"))) (lisp-char-name (if division-char (substitute division-char #\Space python-name) python-name))) diff --git a/runtime/classes.lisp b/runtime/classes.lisp index 3d1446d..cb55c7f 100644 --- a/runtime/classes.lisp +++ b/runtime/classes.lisp @@ -605,8 +605,8 @@ (defparameter *create-simple-lambdas-for-python-functions* (checking-reader-conditionals #+(or allegro lispworks) nil - #+sbcl t - #-(or allegro lispworks sbcl) t) + #+(or abcl sbcl) t + #-(or abcl allegro lispworks sbcl) t) "Whether Python function are real CLOS funcallable instances, or just normal lambdas. Note that in the latter case, functions miss their name and attribute dict, but should otherwise work well.") @@ -630,7 +630,8 @@ otherwise work well.") ;; which is not quite kosher. (:method ((x function)) x)) -(defclass py-function (standard-generic-function dicted-object) +(defclass py-function (#-clisp standard-generic-function + dicted-object) ;; mop:funcallable-standard-class defines :name initarg, but how to to access it portably... ((fname :initarg :fname :initform nil :accessor py-function-name) (context-name :initarg :context-name :initform nil :accessor py-function-context-name) @@ -1341,7 +1342,6 @@ Basically the Python equivalent of ENSURE-CLASS." (def-py-method py-type.__nonzero__ (cls) ;; to make e.g. "if str: ..." work - (declare (ignore cls)) +the-true+) (def-py-method py-type.__dict__ :attribute-read (cls) @@ -4025,7 +4025,7 @@ finished; F will then not be called again." +the-false+))) (setf (gethash ',syntax *binary-comparison-funcs-ht*) ',func))) -#+ecl +#+(or abcl ecl) (defvar *py-id-entries* (make-weak-key-hash-table)) (defun py-id (x) @@ -4035,9 +4035,10 @@ fixed id during the object's lifetime." (checking-reader-conditionals #+allegro (excl:lispval-to-address x) #+ccl (ccl:%address-of x) + #+clisp (system::address-of x) #+cmu (kernel:get-lisp-obj-address x) - #+ecl (or #1=(gethash x *py-id-entries*) - (setf #1# (hash-table-count *py-id-entries*))) + #+(or abcl ecl) (or #1=(gethash x *py-id-entries*) + (setf #1# (hash-table-count *py-id-entries*))) #+lispworks (system:object-address x) #+sbcl (sb-kernel:get-lisp-obj-address x))) diff --git a/runtime/dictattr.lisp b/runtime/dictattr.lisp index e261532..d122e79 100644 --- a/runtime/dictattr.lisp +++ b/runtime/dictattr.lisp @@ -66,8 +66,10 @@ (defconstant-once +py-class-classname-slot-name+ (checking-reader-conditionals + #+abcl 'mop::name #+allegro 'excl::name #+ccl 'ccl::name + #+clisp 'clos::$classname #+cmu 'pcl::name #+ecl 'clos::name #+lispworks 'clos::name @@ -76,16 +78,16 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defconstant +use-standard-instance-access+ - (checking-reader-conditionals - #+ecl nil - #+(or allegro ccl cmu lispworks sbcl) t)) + (checking-reader-conditionals + #+(or abcl ecl) nil ;; Need to look into ABCL, got NullPointerException in test case + #+(or allegro ccl clisp cmu lispworks sbcl) t)) (register-feature :clpython-use-standard-instance-access +use-standard-instance-access+) (defconstant +use-standard-instance-access-setf+ (checking-reader-conditionals - #+(or allegro ccl lispworks sbcl) t - #+(or cmu ecl) nil ;; these lack (SETF STANDARD-INSTANCE-ACCESS) + #+(or allegro ccl clisp lispworks sbcl) t + #+(or abcl cmu ecl) nil ;; these lack (SETF STANDARD-INSTANCE-ACCESS) )) (register-feature :clpython-use-standard-instance-access-setf +use-standard-instance-access-setf+)) diff --git a/runtime/metaclass.lisp b/runtime/metaclass.lisp index c56e422..1f26f7f 100644 --- a/runtime/metaclass.lisp +++ b/runtime/metaclass.lisp @@ -110,7 +110,7 @@ (defun make-py-hash-table () (make-hash-table :test 'py-hash-table-test))) - #+ecl + #+(or abcl clisp ecl) (cl-custom-hash-table:define-custom-hash-table-constructor make-py-hash-table :test py-==->lisp-val :hash-function py-hash) diff --git a/test/parser-test.lisp b/test/parser-test.lisp index 44628d9..1b81ad6 100644 --- a/test/parser-test.lisp +++ b/test/parser-test.lisp @@ -313,16 +313,18 @@ if 1 > \\ (test-error (ps "\\1" t) :condition-type '{SyntaxError}) ;; unicode - #-ecl + #-(or abcl ecl) (test-equal (ps (concatenate 'string "u'\\N{" #1="Latin Small Letter Y With Acute" "}'") t) `([literal-expr] :string ,(coerce (list (or (clpython.parser::lisp-char-by-python-name #1#) (error "Unicode char ~A not available in this Lisp?" #1#))) 'string))) - #-(or ecl lispworks) ;; Lispworks has no names for chars > 255 + #-(or abcl ecl lispworks) ;; Lispworks has no names for chars > 255 (test-equal (ps "u'\\N{latin capital letter l with stroke}'" t) `([literal-expr] :string - ,(coerce (list (name-char "latin_capital_letter_l_with_stroke")) 'string))) + ,(coerce (list (or (name-char "latin_capital_letter_l_with_stroke") + (error "No name-char for unicode chars in this implementation?"))) + 'string))) #-ecl (test-equal (ps "u'\\u0141 \\U00000141'" t) `([literal-expr] :string diff --git a/test/tsetup.lisp b/test/tsetup.lisp index 599aabf..f2afa09 100644 --- a/test/tsetup.lisp +++ b/test/tsetup.lisp @@ -151,10 +151,12 @@ seems to give implementations some freedom here. (In practice: Allegro=NIL, LisW (run-mod-string-test) (run-mod-math-test) (run-mod-operator-test) - + (setf final-result (not (plusp *test-unexpected-failures*)) successes *test-successes* errors *test-errors* unexpected-failures *test-unexpected-failures*)) - (values final-result - successes errors unexpected-failures))) + + (let ((vals (list final-result successes errors unexpected-failures))) + (format t "~%Return values of RUN-TESTS: ~A" vals) + (values-list vals)))) diff --git a/util/utils.lisp b/util/utils.lisp index 5de3426..71fb3a7 100644 --- a/util/utils.lisp +++ b/util/utils.lisp @@ -110,7 +110,7 @@ If the stream length can not be determined (e.g. for standard input), all availa "Break unless the body contains exactly one form. Based on idea from Steve Haflich." (let ((num (length body))) (unless (= num 1) - (error "A CHECKING-READER-CONDITIONALS expression returned ~r forms: ~s" num whole)) + (error "A CHECKING-READER-CONDITIONALS expression returned ~r forms, in: ~A" num (or *compile-file-truename* *load-truename*))) (car body))) (defmacro named-function (name lambda-form) @@ -247,7 +247,7 @@ See function ALIST-VS-HT.") (check-type code integer) (checking-reader-conditionals #+allegro (excl:exit code :quiet t) - #+cmu (ext:quit code) + #+(or clisp cmu) (ext:quit code) #+lispworks (lw:quit :status code) #+sbcl (sb-ext:exit :code (or code 0)) #+(or openmcl mcl) (ccl::quit) From c1be87d3b759a0eb15ee1e72e7bc7972320d61de Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sat, 22 Apr 2017 13:02:38 +0200 Subject: [PATCH 12/30] Fix optional dependency on CL-Yacc --- clpython.asd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/clpython.asd b/clpython.asd index 7813bc7..d0aa9e0 100644 --- a/clpython.asd +++ b/clpython.asd @@ -49,21 +49,21 @@ (:file "aupprint"))))) ;;; In Allegro, which provides its own Yacc, CL-Yacc can optionally be used. -;;; In other implementations, Allegro Yacc is unavailable +;;; In other implementations CL-Yacc must be used. (when (asdf:find-system "yacc" nil) - (pushnew :use-cl-yacc *features*)) + (pushnew :have-cl-yacc *features*)) (defsystem "clpython/parser" :description "Python parser, code walker, and pretty printer" :depends-on ("clpython/basic" "closer-mop" - (:feature (:or :allegro :use-cl-yacc) "yacc")) + (:feature (:or (:not :allegro) :have-cl-yacc) "yacc")) :components ((:module "parser" :components ((:file "grammar" ) (:file "lexer" :depends-on ("grammar")) (:file "parser" :depends-on ("grammar" "lexer")) (:file "grammar-aclyacc" :depends-on ("grammar" "lexer" "parser") :if-feature :allegro) - (:file "grammar-clyacc" :depends-on ("grammar" "lexer" "parser") :if-feature :use-cl-yacc) + (:file "grammar-clyacc" :depends-on ("grammar" "lexer" "parser") :if-feature (:or (:not :allegro) :have-cl-yacc)) (:file "ast-util" :depends-on ("grammar")) (:file "walk" ) (:file "pprint" ))))) From 7f0be4fdef5ea0a514a1bc6185a3b3c21ad4dca4 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 23 Apr 2017 21:45:49 +0200 Subject: [PATCH 13/30] Add parser support for relative import. --- compiler/compiler.lisp | 4 ++++ parser/grammar.lisp | 7 ++++++- parser/lexer.lisp | 16 +++++++++++++++- test/parser-test.lisp | 8 ++++++++ 4 files changed, 33 insertions(+), 2 deletions(-) diff --git a/compiler/compiler.lisp b/compiler/compiler.lisp index 8f2ee52..051fd13 100644 --- a/compiler/compiler.lisp +++ b/compiler/compiler.lisp @@ -1365,6 +1365,10 @@ LOCALS shares share tail structure with input arg locals." (defvar *inside-import-from-stmt* nil) ;; hack (defmacro [import-from-stmt] (mod-name-as-list items) + (when (eq (car mod-name-as-list) '[.]) + (error "Relative imports are not yet supported by the compiler: ~A" + (with-output-to-string (s) + (py-pprint `([import-from-stmt] ,mod-name-as-list ,items) s)))) `(let* ((*module-namespace* nil) ;; hack (args (list :within-mod-path ,*compile-file-truename* :within-mod-name ',*current-module-name*)) diff --git a/parser/grammar.lisp b/parser/grammar.lisp index 0f0f390..65e73ea 100644 --- a/parser/grammar.lisp +++ b/parser/grammar.lisp @@ -348,12 +348,17 @@ Value should be a (weak) EQ hash table: (make-weak-key-hash-table :test 'eq).") (gp comma--dotted-as-name+) (p comma--dotted-as-name ([,] dotted-as-name) $2) -(p import-from ([from] dotted-name [import] import-from-2) `([import-from-stmt] ,$2 ,$4)) +(p import-from ([from] dotted-name [import] import-from-2) `([import-from-stmt] ,$2 ,$4)) +(p import-from ([from] dots dotted-name? [import] import-from-2) `([import-from-stmt] ,(nconc $2 $3) ,$5)) + (p import-from-2 :or (([*]) $1) ((import-as-name comma--import-as-name*) (cons $1 $2)) (([(] import-as-name comma--import-as-name* comma? [)]) (cons $2 $3))) +(p dots ([.]) (list $1)) +(p dots (dots [.]) (nconc $1 (list $2))) + (gp comma--import-as-name+) (p comma--import-as-name ([,] import-as-name) $2) diff --git a/parser/lexer.lisp b/parser/lexer.lisp index 48a548c..a40750b 100644 --- a/parser/lexer.lisp +++ b/parser/lexer.lisp @@ -100,7 +100,8 @@ where TOKEN-KIND is a symbol like '[identifier]" (bracket-level :accessor ls-bracket-level :initform 0 :type fixnum) (open-deco :initform nil) (return-count :initform 0) - (last-newline-in-source :reader ls-last-newline-in-source :initform :unknown)) + (last-newline-in-source :reader ls-last-newline-in-source :initform :unknown) + (last-returned-value :accessor ls-last-returned-value :initform nil)) (:metaclass closer-mop:funcallable-standard-class)) (defmethod print-object ((lexer lexer) stream) @@ -124,6 +125,7 @@ where TOKEN-KIND is a symbol like '[identifier]" (define-symbol-macro %lex-curr-line-no% (ls-curr-line-no *lex-state*)) (define-symbol-macro %lex-string% (ls-string *lex-state*)) (define-symbol-macro %lex-tab-width% (ls-tab-width *lex-state*)) +(define-symbol-macro %lex-last-returned-value% (ls-last-returned-value *lex-state*)) (defgeneric call-lexer (yacc-version lexer op) (:documentation "Returns either the eof-token, or two values: TOKEN-KIND, TOKEN-VALUE")) @@ -162,6 +164,7 @@ On EOF returns: eof-token, eof-token." (flet ((lex-return (token value source-loc &optional msg) (when *lex-debug* (format t "Lexer returns: ~S ~S ~S~@[ ~A~]~%" token value source-loc msg)) (incf return-count) + (setf %lex-last-returned-value% value) (return-from call-lexer (values token value source-loc))) (lex-todo (token value) (when *lex-debug* (format t "Lexer todo: ~S ~S~%" token value)) @@ -234,6 +237,12 @@ On EOF returns: eof-token, eof-token." (read-kind :string c) (lex-return '[literal-expr] (list '[literal-expr] :string val) source-loc))) + ((and (char= c #\.) + (member %lex-last-returned-value% '([from] [.]))) + (multiple-value-bind (val source-loc) + (read-kind :dot c) + (lex-return val val source-loc))) + ((or (punct-char1-p c) (punct-char-not-punct-char1-p c)) (multiple-value-bind (token source-loc) @@ -422,6 +431,11 @@ Used by compiler to generate 'forbidden' identfiers.") (or (find-symbol str (load-time-value (find-package :clpython.ast.reserved))) (intern str (load-time-value (find-package :clpython.user)))))) +(defmethod read-kind ((kind (eql :dot)) c1 &rest args) + (declare (ignorable kind)) + (assert (char= c1 #\.)) + '[.]) + ;; String (defmethod read-kind ((kind (eql :string)) ch1 &key raw unicode) diff --git a/test/parser-test.lisp b/test/parser-test.lisp index 1b81ad6..6da3acf 100644 --- a/test/parser-test.lisp +++ b/test/parser-test.lisp @@ -87,6 +87,8 @@ `([literal-expr] :number ,(expt 10 n-expt))))) ;; import + (test-equal '([import-from-stmt] ({a} {b}) (({c} nil))) (ps "from a.b import c" t)) + (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import path" t)) (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import (path)" t)) (test-equal '([import-from-stmt] ({sys}) (({path} nil))) (ps "from sys import (path,)" t)) @@ -103,6 +105,12 @@ (test-equal '([import-from-stmt] ({sys}) (({path} nil) ({exit} {e}))) (ps "from sys import (path, exit as e,)" t)) (test-error (ps "from sys import (path exit)" t) :condition-type '{SyntaxError}) + (test-equal '([import-from-stmt] ([.] ) (({b} nil))) (ps "from . import b" t)) + (test-equal '([import-from-stmt] ([.] {a} ) (({b} nil))) (ps "from .a import b" t)) + (test-equal '([import-from-stmt] ([.] [.] {a} ) (({b} nil))) (ps "from ..a import b" t)) + (test-equal '([import-from-stmt] ([.] [.] [.] {a} ) (({b} nil))) (ps "from ...a import b" t)) + (test-equal '([import-from-stmt] ([.] [.] [.] {a} {b}) (({c} nil))) (ps "from ...a.b import c" t)) + ;; suffix operations (test-equal '([attributeref-expr] ([call-expr] From d0c935cd4db7380dbc1e6fdade616680335909d4 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 23 Apr 2017 21:48:59 +0200 Subject: [PATCH 14/30] Link to correct branch, master --- README.md | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index 071f77f..7f7efc7 100644 --- a/README.md +++ b/README.md @@ -16,13 +16,13 @@ The project was started in 2006, and is since 2013 not under active development | Common Lisp Implementation | Build + Test Status | | |:-:|:-:|:-:| -| [ABCL](https://common-lisp.net/project/armedbear/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=abcl+CATCH&label=ABCL)](https://travis-ci.org/metawilm/cl-python) | Fails due to NullPointerException | -| [Allegro CL](http://franz.com/products/allegrocl/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=allegro+CATCH&label=Allegro+CL)](https://travis-ci.org/metawilm/cl-python) | | -| [Clozure CL](http://clozure.com/clozurecl.html) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=ccl&label=Clozure+CL)](https://travis-ci.org/metawilm/cl-python) | | -| [CLISP](http://clisp.sourceforge.net) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=clisp&label=CLISP)](https://travis-ci.org/metawilm/cl-python) | Fails due to stack overflow | +| [ABCL](https://common-lisp.net/project/armedbear/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=abcl+CATCH&label=ABCL)](https://travis-ci.org/metawilm/cl-python) | Fails due to NullPointerException | +| [Allegro CL](http://franz.com/products/allegrocl/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=allegro+CATCH&label=Allegro+CL)](https://travis-ci.org/metawilm/cl-python) | | +| [Clozure CL](http://clozure.com/clozurecl.html) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=ccl&label=Clozure+CL)](https://travis-ci.org/metawilm/cl-python) | | +| [CLISP](http://clisp.sourceforge.net) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=clisp&label=CLISP)](https://travis-ci.org/metawilm/cl-python) | Fails due to stack overflow | | [CMUCL](http://www.cons.org/cmucl/) | ? | | -| [ECL](http://ecls.sourceforge.net/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=ecl+CATCH&label=ECL)](https://travis-ci.org/metawilm/cl-python) | | +| [ECL](http://ecls.sourceforge.net/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=ecl+CATCH&label=ECL)](https://travis-ci.org/metawilm/cl-python) | | | [LispWorks](http://www.lispworks.com/) | ? | | -| [SBCL](http://sbcl.sourceforge.net/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=dev&envContains=sbcl&label=SBCL)](https://travis-ci.org/metawilm/cl-python) [![Coverage Status](https://coveralls.io/repos/metawilm/cl-python/badge.svg?branch=dev)](https://coveralls.io/r/metawilm/cl-python?branch=dev) | | +| [SBCL](http://sbcl.sourceforge.net/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=sbcl&label=SBCL)](https://travis-ci.org/metawilm/cl-python) [![Coverage Status](https://coveralls.io/repos/metawilm/cl-python/badge.svg?branch=master)](https://coveralls.io/r/metawilm/cl-python?branch=master) | | From 23c71737617b898cf755395f6ebce8bdd14b96d1 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 5 Nov 2017 14:47:08 +0100 Subject: [PATCH 15/30] Add ASDF 3.3 requirement --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 7f7efc7..c34bd54 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ Also Python and Lisp code can be mixed. For rough documentation, please see the [Introduction](http://common-lisp.net/project/clpython/index.html) and [Manual](http://common-lisp.net/project/clpython/manual.html) on *common-lisp.net*. -To install using QuickLisp: `(ql:quickload "clpython")` +To install using QuickLisp: `(ql:quickload "clpython")` (require ASDF 3.3 or higher). CLPython is developed by Willem Broekema and is released as open source under the [LLGPL](http://opensource.franz.com/preamble.html). The project was started in 2006, and is since 2013 not under active development anymore. From da04e65553c4ff8082a1e16d023dce7cde7dc7dd Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 5 Nov 2017 21:35:14 +0100 Subject: [PATCH 16/30] Fix warnings on ABCL --- parser/lexer.lisp | 3 ++- util/utils.lisp | 5 +++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/parser/lexer.lisp b/parser/lexer.lisp index a40750b..293e62b 100644 --- a/parser/lexer.lisp +++ b/parser/lexer.lisp @@ -432,8 +432,9 @@ Used by compiler to generate 'forbidden' identfiers.") (intern str (load-time-value (find-package :clpython.user)))))) (defmethod read-kind ((kind (eql :dot)) c1 &rest args) - (declare (ignorable kind)) + (declare (ignorable kind) (dynamic-extent args)) (assert (char= c1 #\.)) + (assert (null args)) '[.]) ;; String diff --git a/util/utils.lisp b/util/utils.lisp index 71fb3a7..aeffff7 100644 --- a/util/utils.lisp +++ b/util/utils.lisp @@ -14,8 +14,9 @@ filename) &body body) "Automatically recompile when FASL is apparently intended for another implementation" - (declare (ignorable restart-name)) - `(flet ((.invoke-recompile-restart (&optional c) + (declare (ignorable restart-name filename)) + `(flet (#+(or allegro ccl sbcl lispworks) + (.invoke-recompile-restart (&optional c) (declare (ignore c)) ,(when restart-name `(progn From e5ea8292d9047356869fd179521da103b5f81ac4 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 5 Nov 2017 21:36:17 +0100 Subject: [PATCH 17/30] Explicitly load some libraries for SBCL QuickLisp apparently did not detect these dependencies. --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 710dc28..79f0851 100644 --- a/.travis.yml +++ b/.travis.yml @@ -46,6 +46,7 @@ script: - cl -e '(in-package :cl-user)' -e '(print *package*)' -e '(ql:quickload :ptester)' + -e '(when (member :sbcl *features*) (dolist (s (quote (:trivial-features :babel))) (ql:quickload s)))' -e '#+sbcl (ql:quickload :cl-coveralls)' -e '#+sbcl (defmacro outer (&body body) `(coveralls:with-coveralls () ,@body))' -e '#-sbcl (defmacro outer (&body body) `(progn ,@body))' From 4d25d817f811b46b6e7e4e2db40d0ccd1d6167e5 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Tue, 7 Nov 2017 22:25:31 +0100 Subject: [PATCH 18/30] Fix symbol references --- lib/datetime.lisp | 18 +++++++++--------- lib/operator.lisp | 2 +- lib/posix.lisp | 2 +- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/datetime.lisp b/lib/datetime.lisp index bc59e4d..55c4b3c 100644 --- a/lib/datetime.lisp +++ b/lib/datetime.lisp @@ -10,28 +10,28 @@ (in-package :clpython.module.datetime) (defclass |date| (object) - ((year :accessor date.year) - (month :accessor date.month) - (day :accessor date.day)) + ((year :accessor date-year) + (month :accessor date-month) + (day :accessor date-day)) (:metaclass py-type)) (def-py-method |date.year| :attribute-read (x) - (date.year x)) + (date-year x)) (def-py-method |date.year| :attribute-write (x val) - (setf (date.year x) val)) + (setf (date-year x) val)) (def-py-method |date.month| :attribute-read (x) - (date.month x)) + (date-month x)) (def-py-method |date.month| :attribute-write (x val) - (setf (date.month x) val)) + (setf (date-month x) val)) (def-py-method |date.day| :attribute-read (x) - (date.day x)) + (date-day x)) (def-py-method |date.day| :attribute-write (x val) - (setf (date.day x) val)) + (setf (date-day x) val)) (def-py-method |date.strftime| (x format) (error "TODO")) diff --git a/lib/operator.lisp b/lib/operator.lisp index b874e6a..9a8b3a2 100644 --- a/lib/operator.lisp +++ b/lib/operator.lisp @@ -248,7 +248,7 @@ The items can be any type accepted by the operand's __getitem__() method. Dictio accept any hashable value. Lists, tuples, and strings accept an index or a slice." (cond ((null items) (py-raise '{ValueError} "One or more items must be provided.")) - ((not (cdr items)) + ((cl:not (cdr items)) (named-function :itemgetter (lambda (obj &aux (item (car items))) (py-subs obj item)))) diff --git a/lib/posix.lisp b/lib/posix.lisp index 8d2a8a3..2716048 100644 --- a/lib/posix.lisp +++ b/lib/posix.lisp @@ -50,7 +50,7 @@ (defun |unlink| (path) (declare (ignore path)) - (error "TODO: posix.unlink(path)")) + (cl:error "TODO: posix.unlink(path)")) (defconstant-once |error| (find-class '{OSError})) From c140ce6d974151a04066df0c818daf6698b89a51 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Wed, 8 Nov 2017 10:21:28 +0100 Subject: [PATCH 19/30] Cleaner handling of maps that are either dict or cl-custom-hash-table --- compiler/compiler.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/compiler.lisp b/compiler/compiler.lisp index 051fd13..d88904d 100644 --- a/compiler/compiler.lisp +++ b/compiler/compiler.lisp @@ -200,7 +200,7 @@ ARGS are the command-line args, available as `sys.argv'; can be a string (which (let ((*habitat* (or habitat (make-habitat)))) (unless module-globals (setf module-globals (habitat-module-globals *habitat*))) - (check-type module-globals (or hash-table package #+ecl cl-custom-hash-table::custom-hash-table)) + (assert (with-py-dict (hash-table-p module-globals))) (when args-p (setf (habitat-cmd-line-args *habitat*) args)) (flet ((run () @@ -1545,7 +1545,7 @@ LOCALS shares share tail structure with input arg locals." (multiple-value-bind (module module-new-p) (ensure-module :src-pathname src-pathname :bin-pathname bin-pathname :name current-module-name) (let ((%module-globals (module-ht module))) - (check-type %module-globals (or hash-table #+ecl cl-custom-hash-table::custom-hash-table)) + (assert (with-py-dict (hash-table-p %module-globals))) (flet ((init-module (&optional (module-globals %module-globals)) (init-module-namespace module-globals current-module-name)) (run-top-level-forms (&optional (module-globals %module-globals)) @@ -1581,7 +1581,7 @@ LOCALS shares share tail structure with input arg locals." :run-tlv t :globals %module-globals)) (continue-loading (&key (init t) (run-tlv t) (globals %module-globals)) - (check-type globals (or hash-table #+ecl cl-custom-hash-table::custom-hash-table)) + (assert (with-py-dict (hash-table-p globals))) (setf %module-globals globals) (when init (init-module)) From 7be325369810defc2492eac5bf7ff362ada35d5f Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Wed, 8 Nov 2017 10:21:40 +0100 Subject: [PATCH 20/30] Fix printing floating points --- parser/pprint.lisp | 17 +- test/parser-test.lisp | 459 +++++++++++++++++++++--------------------- 2 files changed, 246 insertions(+), 230 deletions(-) diff --git a/parser/pprint.lisp b/parser/pprint.lisp index be01c3a..61f2d37 100644 --- a/parser/pprint.lisp +++ b/parser/pprint.lisp @@ -323,14 +323,27 @@ output to a string does not start with a newline." (declare (ignorable kind)) (format stream "~D" x)) +(defun print-float-like-python (f trim-dot-zero-p) + (let* ((str (format nil "~G" f)) + (space (position #\Space str)) + (dot (position #\. str))) + (cond ((and trim-dot-zero-p space dot (= (1+ dot) space)) ;; "3.j " -> "3" + (subseq str 0 dot)) + ((and space dot (= (1+ dot) space)) ;; "3. " -> "3.0" + (concatenate 'string (subseq str 0 space) "0")) + (space + (subseq str 0 space)) + (t + str)))) + (defmethod py-pprint-literal (stream (kind (eql :number)) (x complex)) (declare (ignorable kind)) (assert (= 0 (realpart x))) - (format stream "~Gj" (imagpart x))) + (format stream "~Aj" (print-float-like-python (imagpart x) t))) (defmethod py-pprint-literal (stream (kind (eql :number)) (x float)) (declare (ignorable kind)) - (format stream "~G" x)) + (format stream "~A" (print-float-like-python x nil))) (defmethod py-pprint-literal (stream (kind (eql :bytes)) (x vector)) (declare (ignorable kind)) diff --git a/test/parser-test.lisp b/test/parser-test.lisp index 6da3acf..ad7667c 100644 --- a/test/parser-test.lisp +++ b/test/parser-test.lisp @@ -342,6 +342,7 @@ if 1 > \\ clpython.parser::+unicode-capable-string-type+))) (test-error (ps "u'\\N'" t) :condition-type '{SyntaxError}) (test-error (ps "u'\\N{foo'" t) :condition-type '{SyntaxError}) + #-abcl (test-error (ps "u'\\N{foo}'" t) :condition-type '{SyntaxError}) (test-equal (ps "u'\\r'" t) `([literal-expr] :string ,(coerce (list #\Return) 'string))) ;; warning then using unicode escape @@ -399,155 +400,161 @@ if 1: ;; #-allegro-cl-express (defun run-pretty-printer-test () - #.(let ((test-form - #1='(with-subtest (:name "CLPython-PrettyPrinter") - ;; Test string -> ast -> string and ast -> string -> ast - (macrolet ((p (str &rest options) - `(progn - (test ,str (py-pprint (parse ,str)) - :test 'string-strip-= ,@options) - (when (string-strip-= ,str (py-pprint (parse ,str))) - (test-equal (values (parse ,str)) - (values (parse (py-pprint (parse ,str)))) - ,@options)))) - (pe (str &rest options) - `(progn - (test ,str (py-pprint (parse ,str :one-expr t)) - :test 'string-strip-= ,@options) - (when (string-strip-= ,str (py-pprint (parse ,str :one-expr t))) - (test-equal (values (parse ,str)) - (values (parse (py-pprint (parse ,str :one-expr t)))) - ,@options))))) - #+(or)(parse "") - ;; number - (pe "42") - (pe "1.") - (pe "1.2") - (pe "3j" :known-failure t :fail-info "spaces between number and j") - ;; string - (pe "'x'") - (p "'\"'") - ;; bytes - (p "b'\\x41\\x42\\x03'") - ;; assert - (p "assert (1, 2, 3)") - (p "assert x > 0, 'error'") - ;; assign-stmt - (p "x = 42") - (p "x, y = 1, 2") - (p "x = y = 4") - (p "x = y, z = 1, 2") - ;; attributeref-expr - (p "x.a") - (p "a.b.c.d.e.f") - (p "a.b = 3") - (p "a.b = x.y") - (p "a.b = x, x.y") - ;; augassign-stmt - (p "x += 3, 4") - (p "x, y += foo") - (p "x[0, 1] += 3, (4, 5)") - ;; backticks-expr - (p "`p`") - (p "`42`") - (p "`f.g[x]`") - (p "`'water'`") - ;; binary-expr - (p "a + 3") - (p "a.g * 23") - (p "24 << 12") - (p "3 + 4 * 5") - (p "(3 + 4) * 5") - (p "1 * (2 + 3) << 0") - (p "1 + 2 - 3 * 4 // 5 / 6 % 7 << 8 >> 9 & 10 | 11 ^ 12 ** 13") - (p "-1 * -2 * -(3 * 4)") - (p "1 < 2 < (3 < 4) < 5 < (6 < (7 < 8))") - (p "x + 3 in foo") - (p "y not in foo") - (p "x is y") - (p "x is not x") - (p "not x is not x") - (p "not x is (not x)") - (p "(not x) is (not x)") - (p "x in (not y)") ;; brackets not necessary - ;; binary-lazy-expr - (p "a or b") - (p "a and b or c") - (p "(a or b) and c") - ;; break-stmt - (p "break") - ;; call-expr - (p "f(a, bb, c)") - (p "f(x=3, y=4)") - (p "f(*x)") - (p "f(**x)") - (p "f(*x, **y)") - (p "f((1, 2), x=(3, (4, 5)))") - ;; classdef-stmt (more indenting and layout tests -> suite-stmt) - (p "class C: + (with-subtest (:name "CLPython-PrettyPrinter") + ;; Test string -> ast -> string and ast -> string -> ast + (macrolet ((p (str &rest options) + `(progn + (test ,str (py-pprint (parse ,str)) + :test 'string-strip-= ,@options) + (when (string-strip-= ,str (py-pprint (parse ,str))) + (test-equal (values (parse ,str)) + (values (parse (py-pprint (parse ,str)))) + ,@options)))) + (pe (str &rest options) + `(progn + (test ,str (py-pprint (parse ,str :one-expr t)) + :test 'string-strip-= ,@options) + (when (string-strip-= ,str (py-pprint (parse ,str :one-expr t))) + (test-equal (values (parse ,str)) + (values (parse (py-pprint (parse ,str :one-expr t)))) + ,@options))))) + #+(or)(parse "") + ;; number + (pe "42") + (pe "0") + (pe "-42") + (pe "1.0") + (pe "-1.0") + (pe "1.2") + (pe "-1.2") + (pe "3j") + (pe "-3j") + (pe "123.345j") + (pe "-123.345j") + ;; string + (pe "'x'") + (p "'\"'") + ;; bytes + (p "b'\\x41\\x42\\x03'") + ;; assert + (p "assert (1, 2, 3)") + (p "assert x > 0, 'error'") + ;; assign-stmt + (p "x = 42") + (p "x, y = 1, 2") + (p "x = y = 4") + (p "x = y, z = 1, 2") + ;; attributeref-expr + (p "x.a") + (p "a.b.c.d.e.f") + (p "a.b = 3") + (p "a.b = x.y") + (p "a.b = x, x.y") + ;; augassign-stmt + (p "x += 3, 4") + (p "x, y += foo") + (p "x[0, 1] += 3, (4, 5)") + ;; backticks-expr + (p "`p`") + (p "`42`") + (p "`f.g[x]`") + (p "`'water'`") + ;; binary-expr + (p "a + 3") + (p "a.g * 23") + (p "24 << 12") + (p "3 + 4 * 5") + (p "(3 + 4) * 5") + (p "1 * (2 + 3) << 0") + (p "1 + 2 - 3 * 4 // 5 / 6 % 7 << 8 >> 9 & 10 | 11 ^ 12 ** 13") + (p "-1 * -2 * -(3 * 4)") + (p "1 < 2 < (3 < 4) < 5 < (6 < (7 < 8))") + (p "x + 3 in foo") + (p "y not in foo") + (p "x is y") + (p "x is not x") + (p "not x is not x") + (p "not x is (not x)") + (p "(not x) is (not x)") + (p "x in (not y)") ;; brackets not necessary + ;; binary-lazy-expr + (p "a or b") + (p "a and b or c") + (p "(a or b) and c") + ;; break-stmt + (p "break") + ;; call-expr + (p "f(a, bb, c)") + (p "f(x=3, y=4)") + (p "f(*x)") + (p "f(**x)") + (p "f(*x, **y)") + (p "f((1, 2), x=(3, (4, 5)))") + ;; classdef-stmt (more indenting and layout tests -> suite-stmt) + (p "class C: pass") - (p "class C(D, E): + (p "class C(D, E): pass") - (p "class C: + (p "class C: def m(): pass") - ;; comparison-expr - (p "x < y") - (p "x <= y <= z") - (p "a < b > c == d != e <= f >= g != h") - (test "x != y" (clpython:py-string.strip (py-pprint (parse "x <> y"))) :test 'string=) - ;; continue-stmt - (p "continue") - ;; del-stmt - (p "del x") - (p "del x, y") - (p "del x[0]") - (p "del x.a") - ;; dict-expr - (p "{}") - (p "{1: 2}") - (p "{a: b}") - (p "{(1, 2): (3, 4)}") - (p "{[1, 2, 3]: f.g[0](1, 2, 3)}") - ;; exec-stmt - (p "exec foo") - (p "exec foo in glob") - (p "exec foo in glob, loc") - (p "exec foo in (a, b, c), (1, 2, 3)") - ;; for-in-stmt - (p "for x in y: + ;; comparison-expr + (p "x < y") + (p "x <= y <= z") + (p "a < b > c == d != e <= f >= g != h") + (test "x != y" (clpython:py-string.strip (py-pprint (parse "x <> y"))) :test 'string=) + ;; continue-stmt + (p "continue") + ;; del-stmt + (p "del x") + (p "del x, y") + (p "del x[0]") + (p "del x.a") + ;; dict-expr + (p "{}") + (p "{1: 2}") + (p "{a: b}") + (p "{(1, 2): (3, 4)}") + (p "{[1, 2, 3]: f.g[0](1, 2, 3)}") + ;; exec-stmt + (p "exec foo") + (p "exec foo in glob") + (p "exec foo in glob, loc") + (p "exec foo in (a, b, c), (1, 2, 3)") + ;; for-in-stmt + (p "for x in y: pass") - (p "for x, y in zut: + (p "for x, y in zut: pass") - (p "for [x, (y, z)] in grub: + (p "for [x, (y, z)] in grub: pass") - (p "for x in a, b, c: + (p "for x in a, b, c: pass") - ;; funcdef-stmt - (p "def foo(): + ;; funcdef-stmt + (p "def foo(): pass") - (p "def foo(x, y): + (p "def foo(x, y): pass") - (p "def foo(x, y, z=3, *loc, **kw): + (p "def foo(x, y, z=3, *loc, **kw): pass") - ;; generator-expr - (p "(x for x in y)") - ;; global-stmt - (p "global x") - (p "global x, y") - ;; identifier-expr - (p "x") - (p "x, y") - (p "FooBar") - ;; if-expr - (p "(3 if 1 > 0 else 2)") - ;; if-stmt - (p "if a > 3: + ;; generator-expr + (p "(x for x in y)") + ;; global-stmt + (p "global x") + (p "global x, y") + ;; identifier-expr + (p "x") + (p "x, y") + (p "FooBar") + ;; if-expr + (p "(3 if 1 > 0 else 2)") + ;; if-stmt + (p "if a > 3: pass") - (p "if not a or b: + (p "if not a or b: pass") - (p - "if a > 3: + (p + "if a > 3: x elif a > 4: y @@ -555,8 +562,8 @@ elif a > 5: z else: qq") - (p - "if a: + (p + "if a: if b1: if c1: a @@ -564,108 +571,104 @@ else: b else: r") - ;; import-stmt - (p "import foo") - (p "import foo, bar") - (p "import foo as bar") - (p "import foo, bar as baz, zut") - ;; import-from-stmt - (p "from foo import bar") - (p "from foo import bar, baz") - (p "from foo import *") - ;; lambda-expr - (p "lambda: 42") - (p "lambda x: 42") - (p "lambda x, y=3: x + y") - (p "lambda *args: args[0]") - (p "lambda x, y=lambda y: 42: 3") - (p "lambda (x, y): x, y") - ;; listcompr-expr - (p "[x for y in z]") - (p "[x + y for x, y in a, b() if x > 3]") - (p "[x for x in a, b, c]") - ;; list-expr - (p "[]") - (p "[x]") - (p "[1, 2, 3]") - (p "[1, 2, (3, 4), (5, (6, 7, [8]))]") - (p "[x] = [3]") - (p "[x, y] = []") - ;; pass-stmt - (p "pass") - ;; print-stmt - (p "print") - (p "print x") - (p "print x,") - (p "print x, y") - (p "print x, y,") - ;; return-stmt - (p "return") - (p "return x") - (p "return x, y") - (p "return x + y") - ;; slice-expr - (p "x[:]") - (p "x[1:]") - (p "x[:1]") - (p "x[1:3]") - (p "x[1:2:3]") - (p "x[::3]") - (p "x[:3]") - (p "x[::1]") - ;; subscription-expr - (p "x[0]") - (p "x[...]") - (p "x[a, b, (c, d)]") - (p "x[a, ..., b]") - (p "x[y[0]]") - ;; suite-stmt - ;; raise-stmt - (p "raise") - (p "raise x") - (p "raise x, y") - (p "raise x, y, z") - ;; try-except-stmt - (p "try: + ;; import-stmt + (p "import foo") + (p "import foo, bar") + (p "import foo as bar") + (p "import foo, bar as baz, zut") + ;; import-from-stmt + (p "from foo import bar") + (p "from foo import bar, baz") + (p "from foo import *") + ;; lambda-expr + (p "lambda: 42") + (p "lambda x: 42") + (p "lambda x, y=3: x + y") + (p "lambda *args: args[0]") + (p "lambda x, y=lambda y: 42: 3") + (p "lambda (x, y): x, y") + ;; listcompr-expr + (p "[x for y in z]") + (p "[x + y for x, y in a, b() if x > 3]") + (p "[x for x in a, b, c]") + ;; list-expr + (p "[]") + (p "[x]") + (p "[1, 2, 3]") + (p "[1, 2, (3, 4), (5, (6, 7, [8]))]") + (p "[x] = [3]") + (p "[x, y] = []") + ;; pass-stmt + (p "pass") + ;; print-stmt + (p "print") + (p "print x") + (p "print x,") + (p "print x, y") + (p "print x, y,") + ;; return-stmt + (p "return") + (p "return x") + (p "return x, y") + (p "return x + y") + ;; slice-expr + (p "x[:]") + (p "x[1:]") + (p "x[:1]") + (p "x[1:3]") + (p "x[1:2:3]") + (p "x[::3]") + (p "x[:3]") + (p "x[::1]") + ;; subscription-expr + (p "x[0]") + (p "x[...]") + (p "x[a, b, (c, d)]") + (p "x[a, ..., b]") + (p "x[y[0]]") + ;; suite-stmt + ;; raise-stmt + (p "raise") + (p "raise x") + (p "raise x, y") + (p "raise x, y, z") + ;; try-except-stmt + (p "try: x except: y else: z ") - ;; try-finally-stmt - (p "try: + ;; try-finally-stmt + (p "try: x finally: y ") - ;; tuple-expr - (p "1, 2") - (p "x, y = 1, 2") - ;; unary-expr - (p "+x") - (p "-x") - (p "~x") - ;; while-stmt - (p "while x: + ;; tuple-expr + (p "1, 2") + (p "x, y = 1, 2") + ;; unary-expr + (p "+x") + (p "-x") + (p "~x") + ;; while-stmt + (p "while x: y") - ;; yield-stmt - (p "(yield)") - (p "(yield x)") - (p "(yield x, y)") - (p "()") - ;; some strings - (p "'asdf'") - (p "'asdf\"'") - (p "\"'\"") - (p "abc + ;; yield-stmt + (p "(yield)") + (p "(yield x)") + (p "(yield x, y)") + (p "()") + ;; some strings + (p "'asdf'") + (p "'asdf\"'") + (p "\"'\"") + (p "abc defg") - )))) - (declare (ignore test-form)) - #+allegro-cl-express ;; Work around out-of-memory due to heap limitation - `(eval '#1#) - #-allegro-cl-express - #1#)) + ))) + #+(or) ;; TODO: update Lispy test (defun run-lispy-test () From 94318e9acf83eea9d2328729614d8f1a90d05cde Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Wed, 8 Nov 2017 10:21:50 +0100 Subject: [PATCH 21/30] Fixes for ABCL --- runtime/classes.lisp | 7 ++++--- runtime/dictattr.lisp | 6 +++++- runtime/metaclass.lisp | 4 ++-- test/lang-test.lisp | 2 ++ 4 files changed, 13 insertions(+), 6 deletions(-) diff --git a/runtime/classes.lisp b/runtime/classes.lisp index cb55c7f..1518d1c 100644 --- a/runtime/classes.lisp +++ b/runtime/classes.lisp @@ -2383,11 +2383,12 @@ But if RELATIVE-TO package name is given, result may contains dots." (defparameter *hash-table-iterator-indefinite-extent* (checking-reader-conditionals + #+abcl t #+allegro t #+ecl t #+lispworks nil #+sbcl t - #-(or allegro ecl lispworks sbcl) nil) + #-(or abcl allegro ecl lispworks sbcl) nil) "Whether the iterator created by WITH-HASH-TABLE-ITERATOR has indefinite extent. ANSI states for WITH-HASH-TABLE-ITERATOR: \"It is unspecified what happens if any of the implicit interior state of an iteration is returned outside the dynamic extent @@ -2402,7 +2403,7 @@ invocation form.\"") :func (lambda () (multiple-value-bind (ok key val) (next-fn) (when ok (funcall func key val))))))) (progn - #+custom-hash-table-fallback ;; from library CL-CUSTOM-HASH-TABLE + #+custom-hash-table-fallback (error "This LOOP is not supported by CUSTOM-HASH-TABLE-FALLBACK") (let ((vec (loop with vec = (make-array (* 2 (hash-table-count hash-table))) @@ -3397,7 +3398,7 @@ invocation form.\"") (:method ((x string)) (declare (ignorable x)) (ltv-find-class 'py-string )) (:method ((x vector)) (declare (ignorable x)) (ltv-find-class 'py-list )) - #+ecl + #+custom-hash-table-fallback (:method ((x cl-custom-hash-table:custom-hash-table)) (declare (ignorable x)) (ltv-find-class 'dict)) diff --git a/runtime/dictattr.lisp b/runtime/dictattr.lisp index d122e79..3e10c80 100644 --- a/runtime/dictattr.lisp +++ b/runtime/dictattr.lisp @@ -127,12 +127,16 @@ (defun class.raw-classname (class) "Given a class, return its classname. Only intended for classes corresponding to Python (meta)types." + #+custom-hash-table-fallback + (when (typep class 'structure-class) + (assert (eq class (ltv-find-class 'cl-custom-hash-table:custom-hash-table))) + (return-from class.raw-classname 'dict)) #+clpython-use-standard-instance-access (#.+standard-instance-access-func+ class +py-class-classname-slot-index+) #-clpython-use-standard-instance-access (slot-value class +py-class-classname-slot-name+)) -#+clpython-use-standard-instance-access +#+(and (not custom-hash-table-fallback) clpython-use-standard-instance-access) (define-compiler-macro class.raw-classname (class) `(#.+standard-instance-access-func+ ,class +py-class-classname-slot-index+)) diff --git a/runtime/metaclass.lisp b/runtime/metaclass.lisp index 1f26f7f..4b7a69f 100644 --- a/runtime/metaclass.lisp +++ b/runtime/metaclass.lisp @@ -121,8 +121,8 @@ (make-hash-table :test 'py-==->lisp-val)))) (defmacro with-py-dict (&body body) - #+ecl `(cl-custom-hash-table:with-custom-hash-table ,@body) - #-ecl `(progn ,@body)) + #+custom-hash-table-fallback `(cl-custom-hash-table:with-custom-hash-table ,@body) + #-custom-hash-table-fallback `(progn ,@body)) ;; None and NotImplemented are here, so that other modules like classes can use the compiler macros. diff --git a/test/lang-test.lisp b/test/lang-test.lisp index 4c73792..466f415 100644 --- a/test/lang-test.lisp +++ b/test/lang-test.lisp @@ -405,6 +405,8 @@ assert x == [0, 1, 2, 3, 4, 6, 8]")) (run-no-error "{1+2: 3+4}") (run-no-error "assert {1: 3}[1] == 3") (run-no-error "assert {1: 3, 2: 4}[1] == 3") + (run-no-error "{} == {}") + (run-no-error "{'a': 1, 'b': 2} == {'b': 2, 'a': 1}") (run-no-error " d = {} d[3] = 1 From a57f778cd69e76b6fe0307b0ecbf2ff1eb72e747 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Thu, 19 Apr 2018 14:47:13 +0200 Subject: [PATCH 22/30] Add support for: file.write(string) --- lib/builtins-file.lisp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lib/builtins-file.lisp b/lib/builtins-file.lisp index 30afda4..fa9d2e8 100644 --- a/lib/builtins-file.lisp +++ b/lib/builtins-file.lisp @@ -265,7 +265,11 @@ ;; buffering, the string may not actually show up in the file until ;; the flush() or close() method is called. (ensure-open-file f) - (write-string str (py-file-stream f)) + (unless (stringp str) + (py-raise '{TypeError} "Not supported: file.write() of non-string ~S" str)) + (loop with fs = (py-file-stream f) + for ch across str + do (write-byte (char-code ch) fs)) *the-none*) (def-py-method py-file.writelines (f sequence) From e2c485685a25d9c6e80f3b77fe3396597879c482 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Thu, 19 Apr 2018 14:55:29 +0200 Subject: [PATCH 23/30] Fix file.read() EOF handling --- lib/builtins-file.lisp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/lib/builtins-file.lisp b/lib/builtins-file.lisp index fa9d2e8..ff3c173 100644 --- a/lib/builtins-file.lisp +++ b/lib/builtins-file.lisp @@ -149,15 +149,15 @@ ;; parameter was given. (ensure-open-file f) (let* ((size (if size (py-val->integer size) 100)) - (check-size-p (>= size 0)) - (chars (loop - for i from 0 - for not-at-limit = (or (null check-size-p) (< i size)) + (check-size-p (>= size 0)) + (chars (loop + for i from 0 + for not-at-limit = (or (null check-size-p) (< i size)) ;; TODO check file encoding - for ch = (and not-at-limit - (code-char (read-byte (py-file-stream f) nil nil))) - while ch - collect ch))) + for b = (and not-at-limit (read-byte (py-file-stream f) nil nil)) + for ch = (and b (code-char b)) + while ch + collect ch))) (coerce chars 'string))) (def-py-method py-file.readline (f^ &optional size^) From 0f47bf71997291266dda4095c62a5bcb9d442b57 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Sun, 2 Sep 2018 12:14:04 +0200 Subject: [PATCH 24/30] Fix itertools.tee (issue #24) --- lib/itertools.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/itertools.lisp b/lib/itertools.lisp index 7e41a54..ea7e85f 100644 --- a/lib/itertools.lisp +++ b/lib/itertools.lisp @@ -111,4 +111,4 @@ (unless (eq d deque) (clpython.module._collections::deque.append d new-val))) new-val)))))) - (make-tuple-from-list (mapcar 'generator deques))))))) \ No newline at end of file + (make-tuple-from-list (mapcar #'generator deques))))))) From 8faa7a274a9feb252dc2fdd42a88dae21df90884 Mon Sep 17 00:00:00 2001 From: "Neil T. Dantam" Date: Mon, 12 Nov 2018 03:33:18 -0700 Subject: [PATCH 25/30] Use ASDF:MAKE-OPERATION instead of MAKE-INSTANCE In recent ASDF, "OPERATION instances must only be created through MAKE-OPERATION." --- runtime/import.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/runtime/import.lisp b/runtime/import.lisp index e70780d..3642968 100644 --- a/runtime/import.lisp +++ b/runtime/import.lisp @@ -68,7 +68,7 @@ In particular, asdf-binary-locations is used if available.") (asdf-path (when *use-asdf-fasl-locations* (ignore-errors (let ((path (car (asdf:output-files - (make-instance 'asdf:compile-op) + (asdf:make-operation 'asdf:compile-op) (make-instance 'asdf:cl-source-file :parent (asdf:find-system :clpython) :pathname bin-path))))) From 8e8053a3c503b3fc9742db79dda8cfcb5291d809 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Wed, 10 Jul 2019 15:18:07 +0200 Subject: [PATCH 26/30] Fix for ECL --- runtime/metaclass.lisp | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/runtime/metaclass.lisp b/runtime/metaclass.lisp index 4b7a69f..6113d70 100644 --- a/runtime/metaclass.lisp +++ b/runtime/metaclass.lisp @@ -11,9 +11,12 @@ ;;; Class hierarchy -;; Different implementations have different requirements, so let's -;; make everything available all the time. - +(defmacro maybe-eval-always (&body body) + ;; ECL needs to see the VALIDATE-SUPERCLASS methods + #+ecl + `(eval-when (compile load eval) ,@body) + #-ecl + `(progn ,@body)) (defclass dict-mixin () ((dict :initarg :dict @@ -35,16 +38,19 @@ (closer-mop:finalize-inheritance (find-class 'py-meta-type)) +(maybe-eval-always (defmethod closer-mop:validate-superclass ((class py-meta-type) superclass) (declare (ignorable class superclass)) t) - +) + (defclass py-type (dict-mixin standard-class) () (:metaclass py-meta-type)) (closer-mop:finalize-inheritance (find-class 'py-type)) +(maybe-eval-always (defmethod closer-mop:validate-superclass ((class py-type) superclass) (declare (ignorable class superclass)) t) @@ -52,6 +58,7 @@ (defmethod closer-mop:validate-superclass ((class standard-class) (superclass py-type)) (declare (ignorable class superclass)) t) +) (defclass object (standard-object) () @@ -65,13 +72,15 @@ (closer-mop:finalize-inheritance (find-class 'dicted-object)) - (defmethod closer-mop:validate-superclass (class (superclass py-meta-type)) - (declare (ignorable class superclass)) - t) +(maybe-eval-always +(defmethod closer-mop:validate-superclass (class (superclass py-meta-type)) + (declare (ignorable class superclass)) + t) - (defmethod closer-mop:validate-superclass ((class standard-class) (superclass py-meta-type)) - (declare (ignorable class superclass)) - t) +(defmethod closer-mop:validate-superclass ((class standard-class) (superclass py-meta-type)) + (declare (ignorable class superclass)) + t) +) ;;; Instance dicts From cd01f8962835d64cf3f768839ca4d61228191d9e Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Wed, 10 Jul 2019 16:37:55 +0200 Subject: [PATCH 27/30] Fixes for Lispworks --- runtime/import.lisp | 13 +++++++++---- runtime/metaclass.lisp | 4 ++-- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/runtime/import.lisp b/runtime/import.lisp index 3642968..e2cd71a 100644 --- a/runtime/import.lisp +++ b/runtime/import.lisp @@ -94,7 +94,10 @@ When FILENAME-ITEMS is (:A :B :C) result could look like #p'/tmp/clpython-A.B.C- Might signal TEMPORARY-FILE:CANNOT-CREATE-TEMPORARY-FILE" (whereas ((file-name (gethash key *temp-file-map*))) (return-from get-temporary-file file-name)) - (let ((file-stream (cl-fad:open-temporary :template (format nil "TEMPORARY-FILES:~{~A~^-~}-%" filename-items) + (let ((file-stream (cl-fad:open-temporary :template + ;; Lispworks apparently does not resolve "TEMPORARY-FILES:.." properly + #+lispworks (format nil "/tmp/~{~A~^-~}-%" filename-items) + #-lispworks (format nil "TEMPORARY-FILES:~{~A~^-~}-%" filename-items) :direction :output))) (prog1 (setf (gethash key *temp-file-map*) (pathname file-stream)) (close file-stream)))) @@ -135,7 +138,8 @@ with: KIND one of :module, :package (cached-probe-file fname)) (probe-bin (fname) (whereas ((path (cached-probe-file fname))) - (and #+allegro (excl::check-fasl-magic path nil) + (and (typep (file-length path) '(integer 1)) ;; skip empty files, or when length can't be determined + #+allegro (excl::check-fasl-magic path nil) path)))) ;; Ignore non-existent directories (setf search-paths (remove-if-not #'cached-probe-file search-paths)) @@ -416,7 +420,8 @@ Otherwise raises ImportError." (not (cached-probe-file bin-file)) (< (file-write-date bin-file) (file-write-date src-file)) (with-open-file (f bin-file :direction :input) ;; just created temp output file - (zerop (file-length f))))))) + (zerop (file-length f))))))) + (format t "need-recompile: ~s" need-recompile) (when need-recompile ;; This would be a good place for a "try recompiling" restart, ;; but implementations tend to provide that already. @@ -523,4 +528,4 @@ Otherwise raises ImportError." (whereas ((ht (symbol-value (find-symbol (symbol-name '#:|modules|) :clpython.module.sys)))) (check-type ht (or hash-table #+ecl cl-custom-hash-table::custom-hash-table)) (with-py-dict - (clrhash ht)))) \ No newline at end of file + (clrhash ht)))) diff --git a/runtime/metaclass.lisp b/runtime/metaclass.lisp index 6113d70..eb36565 100644 --- a/runtime/metaclass.lisp +++ b/runtime/metaclass.lisp @@ -13,9 +13,9 @@ (defmacro maybe-eval-always (&body body) ;; ECL needs to see the VALIDATE-SUPERCLASS methods - #+ecl + #+(or ecl lispworks) `(eval-when (compile load eval) ,@body) - #-ecl + #-(or ecl lispworks) `(progn ,@body)) (defclass dict-mixin () From 48e84cc5d0f83163bef1aa3f7a28d1089d1fb3fa Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Wed, 10 Jul 2019 17:04:32 +0200 Subject: [PATCH 28/30] Update build status --- README.md | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index c34bd54..d139f82 100644 --- a/README.md +++ b/README.md @@ -14,15 +14,15 @@ To install using QuickLisp: `(ql:quickload "clpython")` (require ASDF 3.3 or hig CLPython is developed by Willem Broekema and is released as open source under the [LLGPL](http://opensource.franz.com/preamble.html). The project was started in 2006, and is since 2013 not under active development anymore. +See the [build status](https://travis-ci.org/metawilm/cl-python) on Travis-CI, and the [coverage status](https://coveralls.io/github/metawilm/cl-python?branch=master) on Coveralls: + | Common Lisp Implementation | Build + Test Status | | |:-:|:-:|:-:| -| [ABCL](https://common-lisp.net/project/armedbear/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=abcl+CATCH&label=ABCL)](https://travis-ci.org/metawilm/cl-python) | Fails due to NullPointerException | -| [Allegro CL](http://franz.com/products/allegrocl/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=allegro+CATCH&label=Allegro+CL)](https://travis-ci.org/metawilm/cl-python) | | -| [Clozure CL](http://clozure.com/clozurecl.html) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=ccl&label=Clozure+CL)](https://travis-ci.org/metawilm/cl-python) | | -| [CLISP](http://clisp.sourceforge.net) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=clisp&label=CLISP)](https://travis-ci.org/metawilm/cl-python) | Fails due to stack overflow | +| [ABCL](https://common-lisp.net/project/armedbear/) 1.5.0 | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=abcl+CATCH&label=ABCL)](https://travis-ci.org/metawilm/cl-python) | Fails due to `ClassCastException: StandardObject cannot be cast to LispClass` | +| [Allegro CL](http://franz.com/products/allegrocl/) 10.1 | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=allegro+CATCH&label=Allegro+CL)](https://travis-ci.org/metawilm/cl-python) | | +| [Clozure CL](http://clozure.com/clozurecl.html) 1.11 | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=ccl&label=Clozure+CL)](https://travis-ci.org/metawilm/cl-python) | | +| [CLISP](http://clisp.sourceforge.net) 2.49 | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=clisp&label=CLISP)](https://travis-ci.org/metawilm/cl-python) | Fails due to stack overflow | | [CMUCL](http://www.cons.org/cmucl/) | ? | | -| [ECL](http://ecls.sourceforge.net/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=ecl+CATCH&label=ECL)](https://travis-ci.org/metawilm/cl-python) | | -| [LispWorks](http://www.lispworks.com/) | ? | | -| [SBCL](http://sbcl.sourceforge.net/) | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=sbcl&label=SBCL)](https://travis-ci.org/metawilm/cl-python) [![Coverage Status](https://coveralls.io/repos/metawilm/cl-python/badge.svg?branch=master)](https://coveralls.io/r/metawilm/cl-python?branch=master) | | - - +| [ECL](http://ecls.sourceforge.net/) 16.1.3 | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=ecl+CATCH&label=ECL)](https://travis-ci.org/metawilm/cl-python) | | +| [LispWorks](http://www.lispworks.com/) 6.1.1 | ✅ | Manually verified | +| [SBCL](http://sbcl.sourceforge.net/) 1.5.4 | [![Build Status](https://travis-build-job-badge.herokuapp.com/badge?user=metawilm&repo=cl-python&branch=master&envContains=sbcl&label=SBCL)](https://travis-ci.org/metawilm/cl-python) [![Coverage Status](https://coveralls.io/repos/metawilm/cl-python/badge.svg?branch=master)](https://coveralls.io/r/metawilm/cl-python?branch=master) | | From d33855076ce6fff19b7db57a3873f4cc6b65bdc5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Fri, 10 Apr 2020 19:39:36 +0200 Subject: [PATCH 29/30] Unfix ECL Upcoming ECL release will have this problem solved (and clpython does not load with this fix present, because class is not available at compile time). --- runtime/metaclass.lisp | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/runtime/metaclass.lisp b/runtime/metaclass.lisp index eb36565..4863042 100644 --- a/runtime/metaclass.lisp +++ b/runtime/metaclass.lisp @@ -12,8 +12,12 @@ ;;; Class hierarchy (defmacro maybe-eval-always (&body body) - ;; ECL needs to see the VALIDATE-SUPERCLASS methods - #+(or ecl lispworks) + #+ecl + ;; ECL may need to see the VALIDATE-SUPERCLASS methods. + (if (<= ext:+ecl-version-number+ 160103) + `(eval-when (compile load eval) ,@body) + `(progn ,@body)) + #+lispworks `(eval-when (compile load eval) ,@body) #-(or ecl lispworks) `(progn ,@body)) From 66eb75edd0506fc1a22819a4f15546c35ac429c7 Mon Sep 17 00:00:00 2001 From: Willem Broekema Date: Thu, 10 Mar 2022 16:45:32 +0100 Subject: [PATCH 30/30] Fix empty triple quote parse error --- parser/lexer.lisp | 4 +++- test/parser-test.lisp | 7 ++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/parser/lexer.lisp b/parser/lexer.lisp index 293e62b..09a1a21 100644 --- a/parser/lexer.lisp +++ b/parser/lexer.lisp @@ -585,7 +585,9 @@ Used by compiler to generate 'forbidden' identfiers.") (not prev-bs)) until (and (char= z x y ch1) (not prev-bs)) finally (return (- %lex-last-read-char-ix% 3))))) - (lex-substring start end))) + (if (> start end) + (return-from read-kind "") + (lex-substring start end)))) ((char= ch1 ch2) ;; "" or '' but not """ or ''' (when ch3 (lex-unread-char ch3)) diff --git a/test/parser-test.lisp b/test/parser-test.lisp index ad7667c..19d16d1 100644 --- a/test/parser-test.lisp +++ b/test/parser-test.lisp @@ -57,7 +57,12 @@ (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :number 42)))) (ps "42")) (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :string "x")))) (ps "'x'")) (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :bytes "x")))) (ps "b'x'")) - + (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :string "")))) (ps "\"\"\"\"\"\"")) + (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :string "")))) (ps "''''''")) + (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :string "x")))) (ps "'''x'''")) + (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :string " ")))) (ps "''' '''")) + (test-equal '([module-stmt] ([suite-stmt] (([literal-expr] :string "'")))) (ps "'''\\''''")) + ;; variables (test-equal '([assign-stmt] ([literal-expr] :number 3) (([identifier-expr] {y} ))) (ps "y = 3" t)) (test-equal '([assign-stmt] ([literal-expr] :number 3) (([identifier-expr] {len}))) (ps "len = 3" t))