X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsb-bsd-sockets.asd;h=7bbf5d90839cd449c07a4b1977fecf79a15b51f2;hb=b9691ef5009d3669c4f87f4dfbd2baf4538e60f8;hp=6cc6b22f4a9c6be74002580474c434119def3c99;hpb=65a01dae3d437a48e8dd0d051a446245f9e29929;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd index 6cc6b22..7bbf5d9 100644 --- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd +++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd @@ -1,132 +1,71 @@ ;;; -*- Lisp -*- - -(defpackage #:sb-bsd-sockets-system (:use #:asdf #:cl)) +(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) -;;; constants.lisp requires special treatment - -(defclass constants-file (cl-source-file) ()) - -(defmethod perform ((op compile-op) (component 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))) - (filename (component-pathname component)) - (real-output-file - (if (typep output-file 'logical-pathname) - (translate-logical-pathname output-file) - (pathname output-file))) - (tmp-c-source (merge-pathnames #p"foo.c" real-output-file)) - (tmp-a-dot-out (merge-pathnames #p"a.out" real-output-file)) - (tmp-constants (merge-pathnames #p"constants.lisp-temp" - real-output-file))) - (princ (list filename output-file real-output-file - tmp-c-source tmp-a-dot-out tmp-constants)) - (terpri) - (funcall (intern "C-CONSTANTS-EXTRACT" - (find-package "SB-BSD-SOCKETS-SYSTEM")) - filename tmp-c-source :sb-bsd-sockets-internal) - (and - (= (run-shell-command "gcc -o ~S ~S" (namestring tmp-a-dot-out) - (namestring tmp-c-source)) 0) - (= (run-shell-command "~A >~A" - (namestring tmp-a-dot-out) - (namestring tmp-constants)) 0) - (compile-file tmp-constants :output-file output-file)))) - - -;;; we also have a shared library with some .o files in it - -(defclass unix-dso (module) ()) -(defun unix-name (pathname) - (namestring - (typecase pathname - (logical-pathname (translate-logical-pathname pathname)) - (t pathname)))) - -(defmethod asdf::input-files ((operation compile-op) (dso unix-dso)) - (mapcar #'component-pathname (module-components dso))) - -(defmethod output-files ((operation compile-op) (dso unix-dso)) - (let ((dir (component-pathname dso))) - (list - (make-pathname :type "so" - :name (car (last (pathname-directory dir))) - :directory (butlast (pathname-directory dir)) - :defaults dir)))) - - -(defmethod perform :after ((operation compile-op) (dso unix-dso)) - (let ((dso-name (unix-name (car (output-files operation dso))))) - (unless (zerop - (run-shell-command - #+sunos "gcc -shared -lresolv -lsocket -lnsl -o ~S ~{~S ~}" - #-sunos "gcc -shared -o ~S ~{~S ~} " - dso-name - (mapcar #'unix-name - (mapcan (lambda (c) - (output-files operation c)) - (module-components dso))))) - (error 'operation-error :operation operation :component dso)))) - -;;; if this goes into the standard asdf, it could reasonably be extended -;;; to allow cflags to be set somehow -(defmethod output-files ((op compile-op) (c c-source-file)) - (list - (make-pathname :type "o" :defaults - (component-pathname c)))) -(defmethod perform ((op compile-op) (c c-source-file)) - (unless - (= 0 (run-shell-command "gcc -fPIC -o ~S -c ~S" - (unix-name (car (output-files op c))) - (unix-name (component-pathname c)))) - (error 'operation-error :operation op :component c))) - -(defmethod perform ((operation load-op) (c c-source-file)) - t) - -(defmethod perform ((o load-op) (c unix-dso)) - (let ((co (make-instance 'compile-op))) - (let ((filename (car (output-files co c)))) - #+cmu (ext:load-foreign filename) - #+sbcl (sb-alien:load-1-foreign filename)))) - (defsystem sb-bsd-sockets :version "0.58" - :depends-on (sb-rt) + :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 "array-data" :depends-on ("defpackage")) - (:unix-dso "alien" - :components ((:c-source-file "undefs") - (:c-source-file "get-h-errno"))) - (:file "malloc" :depends-on ("defpackage")) - (:file "foreign-glue" :depends-on ("defpackage" "malloc")) - (:constants-file "constants" - :pathname "constants.lisp" - :depends-on - ("def-to-lisp" "defpackage" "foreign-glue")) - (:file "sockets" - :depends-on ("constants" "array-data")) - - (:file "sockopt" :depends-on ("sockets")) - (:file "inet" :depends-on ("sockets" "split" "constants" )) - (:file "local" :depends-on ("sockets" "split" "constants" )) - (:file "name-service" :depends-on ("sockets" "constants" "alien")) - (:file "misc" :depends-on ("sockets" "constants")) - - (:file "def-to-lisp") - (:file "tests" :depends-on ("inet" "sockopt")) - - (:static-file "NEWS") - ;; (:static-file "INSTALL") - (:static-file "README") - (:static-file "index" :pathname "index.html") - (:static-file "doc" :pathname "doc.lisp") - (:static-file "TODO"))) + (: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")) + + (: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)))) - (or (funcall (intern "DO-TESTS" (find-package "SB-RT"))) - (error "test-op failed"))) - + (operate 'load-op 'sb-bsd-sockets-tests) + (operate 'test-op '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"))) + (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"))))