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
;;; -*- 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))
-
# 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
# 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__
export CC SBCL EXTRA_CFLAGS EXTRA_LDFLAGS
-all: $(EXTRA_ALL_TARGETS)
+all: $(FASL) $(ASD) $(EXTRA_ALL_TARGETS)
+
+$(FASL)::
$(MAKE) -C ../asdf
- $(SBCL) --eval '(defvar *system* "$(SYSTEM)")' --load ../asdf-stub.lisp --eval '(exit)'
+ $(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)"
-(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))
-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 "$@"))' </dev/null
-test::
+install::
+ cp $(FASL) "$(BUILD_ROOT)$(INSTALL_DIR)"
+
+test:: $(FASL)
true
-up:
+UPSTREAM=../../obj/asdf-upstream
+up::
sh pull-asdf.sh
- (cd asdf-upstream; make build/asdf.lisp)
- cp asdf-upstream/build/asdf.lisp asdf.lisp
- cp asdf-upstream/doc/asdf.texinfo asdf.texinfo
- cp asdf-upstream/README README
+ ln -f $(UPSTREAM)/build/asdf.lisp asdf.lisp
+ ln -f $(UPSTREAM)/doc/asdf.texinfo asdf.texinfo
+ ln -f $(UPSTREAM)/README README
-#!/bin/sh
+#!/bin/sh -e
# Get the current ASDF release from the upstream repo.
if test -d asdf-upstream
then
- cd asdf-upstream
+ if test -d ../../obj/asdf-upstream
+ then
+ rm -rf asdf-upstream
+ else
+ mv asdf-upstream ../../obj/asdf-upstream
+ fi
+fi
+
+if test -d ../../obj/asdf-upstream
+then
+ (cd ../../obj/asdf-upstream/
git checkout release
git reset --hard release
- git pull -a
+ git pull -a origin release)
else
- git clone --branch release git://common-lisp.net/projects/asdf/asdf.git asdf-upstream
+ (cd ../../obj/
+ git clone --branch release git://common-lisp.net/projects/asdf/asdf.git asdf-upstream)
fi
+
+cd ../../obj/asdf-upstream && make
;;; -*- Lisp -*-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require :sb-grovel))
-(defpackage #:sb-bsd-sockets-system (:use #:asdf #:sb-grovel #:cl))
-(in-package #:sb-bsd-sockets-system)
(defsystem sb-bsd-sockets
- :version "0.58"
- :depends-on (sb-grovel)
- #+sb-building-contrib :pathname
- #+sb-building-contrib #p"SYS:CONTRIB;SB-BSD-SOCKETS;"
- :components ((:file "defpackage")
- (:file "split" :depends-on ("defpackage"))
- #+win32
- (:file "win32-lib")
- #-win32 (sb-grovel:grovel-constants-file
- "constants"
- :package :sockint
- :do-not-grovel #.(progn #-sb-building-contrib t)
- :depends-on ("defpackage"))
- #+win32 (sb-grovel:grovel-constants-file
- "win32-constants"
- :package :sockint
- :do-not-grovel #.(progn #-sb-building-contrib t)
- :depends-on ("defpackage" "win32-lib"))
- #+win32 (:file "win32-sockets"
- :depends-on ("win32-constants"))
- (:file "sockets"
- :depends-on #-win32 ("constants")
- #+win32 ("win32-sockets"))
- (:file "sockopt" :depends-on ("sockets"))
- (:file "inet" :depends-on ("sockets" "split"))
- (:file "local" :depends-on ("sockets" "split"))
- (:file "name-service" :depends-on ("sockets"))
- (:file "misc" :depends-on ("sockets"))
+ :version "0.58"
+ :defsystem-depends-on (sb-grovel)
+ #+sb-building-contrib :pathname
+ #+sb-building-contrib #p"SYS:CONTRIB;SB-BSD-SOCKETS;"
+ :components
+ ((:file "defpackage")
+ (:file "split" :depends-on ("defpackage"))
+ (:file "win32-lib" :if-feature :win32)
+ (:sb-grovel-constants-file "constants" :package :sockint
+ :depends-on ("defpackage") :if-feature (:not :win32))
+ (:sb-grovel-constants-file "win32-constants" :package
+ :sockint :depends-on ("defpackage" "win32-lib") :if-feature :win32)
+ (:file "win32-sockets"
+ :depends-on ("win32-constants") :if-feature :win32)
+ (:file "sockets" :depends-on ("constants" "win32-sockets"))
+ (:file "sockopt" :depends-on ("sockets"))
+ (:file "inet" :depends-on ("sockets" "split"))
+ (:file "local" :depends-on ("sockets" "split"))
+ (:file "name-service" :depends-on ("sockets"))
+ (:file "misc" :depends-on ("sockets"))
+ (:static-file "NEWS")
+ ;; (:static-file "INSTALL")
+ ;; (:static-file "README")
+ ;; (:static-file "index.html")
+ (:static-file "TODO"))
+ :perform (load-op :after (o c) (provide 'sb-bsd-sockets))
+ :perform (test-op (o c) (test-system 'sb-bsd-sockets/tests)))
- (:static-file "NEWS")
- ;; (:static-file "INSTALL")
- ;; (:static-file "README")
- ;; (:static-file "index" :pathname "index.html")
- (:static-file "TODO")))
-
-(defmethod perform :after ((o load-op) (c (eql (find-system :sb-bsd-sockets))))
- (provide 'sb-bsd-sockets))
-
-(defmethod perform ((o test-op) (c (eql (find-system :sb-bsd-sockets))))
- (operate 'load-op 'sb-bsd-sockets-tests)
- (operate 'test-op 'sb-bsd-sockets-tests))
-
-(defsystem sb-bsd-sockets-tests
+(defsystem sb-bsd-sockets/tests
:depends-on (sb-rt sb-bsd-sockets #-win32 sb-posix)
- :components ((:file "tests")))
-
-(defmethod perform ((o test-op) (c (eql (find-system :sb-bsd-sockets-tests))))
- (multiple-value-bind (soft strict pending)
- (funcall (intern "DO-TESTS" (find-package "SB-RT")))
- (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-BSD-SOCKETS;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"))))
+ :components ((:file "tests"))
+ :perform (test-op (o c)
+ (multiple-value-bind (soft strict pending)
+ (funcall (intern "DO-TESTS" (find-package "SB-RT")))
+ (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-BSD-SOCKETS;TEST-PASSED.TEST-REPORT"
+ :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")))))
(c (eql (asdf:find-system :sb-concurrency-tests))))
(multiple-value-bind (soft strict pending)
(funcall (intern "DO-TESTS" (find-package "SB-RT")))
+ (declare (ignorable pending))
(fresh-line)
(unless strict
#+sb-testing-contrib
(make-pathname :directory (append (or (pathname-directory pathname)
(list :relative))
(list (file-namestring pathname)))
- :name nil :type nil
+ :name nil :type nil :version nil
:defaults pathname)))))
(defun report (directory &key ((:form-mode *source-path-mode*) :whole)
it has the value :WHOLE the whole form will be annotated (the default).
The former mode shows explicitly which forms were instrumented, while the
latter mode is generally easier to read."
- (let ((paths)
- (*default-pathname-defaults* (pathname-as-directory directory)))
+ (let* ((paths)
+ (directory (pathname-as-directory directory))
+ (*default-pathname-defaults* (translate-logical-pathname directory)))
(ensure-directories-exist *default-pathname-defaults*)
(maphash (lambda (k v)
(declare (ignore v))
- (let* ((n (format nil "~(~{~2,'0X~}~)"
+ (let* ((pk (translate-logical-pathname k))
+ (n (format nil "~(~{~2,'0X~}~)"
(coerce (sb-md5:md5sum-string
- (sb-ext:native-namestring k))
+ (sb-ext:native-namestring pk))
'list)))
- (path (make-pathname :name n :type "html")))
+ (path (make-pathname :name n :type "html" :defaults directory)))
(when (probe-file k)
+ (ensure-directories-exist pk)
(with-open-file (stream path
:direction :output
:if-exists :supersede
(push (list* k n (report-file k stream external-format))
paths)))))
*code-coverage-info*)
- (let ((report-file (make-pathname :name "cover-index" :type "html")))
+ (let ((report-file (make-pathname :name "cover-index" :type "html" :defaults directory)))
(with-open-file (stream report-file
:direction :output :if-exists :supersede
:if-does-not-exist :create)
;;; -*- Lisp -*-
(defsystem sb-cover
- #+sb-building-contrib :pathname
- #+sb-building-contrib #p"SYS:CONTRIB;SB-COVER;"
- :depends-on (sb-md5)
- :components ((:file "cover")))
+ #+sb-building-contrib :pathname
+ #+sb-building-contrib #p"SYS:CONTRIB;SB-COVER;"
+ :depends-on (sb-md5)
+ :components ((:file "cover"))
+ :perform (load-op :after (o c) (provide 'sb-cover))
+ :perform (test-op :after (o c) (test-system 'sb-cover/tests)))
-(defsystem sb-cover-tests
- :components ((:file "tests")))
+(defsystem sb-cover/tests
+ #+sb-building-contrib :pathname
+ #+sb-building-contrib #p"SYS:CONTRIB;SB-COVER;"
+ :depends-on (sb-cover asdf)
+ :components ((:file "tests")))
-(defmethod perform :after ((o load-op) (c (eql (find-system :sb-cover))))
- (provide 'sb-cover))
-
-(defmethod perform ((o test-op) (c (eql (find-system :sb-cover))))
- (operate 'load-op 'sb-cover-tests)
- (operate 'test-op 'sb-cover-tests))
-(defpackage sb-cover-test
- (:use "CL"))
+(defpackage sb-cover-test (:use :cl :asdf :uiop))
(in-package sb-cover-test)
-(defparameter *path* #.(truename *compile-file-pathname*))
+(defparameter *source-directory*
+ (system-source-directory :sb-cover))
(defparameter *output-directory*
- (merge-pathnames (make-pathname :name nil
- :type nil
- :version nil
- :directory '(:relative "test-output"))
- (make-pathname :directory (pathname-directory *path*))))
+ (apply-output-translations *source-directory*))
+
+(setf *default-pathname-defaults* (translate-logical-pathname *default-pathname-defaults*))
+
+(defun compile-load (x)
+ (flet ((in-dir (dir type)
+ (translate-logical-pathname (subpathname dir x :type type))))
+ (load (compile-file (in-dir *source-directory* "lisp")
+ :output-file (in-dir *output-directory* "fasl")))))
(defun report ()
(handler-case
(error "Should've raised a warning"))
(warning ())))
+
;;; No instrumentation
-(load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
+(compile-load "test-data-1")
(report-expect-failure)
;;; Instrument the file, try again -- first with a non-directory pathname
(proclaim '(optimize sb-cover:store-coverage-data))
-(load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
+(compile-load "test-data-1")
(catch 'ok
(handler-case
(report)
-(assert (probe-file (make-pathname :name "cover-index" :type "html"
- :defaults *output-directory*)))
+(assert (probe-file (subpathname *output-directory* "cover-index.html")))
;;; None of the code was executed
(assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
(report-expect-failure)
;;; Another file, with some branches
-(load (compile-file (merge-pathnames #p"test-data-2.lisp" *path*)))
+(compile-load "test-data-2")
(test2 1)
(report)
(sb-cover::all-of (getf sb-cover::*counts* :branch))))
;; Check for presence of constant coalescing bugs
-
-(load (compile-file (merge-pathnames #p"test-data-3.lisp" *path*)))
+(compile-load "test-data-3")
(test-2)
;; Clean up after the tests
-
(map nil #'delete-file
(directory (merge-pathnames #p"*.html" *output-directory*)))
(when (eql type :errno)
(printf "(cl:setf (get '~A 'errno) t)" lispname))
(as-c "#else")
- (printf "(sb-int:style-warn \"Couldn't grovel for ~A (unknown to the C compiler).\")" cname)
+ (printf "(sb-int:style-warn \"Couldn't grovel for ~~A (unknown to the C compiler).\" \"~A\")" cname)
(as-c "#endif"))
(:enum
(c-for-enum lispname cname export))
(definitions (read i)))
(print-c-source f headers definitions package)))))
-(defclass grovel-constants-file (asdf:cl-source-file)
+(defclass grovel-constants-file (cl-source-file)
((package :accessor constants-package :initarg :package)
(do-not-grovel :accessor do-not-grovel
:initform nil
:initarg :do-not-grovel)))
+(defclass asdf::sb-grovel-constants-file (grovel-constants-file) ())
-(define-condition c-compile-failed (compile-failed) ()
- (:report (lambda (c s)
- (format s "~@<C compiler failed when performing ~A on ~A.~@:>"
- (error-operation c) (error-component c)))))
-(define-condition a-dot-out-failed (compile-failed) ()
- (:report (lambda (c s)
- (format s "~@<a.out failed when performing ~A on ~A.~@:>"
- (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)
:input nil
:output *trace-output*))))
(unless (= code 0)
- (case (operation-on-failure op)
- (:warn (warn "~@<C compiler failure when performing ~A on ~A.~@:>"
- 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))
:input nil
:output *trace-output*))))
(unless (= code 0)
- (case (operation-on-failure op)
- (:warn (warn "~@<a.out failure when performing ~A on ~A.~@:>"
- 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 "~@<COMPILE-FILE warned while ~
- performing ~A on ~A.~@:>")
- op component))
- (:error (error 'compile-warned :component component :operation op))
- (:ignore nil)))
- (when failure-p
- (case (operation-on-failure op)
- (:warn (warn
- (formatter "~@<COMPILE-FILE failed while ~
- performing ~A on ~A.~@:>")
- 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)))))
;; 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"))
;;; -*- 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))
;;;; 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
())
(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"))))))
(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
(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)
(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))))
(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))))
;;; -*- 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 "~@<some POSIX implementations return incorrect error values for ~
- failing calls, but there is legitimate variation between ~
- implementations too. If you think the errno ~
- from your platform is valid, please contact the sbcl ~
- developers; otherwise, please submit a bug report to your ~
- kernel distributor~@:>")
- 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 "~@<some POSIX implementations return incorrect error values for ~
+ failing calls, but there is legitimate variation between ~
+ implementations too. If you think the errno ~
+ from your platform is valid, please contact the sbcl ~
+ developers; otherwise, please submit a bug report to your ~
+ kernel distributor~@:>")
+ t)
+ (t
+ (error "non-errno tests failed!"))))))
;;; -*- 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
((: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")))
;;; -*- 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
(: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")))
+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)"))' </dev/null
+fasl:: $(FASL)
+$(FASL):: $(MODULE).lisp ../../output/sbcl.core
+ $(SBCL) --eval '(compile-file (format nil "SYS:CONTRIB;~:@(~A~);~:@(~A~).LISP" "$(MODULE)" "$(MODULE)") :output-file (parse-native-namestring "$@"))' </dev/null
-test:: $(MODULE).fasl
+$(ASD)::
+ echo "(defsystem :$(MODULE) :class require-system)" > $@
+
+test:: $(FASL) $(ASD)
install:
- cp $(MODULE).fasl "$(BUILD_ROOT)$(INSTALL_DIR)"
+ cp $(FASL) $(ASD) "$(BUILD_ROOT)$(INSTALL_DIR)"
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
. ./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
# 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 $?
# 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 <<EOF
EOF
HEADER_HAS_BEEN_PRINTED=true
fi
- echo " $dir"
+ echo " contrib/$dir"
(unset IFS; while read line; do echo " $line"; done <"$f")
fi
done
# Sometimes people used to see the "No tests failed." output from the last
# DEFTEST in contrib self-tests and think that's all that is. So...
HEADER_HAS_BEEN_PRINTED=false
-for dir in contrib/*
+for dir in `cd contrib ; echo *`
do
- if [ -d "$dir" -a -f "$dir/Makefile" -a ! -f "$dir/test-passed" ]; then
+ if [ -d "contrib/$dir" -a -f "contrib/$dir/Makefile" -a ! -f "obj/asdf-cache/$dir/test-passed.test-report" ]; then
if $HEADER_HAS_BEEN_PRINTED; then
echo > /dev/null
else
EOF
HEADER_HAS_BEEN_PRINTED=true
fi
- echo " `basename $dir`"
+ echo " $dir"
fi
done
time sh make-target-contrib.sh
NCONTRIBS=`find contrib -name Makefile -print | wc -l`
-NPASSED=`find contrib -name test-passed -print | wc -l`
+NPASSED=`find obj/asdf-cache -name test-passed.test-report -print | wc -l`
echo
echo "The build seems to have finished successfully, including $NPASSED (out of $NCONTRIBS)"
echo "contributed modules. If you would like to run more extensive tests on"
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
(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)))))
;; 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))))
projects / sbcl.git / commitdiff