From 00a07c98efcdbb93c38033ac684e8dc5b753d6af Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Sat, 23 Feb 2013 07:52:39 -0500 Subject: [PATCH] Deliver each contrib as a single FASL. Don't implicitly require either ASDF or source code at runtime. Also, move contrib output to obj/sbcl-home/, asdf cache to obj/asdf-cache/ Update sb-grovel and other contribs and their tests for asdf3. TODO: also move sbcl.core from output/ to obj/sbcl-home/ and simplify install. Fixes lp#1132254. --- .gitignore | 3 - contrib/asdf-install/asdf-install.asd | 18 +--- contrib/asdf-module.mk | 26 +++--- contrib/asdf-stub.lisp | 84 +++++++++++++---- contrib/asdf/Makefile | 24 +++-- contrib/asdf/pull-asdf.sh | 21 ++++- contrib/sb-bsd-sockets/sb-bsd-sockets.asd | 115 ++++++++++-------------- contrib/sb-concurrency/sb-concurrency.asd | 1 + contrib/sb-cover/cover.lisp | 17 ++-- contrib/sb-cover/sb-cover.asd | 23 +++-- contrib/sb-cover/tests.lisp | 34 +++---- contrib/sb-grovel/def-to-lisp.lisp | 63 +++++-------- contrib/sb-grovel/defpackage.lisp | 2 +- contrib/sb-grovel/sb-grovel.asd | 24 ++--- contrib/sb-introspect/sb-introspect.asd | 84 +++++++++-------- contrib/sb-introspect/test-driver.lisp | 16 ++-- contrib/sb-posix/sb-posix.asd | 82 ++++++++--------- contrib/sb-rotate-byte/sb-rotate-byte.asd | 36 ++++---- contrib/sb-simple-streams/sb-simple-streams.asd | 26 ++---- contrib/vanilla-module.mk | 15 +++- install.sh | 10 +-- make-target-contrib.sh | 60 ++++++------- run-sbcl.sh | 2 +- src/code/module.lisp | 15 ++-- 24 files changed, 399 insertions(+), 402 deletions(-) diff --git a/.gitignore b/.gitignore index 82898af..729b950 100644 --- a/.gitignore +++ b/.gitignore @@ -44,9 +44,6 @@ tools-for-build/os-provides-putwc-test.exe tools-for-build/where-is-mcontext contrib/*/test-passed contrib/*/test-output -contrib/*/foo.c -contrib/*/a.out -contrib/*/a.exe contrib/asdf/asdf-upstream contrib/sb-cover/test-output doc/manual/*.html diff --git a/contrib/asdf-install/asdf-install.asd b/contrib/asdf-install/asdf-install.asd index 26c2b39..3ee25d3 100644 --- a/contrib/asdf-install/asdf-install.asd +++ b/contrib/asdf-install/asdf-install.asd @@ -1,20 +1,10 @@ ;;; -*- Lisp -*- - -(defpackage #:asdf-install-system - (:use #:cl #:asdf)) - -(in-package #:asdf-install-system) - (defsystem asdf-install :depends-on (sb-posix sb-bsd-sockets) - :version "0.2" #+sb-building-contrib :pathname #+sb-building-contrib #p"SYS:CONTRIB;ASDF-INSTALL;" + :version "0.2" :components ((:file "defpackage") - (:file "installer" :depends-on ("defpackage")))) - -(defmethod perform :after ((o load-op) (c (eql (find-system :asdf-install)))) - (provide 'asdf-install)) - -(defmethod perform ((o test-op) (c (eql (find-system :asdf-install)))) - t) + (:file "installer" :depends-on ("defpackage"))) + :perform (load-op :after (o c) (provide 'asdf-install)) + :perform (test-op (o c) t)) diff --git a/contrib/asdf-module.mk b/contrib/asdf-module.mk index dba81ea..4b429f2 100644 --- a/contrib/asdf-module.mk +++ b/contrib/asdf-module.mk @@ -1,4 +1,3 @@ - # We need to extend flags to the C compiler and the linker # here. sb-posix, sb-grovel, and sb-bsd-sockets depends upon these # being set on x86_64. Setting these in their Makefiles is not @@ -7,6 +6,9 @@ # ones as dependencies. UNAME:=$(shell uname -s) +DEST=$(SBCL_PWD)/obj/sbcl-home/contrib/ +FASL=$(DEST)/$(SYSTEM).fasl +ASD=$(DEST)/$(SYSTEM).asd ifeq (SunOS,$(UNAME)) EXTRA_CFLAGS=-D_XOPEN_SOURCE=500 -D__EXTENSIONS__ @@ -27,18 +29,20 @@ endif export CC SBCL EXTRA_CFLAGS EXTRA_LDFLAGS -all: $(EXTRA_ALL_TARGETS) - $(MAKE) -C ../asdf - $(SBCL) --eval '(defvar *system* "$(SYSTEM)")' --load ../asdf-stub.lisp --eval '(exit)' +all: $(FASL) $(ASD) $(EXTRA_ALL_TARGETS) + +$(FASL):: + $(SBCL) --load ../asdf-stub.lisp \ + --eval '(asdf::build-asdf-contrib "$(SYSTEM)")' + +$(ASD):: + echo "(defsystem :$(SYSTEM) :class require-system)" > $@ -test: all - echo "(pushnew :sb-testing-contrib *features*)" \ - "(asdf:operate (quote asdf:load-op) :$(SYSTEM))" \ - "(asdf:operate (quote asdf:test-op) :$(SYSTEM))" | \ - $(SBCL) --eval '(load "../asdf/asdf")' +test: $(FASL) $(ASD) + $(SBCL) --load ../asdf-stub.lisp \ + --eval '(asdf::test-asdf-contrib "$(SYSTEM)")' # KLUDGE: There seems to be no portable way to tell tar to not to # preserve owner, so chown after installing for the current user. install: $(EXTRA_INSTALL_TARGETS) - tar cf - . | ( cd "$(BUILD_ROOT)$(INSTALL_DIR)" && tar xpvf - ) - find "$(BUILD_ROOT)$(INSTALL_DIR)" -exec chown `id -u`:`id -g` {} \; + cp $(FASL) $(ASD) "$(BUILD_ROOT)$(INSTALL_DIR)" diff --git a/contrib/asdf-stub.lisp b/contrib/asdf-stub.lisp index 1baef5f..e658e07 100644 --- a/contrib/asdf-stub.lisp +++ b/contrib/asdf-stub.lisp @@ -1,18 +1,70 @@ -(load "SYS:CONTRIB;ASDF;ASDF.FASL") +(require :asdf) -(let ((asdf:*central-registry* nil)) +(in-package :asdf) + +(defun keywordize (x) + (intern (string-upcase x) :keyword)) + +(defun wrapping-source-registry () + '(:source-registry (:tree #p"SYS:CONTRIB;") :ignore-inherited-configuration)) + + +(defun setup-asdf-contrib () + ;;(setf *resolve-symlinks* nil) + (let* ((sbcl-pwd (getenv-pathname "SBCL_PWD" :ensure-directory t)) + (src-contrib (subpathname sbcl-pwd "contrib/")) + (asdf-cache (subpathname sbcl-pwd "obj/asdf-cache/")) + (source-registry '(:source-registry :ignore-inherited-configuration)) + (output-translations `(:output-translations (,(namestring src-contrib) + ,(namestring asdf-cache)) + :ignore-inherited-configuration)) + (src.pat (wilden src-contrib)) + (src.dir.pat (merge-pathnames* *wild-inferiors* src-contrib)) + (out.pat (wilden asdf-cache))) + (ensure-directories-exist asdf-cache) + (setf (logical-pathname-translations "SYS") + `(("CONTRIB;**;*.*.*" ,src.pat))) ;; this makes recursive tree search work. + (initialize-source-registry source-registry) + (initialize-output-translations output-translations) + (setf (logical-pathname-translations "SYS") + (labels ((typepat (type base) + `(,(format nil "CONTRIB;**;*.~:@(~A~).*" type) + ,(make-pathname :type (string-downcase type) :defaults base))) + (outpat (type) (typepat type out.pat)) + (srcpat (type) (typepat type src.pat)) + (outpats (&rest types) (mapcar #'outpat types)) + (srcpats (&rest types) (mapcar #'srcpat types))) + `(,@(srcpats :lisp :asd) + ,@(outpats :fasl :sbcl-warnings :build-report + :out :exe :lisp-temp :o :c :test-report :html) + ("CONTRIB;**;" ,src.dir.pat) + #|("CONTRIB;**;*.*.*" ,src.pat)|#))) + (setf *central-registry* nil))) + +(defun build-asdf-contrib (system) (push :sb-building-contrib *features*) - (asdf:operate 'asdf:load-op *system*) - (let ((stub (make-pathname :name *system* :type "lisp"))) - (when (probe-file (compile-file-pathname stub)) - (error "fasl file exists")) - (with-open-file (s stub :direction :output :if-exists :error) - (print '(unless (member "ASDF" *modules* :test #'string=) - (require :asdf)) - s) - ;; we find our contribs without reference to *central-registry*. - (print `(let ((asdf:*central-registry* nil)) - (asdf::module-provide-asdf ,*system*)) - s)) - (compile-file stub) - (delete-file stub))) + (setup-asdf-contrib) + (let* ((name (string-downcase system)) + (sbcl-pwd (getenv-pathname "SBCL_PWD" :ensure-directory t)) + (out-contrib (subpathname sbcl-pwd "obj/sbcl-home/contrib/")) + (cache-module (subpathname sbcl-pwd (format nil "obj/asdf-cache/~a/" name))) + (system (find-system name)) + (system.fasl (output-file 'fasl-op system)) + (module.fasl (subpathname out-contrib (strcat name ".fasl"))) + (module-setup.lisp (subpathname cache-module "module-setup.lisp")) + (module-setup.fasl (subpathname cache-module "module-setup.fasl")) + (dependencies (mapcar 'keywordize (component-sideway-dependencies system))) + (input-fasls (list module-setup.fasl system.fasl))) + (ensure-directories-exist out-contrib) + (ensure-directories-exist cache-module) + (with-open-file (o module-setup.lisp + :direction :output :if-exists :rename-and-delete) + (format o "(provide :~A)~%~{(require ~(~S~))~%~}" name dependencies)) + (compile-file module-setup.lisp :output-file module-setup.fasl) + (operate 'fasl-op system) + (concatenate-files input-fasls module.fasl))) + +(defun test-asdf-contrib (system) + (pushnew :sb-testing-contrib *features*) + (setup-asdf-contrib) + (asdf:test-system system)) diff --git a/contrib/asdf/Makefile b/contrib/asdf/Makefile index 4855a3b..658d583 100644 --- a/contrib/asdf/Makefile +++ b/contrib/asdf/Makefile @@ -1,13 +1,21 @@ -MODULE=asdf -include ../vanilla-module.mk +DEST=$(SBCL_PWD)/obj/sbcl-home/contrib/ +FASL=$(DEST)/asdf.fasl +fasl:: $(FASL) +$(FASL):: asdf.lisp ../../output/sbcl.core + if [ -d asdf-upstream ] ; then rm -rf asdf-upstream ; fi + mkdir -p $(DEST) + $(SBCL) --eval '(compile-file #p"SYS:CONTRIB;ASDF;ASDF.LISP" :output-file (parse-native-namestring "$@"))' " - (error-operation c) (error-component c))))) -(define-condition a-dot-out-failed (compile-failed) () - (:report (lambda (c s) - (format s "~@" - (error-operation c) (error-component c))))) +(define-condition c-compile-failed (compile-file-error) + ((description :initform "C compiler failed"))) +(define-condition a-dot-out-failed (compile-file-error) + ((description :initform "a.out failed"))) -(defmethod asdf:perform ((op asdf:compile-op) - (component grovel-constants-file)) +(defmethod perform ((op compile-op) + (component grovel-constants-file)) ;; we want to generate all our temporary files in the fasl directory ;; because that's where we have write permission. Can't use /tmp; ;; it's insecure (these files will later be owned by root) - (let* ((output-file (car (output-files op component))) + (let* ((output-files (output-files op component)) + (output-file (first output-files)) + (warnings-file (second output-files)) (filename (component-pathname component)) + (context-format "~/asdf-action::format-action/") + (context-arguments `((,op . ,component))) + (condition-arguments `(:context-format ,context-format + :context-arguments ,context-arguments)) (real-output-file (if (typep output-file 'logical-pathname) (translate-logical-pathname output-file) @@ -226,11 +229,7 @@ code: :input nil :output *trace-output*)))) (unless (= code 0) - (case (operation-on-failure op) - (:warn (warn "~@" - op component)) - (:error - (error 'c-compile-failed :operation op :component component))))) + (apply 'error 'c-compile-failed condition-arguments))) (let ((code (sb-ext:process-exit-code (sb-ext:run-program (namestring tmp-a-dot-out) (list (namestring tmp-constants)) @@ -238,29 +237,7 @@ code: :input nil :output *trace-output*)))) (unless (= code 0) - (case (operation-on-failure op) - (:warn (warn "~@" - op component)) - (:error - (error 'a-dot-out-failed :operation op :component component)))))) + (apply 'error 'a-dot-out-failed condition-arguments))) (multiple-value-bind (output warnings-p failure-p) - (compile-file tmp-constants :output-file output-file) - (when warnings-p - (case (operation-on-warnings op) - (:warn (warn - (formatter "~@") - op component)) - (:error (error 'compile-warned :component component :operation op)) - (:ignore nil))) - (when failure-p - (case (operation-on-failure op) - (:warn (warn - (formatter "~@") - op component)) - (:error (error 'compile-failed :component component :operation op)) - (:ignore nil))) - (unless output - (error 'compile-error :component component :operation op))))) - + (compile-file* tmp-constants :output-file output-file :warnings-file warnings-file) + (check-lisp-compile-results output warnings-p failure-p context-format context-arguments))))) diff --git a/contrib/sb-grovel/defpackage.lisp b/contrib/sb-grovel/defpackage.lisp index 5f161b1..291bd0b 100644 --- a/contrib/sb-grovel/defpackage.lisp +++ b/contrib/sb-grovel/defpackage.lisp @@ -6,4 +6,4 @@ ;; nasty things done with SB-ALIEN:STRUCT. #+sb-package-locks (:implement "SB-ALIEN") - (:use "COMMON-LISP" "SB-ALIEN" "ASDF" "SB-EXT")) + (:use "COMMON-LISP" "SB-ALIEN" "ASDF" "UIOP")) diff --git a/contrib/sb-grovel/sb-grovel.asd b/contrib/sb-grovel/sb-grovel.asd index 864671f..b32b121 100644 --- a/contrib/sb-grovel/sb-grovel.asd +++ b/contrib/sb-grovel/sb-grovel.asd @@ -1,19 +1,13 @@ ;;; -*- Lisp -*- -(defpackage #:sb-grovel-system (:use #:asdf #:cl)) -(in-package #:sb-grovel-system) - (defsystem sb-grovel - :version "0.01" - #+sb-building-contrib :pathname - #+sb-building-contrib #p"SYS:CONTRIB;SB-GROVEL;" - :components ((:file "defpackage") - (:file "def-to-lisp" :depends-on ("defpackage")) - (:file "foreign-glue" :depends-on ("defpackage")))) - -(defmethod perform :after ((o load-op) (c (eql (find-system :sb-grovel)))) - (provide 'sb-grovel)) - -(defmethod perform ((o test-op) (c (eql (find-system :sb-grovel)))) - t) + :version "0.2" + :depends-on (asdf) + #+sb-building-contrib :pathname + #+sb-building-contrib #p"SYS:CONTRIB;SB-GROVEL;" + :components ((:file "defpackage") + (:file "def-to-lisp" :depends-on ("defpackage")) + (:file "foreign-glue" :depends-on ("defpackage"))) + :perform (load-op :after (o c) (provide 'sb-grovel)) + :perform (test-op (o c) t)) diff --git a/contrib/sb-introspect/sb-introspect.asd b/contrib/sb-introspect/sb-introspect.asd index 62734d0..2602731 100644 --- a/contrib/sb-introspect/sb-introspect.asd +++ b/contrib/sb-introspect/sb-introspect.asd @@ -9,20 +9,15 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. -(defpackage :sb-introspect-system - (:use :asdf :cl)) - -(in-package :sb-introspect-system) +(defpackage #:sb-introspect-system (:use :cl :asdf :uiop)) +(in-package #:sb-introspect-system) (defsystem :sb-introspect - :components ((:file "introspect"))) - -(defmethod perform :after ((o load-op) (c (eql (find-system :sb-introspect)))) - (provide 'sb-introspect)) - -(defmethod perform ((o test-op) (c (eql (find-system :sb-introspect)))) - (operate 'load-op :sb-introspect-tests) - (operate 'test-op :sb-introspect-tests)) + :components ((:file "introspect")) + #+sb-building-contrib :pathname + #+sb-building-contrib #p"SYS:CONTRIB;SB-INTROSPECT;" + :perform (load-op :after (o c) (provide 'sb-introspect)) + :perform (test-op (o c) (test-system :sb-introspect/tests))) (defclass plist-file (cl-source-file) ((source-plist @@ -42,41 +37,42 @@ ()) (defmethod perform ((op compile-op) (com source-only-file))) - +(defmethod perform ((op load-op) (com source-only-file))) (defmethod output-files ((op compile-op) (com source-only-file)) - (list (component-pathname com))) + ()) +(defmethod component-depends-on ((op load-op) (com source-only-file)) + `((load-source-op ,com) ,@(call-next-method))) -(defsystem :sb-introspect-tests +(defsystem :sb-introspect/tests :depends-on (:sb-introspect :sb-rt) + #+sb-building-contrib :pathname + #+sb-building-contrib #p"SYS:CONTRIB;SB-INTROSPECT;" :components ((:file "xref-test-data") (:file "xref-test" :depends-on ("xref-test-data")) - (:plist-file "test" :source-plist (:test-outer "OUT")) + (:plist-file "test" :source-plist (:test-outer "OUT") :operation-done-p (compile-op (o c) nil)) (:source-only-file "load-test") - (:file "test-driver" :depends-on ("test" "load-test")))) - -(defmethod perform ((op test-op) (com (eql (find-system :sb-introspect-tests)))) - ;; N.b. At least DEFINITION-SOURCE-PLIST.1 assumes that CWD is the - ;; contrib/sb-introspect directory which is true for when this is - ;; implicitly run via make-target-contribs.sh -- but not when this - ;; is executed manually. - (let ((*default-pathname-defaults* - (make-pathname :directory (pathname-directory - '#.(or *compile-file-pathname* - *load-pathname*))))) - (multiple-value-bind (soft strict #+sb-testing-contrib pending) - (funcall (find-symbol "DO-TESTS" "SB-RT")) - (fresh-line) - (unless strict - #+sb-testing-contrib - ;; We create TEST-PASSED from a shell script if tests passed. But - ;; since the shell script only `touch'es it, we can actually create - ;; it ahead of time -- as long as we're certain that tests truly - ;; passed, hence the check for SOFT. - (when soft - (with-open-file (s #p"SYS:CONTRIB;SB-INTROSPECT;TEST-PASSED" - :direction :output) - (dolist (pend pending) - (format s "Expected failure: ~A~%" pend)))) - (warn "ignoring expected failures in test-op")) - (unless soft - (error "test-op failed with unexpected failures"))))) + (:file "test-driver" :depends-on ("test" "load-test"))) + :perform + (test-op (o c) + ;; N.b. At least DEFINITION-SOURCE-PLIST.1 assumes that CWD is the + ;; contrib/sb-introspect directory which is true for when this is + ;; implicitly run via make-target-contribs.sh -- but not when this + ;; is executed manually. + (let ((*default-pathname-defaults* (translate-logical-pathname (system-source-directory c)))) + (multiple-value-bind (soft strict pending) (symbol-call :sb-rt :do-tests) + (declare (ignorable pending)) + (fresh-line) + (unless strict + #+sb-testing-contrib + ;; We create TEST-PASSED from a shell script if tests passed. But + ;; since the shell script only `touch'es it, we can actually create + ;; it ahead of time -- as long as we're certain that tests truly + ;; passed, hence the check for SOFT. + (when soft + (with-open-file (s #p"SYS:CONTRIB;SB-INTROSPECT;TEST-PASSED" + :direction :output) + (dolist (pend pending) + (format s "Expected failure: ~A~%" pend)))) + (warn "ignoring expected failures in test-op")) + (unless soft + (error "test-op failed with unexpected failures")))))) diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp index fe920f0..2120644 100644 --- a/contrib/sb-introspect/test-driver.lisp +++ b/contrib/sb-introspect/test-driver.lisp @@ -32,13 +32,15 @@ (deftest definition-source-plist.1 (let* ((source (find-definition-source #'cl-user::one)) - (plist (definition-source-plist source))) - (values (= (definition-source-file-write-date source) - (file-write-date "test.lisp")) + (plist (definition-source-plist source)) + (pathname (definition-source-pathname source))) + (values (equalp pathname #p"SYS:CONTRIB;SB-INTROSPECT;TEST.LISP.NEWEST") + (= (definition-source-file-write-date source) + (file-write-date pathname)) (or (equal (getf plist :test-outer) "OUT") plist))) - t t) + t t t) (deftest definition-source-plist.2 (let ((plist (definition-source-plist @@ -202,7 +204,7 @@ (matchp-name :function 'cl-user::loaded-as-source-fun 3) t) -(deftest find-source-stuff. +(deftest find-source-stuff.33 (matchp-name :variable 'cl-user::**global** 29) t) @@ -564,7 +566,7 @@ (predicate (find-definition-source #'cl-user::three-p))) (values (and (equalp copier accessor) (equalp copier predicate)) - (equal "test.lisp" + (equal "TEST.LISP.NEWEST" (file-namestring (definition-source-pathname copier))) (equal '(5) (definition-source-form-path copier)))) @@ -578,7 +580,7 @@ (predicate (car (find-definition-sources-by-name 'cl-user::three-p :function)))) (values (and (equalp copier accessor) (equalp copier predicate)) - (equal "test.lisp" + (equal "TEST.LISP.NEWEST" (file-namestring (definition-source-pathname copier))) (equal '(5) (definition-source-form-path copier)))) diff --git a/contrib/sb-posix/sb-posix.asd b/contrib/sb-posix/sb-posix.asd index 325d8f4..9963183 100644 --- a/contrib/sb-posix/sb-posix.asd +++ b/contrib/sb-posix/sb-posix.asd @@ -1,49 +1,39 @@ ;;; -*- Lisp -*- -(cl:eval-when (:compile-toplevel :load-toplevel :execute) - (asdf:oos 'asdf:load-op :sb-grovel)) -(defpackage #:sb-posix-system (:use #:asdf #:cl #:sb-grovel)) -(in-package #:sb-posix-system) - (defsystem sb-posix - :depends-on (sb-grovel) - #+sb-building-contrib :pathname - #+sb-building-contrib #p"SYS:CONTRIB;SB-POSIX;" - :components ((:file "defpackage") - (:file "designator" :depends-on ("defpackage")) - (:file "macros" :depends-on ("designator")) - (sb-grovel:grovel-constants-file - "constants" - :do-not-grovel #.(progn #-sb-building-contrib t) - :package :sb-posix :depends-on ("defpackage")) - (:file "interface" :depends-on ("constants" "macros" "designator")))) - -(defsystem sb-posix-tests - :depends-on (sb-rt) - :components ((:file "posix-tests"))) - -(defmethod perform :after ((o load-op) (c (eql (find-system :sb-posix)))) - (provide 'sb-posix)) - -(defmethod perform ((o test-op) (c (eql (find-system :sb-posix)))) - (operate 'load-op 'sb-posix-tests) - (operate 'test-op 'sb-posix-tests)) + :defsystem-depends-on (sb-grovel) + #+sb-building-contrib :pathname + #+sb-building-contrib #p"SYS:CONTRIB;SB-POSIX;" + :components ((:file "defpackage") + (:file "designator" :depends-on ("defpackage")) + (:file "macros" :depends-on ("designator")) + (:sb-grovel-constants-file "constants" + :package :sb-posix :depends-on ("defpackage")) + (:file "interface" :depends-on ("constants" "macros" "designator"))) + :perform (load-op :after (o c) (provide 'sb-posix)) + :perform (test-op (o c) (test-system 'sb-posix/tests))) -(defmethod perform ((o test-op) (c (eql (find-system :sb-posix-tests)))) - (funcall (intern "DO-TESTS" (find-package "SB-RT"))) - (let ((failures (funcall (intern "PENDING-TESTS" "SB-RT"))) - (ignored-failures (loop for sym being the symbols of :sb-posix-tests - if (search ".ERROR" (symbol-name sym)) - collect sym))) - (cond - ((null failures) - t) - ((null (set-difference failures ignored-failures)) - (warn "~@") - t) - (t - (error "non-errno tests failed!"))))) +(defsystem sb-posix/tests + :depends-on (sb-rt) + #+sb-building-contrib :pathname + #+sb-building-contrib #p"SYS:CONTRIB;SB-POSIX;" + :components ((:file "posix-tests")) + :perform + (test-op (o c) + (funcall (intern "DO-TESTS" (find-package "SB-RT"))) + (let ((failures (funcall (intern "PENDING-TESTS" "SB-RT"))) + (ignored-failures (loop for sym being the symbols of :sb-posix-tests + if (search ".ERROR" (symbol-name sym)) + collect sym))) + (cond + ((null failures) + t) + ((null (set-difference failures ignored-failures)) + (warn "~@") + t) + (t + (error "non-errno tests failed!")))))) diff --git a/contrib/sb-rotate-byte/sb-rotate-byte.asd b/contrib/sb-rotate-byte/sb-rotate-byte.asd index 036f1ba..dc5be27 100644 --- a/contrib/sb-rotate-byte/sb-rotate-byte.asd +++ b/contrib/sb-rotate-byte/sb-rotate-byte.asd @@ -1,9 +1,5 @@ ;;; -*- Lisp -*- -(cl:defpackage #:sb-rotate-byte-system - (:use #:asdf #:cl)) -(cl:in-package #:sb-rotate-byte-system) - (defsystem sb-rotate-byte :version "0.1" #+sb-building-contrib :pathname @@ -12,22 +8,20 @@ ((:file "package") (:file "compiler" :depends-on ("package")) (:module "vm" - :depends-on ("compiler") - :components - (#+x86 - (:file "x86-vm") - #+x86-64 - (:file "x86-64-vm") - #+ppc - (:file "ppc-vm")) - :pathname - #+sb-building-contrib #p"SYS:CONTRIB;SB-ROTATE-BYTE;" - #-sb-building-contrib #.(make-pathname :directory '(:relative))) - (:file "rotate-byte" :depends-on ("compiler")))) + :depends-on ("compiler") + :pathname "" + :components + ((:file "x86-vm" :if-feature :x86) + (:file "x86-64-vm" :if-feature :x86-64) + (:file "ppc-vm" :if-feature :ppc))) + (:file "rotate-byte" :depends-on ("compiler"))) + :perform (load-op :after (o c) (provide 'sb-rotate-byte)) + :perform (test-op (o c) (test-system 'sb-rotate-byte/tests))) + -(defmethod perform :after ((o load-op) (c (eql (find-system :sb-rotate-byte)))) - (provide 'sb-rotate-byte)) +(defsystem sb-rotate-byte/tests + #+sb-building-contrib :pathname + #+sb-building-contrib #p"SYS:CONTRIB;SB-ROTATE-BYTE;" + :depends-on (sb-rotate-byte) + :components ((:file "rotate-byte-tests"))) -(defmethod perform ((o test-op) (c (eql (find-system :sb-rotate-byte)))) - (or (load (compile-file "rotate-byte-tests.lisp")) - (error "test-op failed"))) diff --git a/contrib/sb-simple-streams/sb-simple-streams.asd b/contrib/sb-simple-streams/sb-simple-streams.asd index 3e103db..a69e085 100644 --- a/contrib/sb-simple-streams/sb-simple-streams.asd +++ b/contrib/sb-simple-streams/sb-simple-streams.asd @@ -1,9 +1,5 @@ ;;; -*- lisp -*- -(defpackage #:sb-simple-stream-system (:use #:asdf #:cl)) -(in-package #:sb-simple-stream-system) - - (defsystem sb-simple-streams :depends-on (sb-bsd-sockets sb-posix) #+sb-building-contrib :pathname @@ -24,22 +20,12 @@ (:file "string" :depends-on ("strategy")) (:file "terminal" :depends-on ("strategy")) ;;(:file "gray-compat" :depends-on ("package")) - )) - -(defmethod perform :after ((o load-op) - (c (eql (find-system :sb-simple-streams)))) - (provide 'sb-simple-streams)) - -(defmethod perform ((o test-op) (c (eql (find-system :sb-simple-streams)))) - (operate 'load-op 'sb-simple-streams-tests) - (operate 'test-op 'sb-simple-streams-tests)) + ) + :perform (load-op :after (o c) (provide 'sb-simple-streams)) + :perform (test-op (o c) (test-system 'sb-simple-streams/tests))) - -(defsystem sb-simple-streams-tests +(defsystem sb-simple-streams/tests :depends-on (sb-rt sb-simple-streams) + #+sb-building-contrib :pathname + #+sb-building-contrib #p"SYS:CONTRIB;SB-SIMPLE-STREAMS;" :components ((:file "simple-stream-tests"))) - -(defmethod perform ((o test-op) - (c (eql (find-system :sb-simple-streams-tests)))) - (or (funcall (intern "DO-TESTS" (find-package "SB-RT"))) - (error "test-op failed"))) diff --git a/contrib/vanilla-module.mk b/contrib/vanilla-module.mk index 41c1771..01396f8 100644 --- a/contrib/vanilla-module.mk +++ b/contrib/vanilla-module.mk @@ -1,8 +1,15 @@ +DEST=$(SBCL_PWD)/obj/sbcl-home/contrib/ +FASL=$(DEST)/$(MODULE).fasl +ASD=$(DEST)/$(MODULE).asd -$(MODULE).fasl: $(MODULE).lisp ../../output/sbcl.core - $(SBCL) --eval '(compile-file (format nil "SYS:CONTRIB;~:@(~A~);~:@(~A~).LISP" "$(MODULE)" "$(MODULE)"))' $@ + +test:: $(FASL) $(ASD) install: - cp $(MODULE).fasl "$(BUILD_ROOT)$(INSTALL_DIR)" + cp $(FASL) $(ASD) "$(BUILD_ROOT)$(INSTALL_DIR)" diff --git a/install.sh b/install.sh index 2e01c41..0b2efdb 100644 --- a/install.sh +++ b/install.sh @@ -75,16 +75,16 @@ sbcl_pwd SBCL="$SBCL_PWD/src/runtime/sbcl --noinform --core $SBCL_PWD/output/sbcl.core --no-userinit --no-sysinit --disable-debugger" SBCL_BUILDING_CONTRIB=1 -export SBCL SBCL_BUILDING_CONTRIB +export SBCL SBCL_BUILDING_CONTRIB SBCL_PWD . ./find-gnumake.sh find_gnumake -for i in contrib/*; do - test -d $i && test -f $i/test-passed || continue; - INSTALL_DIR="$SBCL_HOME"/`basename $i ` +for i in `cd contrib ; echo *`; do + test -d contrib/$i && test -f obj/asdf-cache/$i/test-passed.test-report || continue; + INSTALL_DIR="$SBCL_HOME/contrib/" export INSTALL_DIR - ensure_dirs "$BUILD_ROOT$INSTALL_DIR" && $GNUMAKE -C $i install + ensure_dirs "$BUILD_ROOT$INSTALL_DIR" && $GNUMAKE -C contrib/$i install < /dev/null done echo diff --git a/make-target-contrib.sh b/make-target-contrib.sh index b609072..57ed2eb 100644 --- a/make-target-contrib.sh +++ b/make-target-contrib.sh @@ -27,8 +27,8 @@ export CC LANG LC_ALL . ./sbcl-pwd.sh sbcl_pwd -SBCL_HOME="$SBCL_PWD/contrib" -export SBCL_HOME +SBCL_HOME="$SBCL_PWD/obj/sbcl-home" +export SBCL_HOME SBCL_PWD if [ "$OSTYPE" = "cygwin" ] ; then SBCL_PWD=`echo $SBCL_PWD | sed s/\ /\\\\\\\\\ /g` fi @@ -43,39 +43,37 @@ export SBCL SBCL_BUILDING_CONTRIB # operation, because that causes multiple builds of base systems such # as SB-RT and SB-GROVEL, but FIXME: there's probably a better # solution. -- CSR, 2003-05-30 - -find contrib/ \( -name '*.fasl' -o \ - -name '*.FASL' -o \ - -name 'foo.c' -o \ - -name 'FOO.C' -o \ - -name 'a.out' -o \ - -name 'A.OUT' -o \ - -name 'alien.so' -o \ - -name 'ALIEN.SO' -o \ - -name '*.o' -o \ - -name '*.O' \) \ - -print | xargs rm -f +if [ -z "$DONT_CLEAN_SBCL_CONTRIB" ] ; then + find contrib/ obj/asdf-cache/ obj/sbcl-home/contrib/ \ + \( -name '*.fasl' -o \ + -name '*.FASL' -o \ + -name 'foo.c' -o \ + -name 'FOO.C' -o \ + -name 'a.out' -o \ + -name 'A.OUT' -o \ + -name 'alien.so' -o \ + -name 'ALIEN.SO' -o \ + -name '*.o' -o \ + -name '*.O' \) \ + -print | xargs rm -f +fi find output -name 'building-contrib.*' -print | xargs rm -f # Ignore all source registries. -CL_SOURCE_REGISTRY='(:source-registry :ignore-inherited-configuration)' -export CL_SOURCE_REGISTRY - if [ -z "$*" ]; then - contribs_to_build=contrib/* + contribs_to_build="`cd contrib ; echo *`" else - for name in $*; do - contribs_to_build="contrib/$name $contribs_to_build" - done + contribs_to_build="$*" fi for i in $contribs_to_build; do - test -d $i && test -f $i/Makefile || continue; - # export INSTALL_DIR=$SBCL_HOME/`basename $i ` - test -f $i/test-passed && rm $i/test-passed + test -d contrib/$i && test -f contrib/$i/Makefile || continue; + test -f contrib/$i/test-passed && rm contrib/$i/test-passed # remove old convention + test -f obj/asdf-cache/$i/test-passed.test-report && rm obj/asdf-cache/$i/test-passed.test-report + mkdir -p obj/asdf-cache/$i/ # hack to get exit codes right. - if $GNUMAKE -C $i test 2>&1 && touch $i/test-passed ; then + if $GNUMAKE -C contrib/$i test < /dev/null 2>&1 && touch obj/asdf-cache/$i/test-passed.test-report ; then : else exit $? @@ -84,8 +82,8 @@ done # Otherwise report expected failures: HEADER_HAS_BEEN_PRINTED=false -for dir in contrib/*; do - f="$dir/test-passed" +for dir in `cd obj/asdf-cache/ ; echo *`; do + f="obj/asdf-cache/$dir/test-passed.test-report" if test -f "$f" && grep -i fail "$f" >/dev/null; then if ! $HEADER_HAS_BEEN_PRINTED; then cat < /dev/null else @@ -116,7 +114,7 @@ their self-tests. Failed contribs:" EOF HEADER_HAS_BEEN_PRINTED=true fi - echo " `basename $dir`" + echo " $dir" fi done diff --git a/run-sbcl.sh b/run-sbcl.sh index a3507d1..44aaf68 100755 --- a/run-sbcl.sh +++ b/run-sbcl.sh @@ -53,7 +53,7 @@ fi if [ -x "$BASE"/src/runtime/sbcl -a -f "$BASE"/output/sbcl.core ]; then echo "(running SBCL from: $BASE)" 1>&2 - SBCL_HOME="$BASE"/contrib "$BASE"/src/runtime/sbcl $ARGUMENTS "$@" + SBCL_HOME="$BASE/obj/sbcl-home" "$BASE"/src/runtime/sbcl $ARGUMENTS "$@" else echo "No built SBCL here ($BASE): run 'sh make.sh' first!" exit 1 diff --git a/src/code/module.lisp b/src/code/module.lisp index fe3b765..a6b47b4 100644 --- a/src/code/module.lisp +++ b/src/code/module.lisp @@ -83,7 +83,7 @@ (let* ((filesys-name (string-downcase (string name))) (unadorned-path (merge-pathnames - (make-pathname :directory (list :relative filesys-name) + (make-pathname :directory (list :relative "contrib") :name filesys-name) (truename (or (sbcl-homedir-pathname) (return-from module-provide-contrib nil))))) @@ -96,8 +96,11 @@ ;; be removed by the time we get round to trying to load it. ;; Maybe factor out the logic in the LOAD guesser as to which file ;; was meant, so that we can use it here on open streams instead? - (when (or (probe-file unadorned-path) - (probe-file fasl-path) - (probe-file lisp-path)) - (load unadorned-path) - t))) + (let ((file (or (probe-file fasl-path) + (probe-file unadorned-path) + (probe-file lisp-path)))) + (when file + (handler-bind + (((or style-warning sb!int:package-at-variance) #'muffle-warning)) + (load file)) + t)))) -- 1.8.4