Deliver each contrib as a single FASL. Don't implicitly require ASDF or source code...

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.

Fixes lp#1132254.

diff --git a/.gitignore b/.gitignore
index 82898af..729b950 100644 (file)
--- 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
 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
 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 (file)
--- a/contrib/asdf-install/asdf-install.asd
+++ b/contrib/asdf-install/asdf-install.asd
@@ -1,20 +1,10 @@
 ;;; -*-  Lisp -*-
 ;;; -*-  Lisp -*-

-
-(defpackage #:asdf-install-system
-  (:use #:cl #:asdf))
-
-(in-package #:asdf-install-system)
-

 (defsystem asdf-install
   :depends-on (sb-posix sb-bsd-sockets)
 (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;"
   #+sb-building-contrib :pathname
   #+sb-building-contrib #p"SYS:CONTRIB;ASDF-INSTALL;"

+  :version "0.2"

   :components ((:file "defpackage")
   :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..e211f0c 100644 (file)
--- 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
 # 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)
 # 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__
 
 ifeq (SunOS,$(UNAME))
   EXTRA_CFLAGS=-D_XOPEN_SOURCE=500 -D__EXTENSIONS__

@@ -27,18 +29,21 @@ endif
 
 export CC SBCL EXTRA_CFLAGS EXTRA_LDFLAGS
 
 
 export CC SBCL EXTRA_CFLAGS EXTRA_LDFLAGS
 

-all: $(EXTRA_ALL_TARGETS)
+all: $(FASL) $(ASD) $(EXTRA_ALL_TARGETS)
+
+$(FASL)::

        $(MAKE) -C ../asdf
        $(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)
 
 # 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 (file)
--- 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*)
   (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 (file)
--- 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 "$@"))' </dev/null

 
 

-test::
+install::
+       cp $(FASL) "$(BUILD_ROOT)$(INSTALL_DIR)"
+
+test:: $(FASL)

        true
 
        true
 

-up:
+UPSTREAM=../../obj/asdf-upstream
+up::

        sh pull-asdf.sh
        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

diff --git a/contrib/asdf/pull-asdf.sh b/contrib/asdf/pull-asdf.sh
index 35f5669..9aed165 100644 (file)
--- a/contrib/asdf/pull-asdf.sh
+++ b/contrib/asdf/pull-asdf.sh
@@ -1,13 +1,26 @@
-#!/bin/sh
+#!/bin/sh -e

 
 # Get the current ASDF release from the upstream repo.
 
 if test -d asdf-upstream
 then
 
 # 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 checkout release
     git reset --hard release

-    git pull -a
+    git pull -a origin release)

 else
 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
 fi

+
+cd ../../obj/asdf-upstream && make

diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
index e17fc63..cc5af7d 100644 (file)
--- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
+++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd
@@ -1,72 +1,53 @@
 ;;; -*-  Lisp -*-
 ;;; -*-  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
 
 (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)
   :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")))))

diff --git a/contrib/sb-concurrency/sb-concurrency.asd b/contrib/sb-concurrency/sb-concurrency.asd
index 913f078..edcbffc 100644 (file)
--- a/contrib/sb-concurrency/sb-concurrency.asd
+++ b/contrib/sb-concurrency/sb-concurrency.asd
@@ -43,6 +43,7 @@
                          (c (eql (asdf:find-system :sb-concurrency-tests))))
   (multiple-value-bind (soft strict pending)
       (funcall (intern "DO-TESTS" (find-package "SB-RT")))
                          (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
     (fresh-line)
     (unless strict
       #+sb-testing-contrib

diff --git a/contrib/sb-cover/cover.lisp b/contrib/sb-cover/cover.lisp
index 28ead42..957954b 100644 (file)
--- a/contrib/sb-cover/cover.lisp
+++ b/contrib/sb-cover/cover.lisp
@@ -89,7 +89,7 @@ result to RESTORE-COVERAGE."
             (make-pathname :directory (append (or (pathname-directory pathname)
                                                   (list :relative))
                                               (list (file-namestring pathname)))
             (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)
                            :defaults pathname)))))
 
 (defun report (directory &key ((:form-mode *source-path-mode*) :whole)

@@ -104,17 +104,20 @@ the coverage report will be placed on the CARs of any cons-forms, while if
 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."
 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))
     (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
                                 (coerce (sb-md5:md5sum-string

-                                         (sb-ext:native-namestring k))
+                                         (sb-ext:native-namestring pk))

                                         'list)))
                                         'list)))

-                      (path (make-pathname :name n :type "html")))
+                      (path (make-pathname :name n :type "html" :defaults directory)))

                  (when (probe-file k)
                  (when (probe-file k)

+                   (ensure-directories-exist pk)

                    (with-open-file (stream path
                                            :direction :output
                                            :if-exists :supersede
                    (with-open-file (stream path
                                            :direction :output
                                            :if-exists :supersede

@@ -122,7 +125,7 @@ latter mode is generally easier to read."
                      (push (list* k n (report-file k stream external-format))
                            paths)))))
              *code-coverage-info*)
                      (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)
       (with-open-file (stream report-file
                               :direction :output :if-exists :supersede
                               :if-does-not-exist :create)

diff --git a/contrib/sb-cover/sb-cover.asd b/contrib/sb-cover/sb-cover.asd
index e98dee2..a920712 100644 (file)
--- a/contrib/sb-cover/sb-cover.asd
+++ b/contrib/sb-cover/sb-cover.asd
@@ -1,17 +1,16 @@
 ;;; -*-  Lisp -*-
 
 (defsystem sb-cover
 ;;; -*-  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))

diff --git a/contrib/sb-cover/tests.lisp b/contrib/sb-cover/tests.lisp
index ea54b75..1f2a323 100644 (file)
--- a/contrib/sb-cover/tests.lisp
+++ b/contrib/sb-cover/tests.lisp
@@ -1,15 +1,19 @@
-(defpackage sb-cover-test
-  (:use "CL"))
+(defpackage sb-cover-test (:use :cl :asdf :uiop))

 
 (in-package sb-cover-test)
 
 
 (in-package sb-cover-test)
 

-(defparameter *path* #.(truename *compile-file-pathname*))
+(defparameter *source-directory*
+  (system-source-directory :sb-cover))

 (defparameter *output-directory*
 (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
 
 (defun report ()
   (handler-case

@@ -24,14 +28,15 @@
         (error "Should've raised a warning"))
     (warning ())))
 
         (error "Should've raised a warning"))
     (warning ())))
 

+

 ;;; No instrumentation
 ;;; 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))
 (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
 
 (catch 'ok
   (handler-case

@@ -42,8 +47,7 @@
 
 (report)
 
 
 (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))))
 
 ;;; None of the code was executed
 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))

@@ -78,7 +82,7 @@
 (report-expect-failure)
 
 ;;; Another file, with some branches
 (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)
 
 (test2 1)
 (report)

@@ -101,11 +105,9 @@
            (sb-cover::all-of (getf sb-cover::*counts* :branch))))
 
 ;; Check for presence of constant coalescing bugs
            (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
 (test-2)
 
 ;; Clean up after the tests

-

 (map nil #'delete-file
      (directory (merge-pathnames #p"*.html" *output-directory*)))
 (map nil #'delete-file
      (directory (merge-pathnames #p"*.html" *output-directory*)))

diff --git a/contrib/sb-grovel/def-to-lisp.lisp b/contrib/sb-grovel/def-to-lisp.lisp
index 97f2435..d87d7c2 100644 (file)
--- a/contrib/sb-grovel/def-to-lisp.lisp
+++ b/contrib/sb-grovel/def-to-lisp.lisp
@@ -120,7 +120,7 @@ code:
            (when (eql type :errno)
              (printf "(cl:setf (get '~A 'errno) t)" lispname))
            (as-c "#else")
            (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))
            (as-c "#endif"))
           (:enum
            (c-for-enum lispname cname export))

@@ -153,28 +153,31 @@ code:
              (definitions (read i)))
         (print-c-source  f headers definitions package)))))
 
              (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)))
   ((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)
   ;; 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))
          (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)
          (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)
                      :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))
       (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)
                                        :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)
     (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)))))

diff --git a/contrib/sb-grovel/defpackage.lisp b/contrib/sb-grovel/defpackage.lisp
index 5f161b1..291bd0b 100644 (file)
--- 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")
   ;; 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 (file)
--- a/contrib/sb-grovel/sb-grovel.asd
+++ b/contrib/sb-grovel/sb-grovel.asd
@@ -1,19 +1,13 @@
 ;;; -*-  Lisp -*-
 
 ;;; -*-  Lisp -*-
 

-(defpackage #:sb-grovel-system (:use #:asdf #:cl))
-(in-package #:sb-grovel-system)
-

 (defsystem sb-grovel
 (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 (file)
--- 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.
 
 ;;;; 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
 
 (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
 
 (defclass plist-file (cl-source-file)
   ((source-plist

@@ -42,41 +37,42 @@
   ())
 
 (defmethod perform ((op compile-op) (com source-only-file)))
   ())
 
 (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))
 (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)
   :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"))
   :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")
                (: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 (file)
--- 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))
 
 (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)))
               (or (equal (getf plist :test-outer)
                          "OUT")
                   plist)))

-  t t)
+  t t t)

 
 (deftest definition-source-plist.2
     (let ((plist (definition-source-plist
 
 (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)
 
     (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)
 
     (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))
           (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))))
                      (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))
           (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))))
                      (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 (file)
--- a/contrib/sb-posix/sb-posix.asd
+++ b/contrib/sb-posix/sb-posix.asd
@@ -1,49 +1,39 @@
 ;;; -*-  Lisp -*-
 ;;; -*-  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
 (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!"))))))

diff --git a/contrib/sb-rotate-byte/sb-rotate-byte.asd b/contrib/sb-rotate-byte/sb-rotate-byte.asd
index 036f1ba..dc5be27 100644 (file)
--- a/contrib/sb-rotate-byte/sb-rotate-byte.asd
+++ b/contrib/sb-rotate-byte/sb-rotate-byte.asd
@@ -1,9 +1,5 @@
 ;;; -*-  Lisp -*-
 
 ;;; -*-  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
 (defsystem sb-rotate-byte
   :version "0.1"
   #+sb-building-contrib :pathname

@@ -12,22 +8,20 @@
   ((:file "package")
    (:file "compiler" :depends-on ("package"))
    (:module "vm"
   ((: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 (file)
--- a/contrib/sb-simple-streams/sb-simple-streams.asd
+++ b/contrib/sb-simple-streams/sb-simple-streams.asd
@@ -1,9 +1,5 @@
 ;;; -*- lisp -*-
 
 ;;; -*- 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
 (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"))
                (: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)
   :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")))
   :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 (file)
--- 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)"))' </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:
 
 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 (file)
--- 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
 
 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
 
 
 . ./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
     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
 done
 
 echo

diff --git a/make-target-contrib.sh b/make-target-contrib.sh
index b609072..57ed2eb 100644 (file)
--- 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-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
 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
 # 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.
 
 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
 if [ -z "$*" ]; then

-    contribs_to_build=contrib/*
+    contribs_to_build="`cd contrib ; echo *`"

 else
 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
 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.
     # 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 $?
        :
     else
        exit $?

@@ -84,8 +82,8 @@ done
 
 # Otherwise report expected failures:
 HEADER_HAS_BEEN_PRINTED=false
 
 # 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
   if test -f "$f" && grep -i fail "$f" >/dev/null; then
       if ! $HEADER_HAS_BEEN_PRINTED; then
           cat <<EOF

@@ -95,7 +93,7 @@ platform and features have been ignored:
 EOF
           HEADER_HAS_BEEN_PRINTED=true
       fi
 EOF
           HEADER_HAS_BEEN_PRINTED=true
       fi

-      echo "  $dir"
+      echo "  contrib/$dir"

       (unset IFS; while read line; do echo "    $line"; done <"$f")
   fi
 done
       (unset IFS; while read line; do echo "    $line"; done <"$f")
   fi
 done

@@ -103,9 +101,9 @@ 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
 # 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
 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
       if $HEADER_HAS_BEEN_PRINTED; then
           echo > /dev/null
       else

@@ -116,7 +114,7 @@ their self-tests. Failed contribs:"
 EOF
           HEADER_HAS_BEEN_PRINTED=true
       fi
 EOF
           HEADER_HAS_BEEN_PRINTED=true
       fi

-      echo "  `basename $dir`"
+      echo "  $dir"

   fi
 done
 
   fi
 done
 

diff --git a/make.sh b/make.sh
index f10db34..a82b3c2 100755 (executable)
--- a/make.sh
+++ b/make.sh
@@ -71,7 +71,7 @@ time sh make-target-2.sh
 time sh make-target-contrib.sh
 
 NCONTRIBS=`find contrib -name Makefile -print | wc -l`
 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"
 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"

diff --git a/run-sbcl.sh b/run-sbcl.sh
index a3507d1..44aaf68 100755 (executable)
--- 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
 
 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
 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 (file)
--- 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
   (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)))))
                           :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?
     ;; 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))))