contrib/sb-posix/sb-posix.asd

   1 ;;; -*-  Lisp -*-
   2 (require :sb-grovel)
   3 (defpackage #:sb-posix-system (:use #:asdf #:cl #:sb-grovel))
   4 (in-package #:sb-posix-system)
   5
   6
   7 ;;; we also have a shared library with some .o files in it
   8 ;;;
   9 ;;; FIXME: we share this with SB-BSD-SOCKETS.  This should either (a)
  10 ;;; be part of ASDF itself, or (b) be in a shared file that we can
  11 ;;; LOAD at this point.
  12 (defclass unix-dso (module) ())
  13 (defun unix-name (pathname)
  14   (namestring
  15    (typecase pathname
  16      (logical-pathname (translate-logical-pathname pathname))
  17      (t pathname))))
  18
  19 (defmethod asdf::input-files ((operation compile-op) (dso unix-dso))
  20   (mapcar #'component-pathname (module-components dso)))
  21
  22 (defmethod output-files ((operation compile-op) (dso unix-dso))
  23   (let ((dir (component-pathname dso)))
  24     (list
  25      (make-pathname :type "so"
  26                     :name (car (last (pathname-directory dir)))
  27                     :directory (butlast (pathname-directory dir))
  28                     :defaults dir))))
  29
  30
  31 (defmethod perform :after ((operation compile-op) (dso unix-dso))
  32   (let ((dso-name (unix-name (car (output-files operation dso)))))
  33     (unless (zerop
  34              (run-shell-command
  35               "gcc ~A -o ~S ~{~S ~}"
  36               (concatenate 'string
  37                            (sb-ext:posix-getenv "EXTRA_LDFLAGS")
  38                            " "
  39                            #+sunos "-shared -lresolv -lsocket -lnsl"
  40                            #+darwin "-bundle"
  41                            #-(or darwin sunos) "-shared")
  42               dso-name
  43               (mapcar #'unix-name
  44                       (mapcan (lambda (c)
  45                                 (output-files operation c))
  46                               (module-components dso)))))
  47       (error 'operation-error :operation operation :component dso))))
  48
  49 ;;; if this goes into the standard asdf, it could reasonably be extended
  50 ;;; to allow cflags to be set somehow
  51 (defmethod output-files ((op compile-op) (c c-source-file))
  52   (list
  53    (make-pathname :type "o" :defaults
  54                   (component-pathname c))))
  55 (defmethod perform ((op compile-op) (c c-source-file))
  56   (unless
  57       (= 0 (run-shell-command "gcc ~A -o ~S -c ~S"
  58                               (concatenate
  59                                'string
  60                                (sb-ext:posix-getenv "EXTRA_CFLAGS")
  61                                " "
  62                                "-fPIC")
  63                               (unix-name (car (output-files op c)))
  64                               (unix-name (component-pathname c))))
  65     (error 'operation-error :operation op :component c)))
  66
  67 (defmethod perform ((operation load-op) (c c-source-file))
  68   t)
  69
  70 (defmethod perform ((o load-op) (c unix-dso))
  71   (let ((co (make-instance 'compile-op)))
  72     (let ((filename (car (output-files co c))))
  73       #+cmu (ext:load-foreign filename)
  74       #+sbcl (sb-alien:load-shared-object filename))))
  75
  76 (defsystem sb-posix
  77     :depends-on (sb-grovel)
  78     #+sb-building-contrib :pathname
  79     #+sb-building-contrib "SYS:CONTRIB;SB-POSIX;"
  80     :components ((:file "defpackage")
  81                  (:file "designator" :depends-on ("defpackage"))
  82                  (:unix-dso "alien"
  83                             :components ((:c-source-file "stat-macros")
  84                                          (:c-source-file "waitpid-macros")))
  85                  (:file "macros" :depends-on ("designator"))
  86                  (sb-grovel:grovel-constants-file
  87                   "constants"
  88                   :package :sb-posix :depends-on  ("defpackage"))
  89                  (:file "interface" :depends-on ("constants" "macros" "designator" "alien"))))
  90
  91 (defsystem sb-posix-tests
  92     :depends-on (sb-rt)
  93     :components ((:file "posix-tests")))
  94
  95 (defmethod perform :after ((o load-op) (c (eql (find-system :sb-posix))))
  96   (provide 'sb-posix))
  97
  98 (defmethod perform ((o test-op) (c (eql (find-system :sb-posix))))
  99   (operate 'load-op 'sb-posix-tests)
 100   (operate 'test-op 'sb-posix-tests))
 101
 102 (defmethod perform ((o test-op) (c (eql (find-system :sb-posix-tests))))
 103   (funcall (intern "DO-TESTS" (find-package "SB-RT")))
 104   (let ((failures (funcall (intern "PENDING-TESTS" "SB-RT")))
 105         (ignored-failures (loop for sym being the symbols of :sb-posix-tests
 106                                 if (search ".ERROR" (symbol-name sym))
 107                                 collect sym)))
 108     (cond
 109       ((null failures)
 110        t)
 111       ((null (set-difference failures ignored-failures))
 112        (warn "~@<some POSIX implementations return incorrect error values for ~
 113               failing calls, but there is legitimate variation between ~
 114               implementations too.  If you think the errno ~
 115               from your platform is valid, please contact the sbcl ~
 116               developers; otherwise, please submit a bug report to your ~
 117               kernel distributor~@:>")
 118        t)
 119       (t
 120        (error "non-errno tests failed!")))))