This commit is contained in:
Ian Keane 2020-02-18 14:21:14 -05:00
parent 276853ba84
commit 1cb167b597
361 changed files with 77302 additions and 4 deletions

View file

@ -0,0 +1,30 @@
language: lisp
env:
matrix:
# - LISP=abcl
# - LISP=allegro
- LISP=sbcl
- LISP=sbcl32
- LISP=ccl
- LISP=ccl32
- LISP=clisp
- LISP=clisp32
# - LISP=cmucl
- LISP=ecl
matrix:
allow_failures:
- env: LISP=ecl
install:
- curl -L https://github.com/luismbo/cl-travis/raw/master/install.sh | sh
- if [ "${LISP:(-2)}" = "32" ]; then
sudo apt-get install libc6-dev-i386;
fi
script:
- cl -e '(ql:quickload :cffi-grovel)
(ql:quickload :trivial-features-tests)
(unless (trivial-features-tests:run)
(uiop:quit 1))'

View file

@ -0,0 +1,21 @@
Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the "Software"), to deal in the Software without
restriction, including without limitation the rights to use, copy,
modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.

View file

@ -0,0 +1,32 @@
[![Build Status](https://travis-ci.org/trivial-features/trivial-features.svg?branch=master)](https://travis-ci.org/trivial-features/trivial-features)
trivial-features ensures consistent `*FEATURES*` across multiple
Common Lisp implementations.
For example, on MacOS X platforms, while most Lisps push `:DARWIN` to
`*FEATURES*`, CLISP and Allegro push `:MACOS` and `:MACOSX` instead,
respectively. Some Lisps might not push any feature suggesting MacOS
X at all. trivial-features will make sure all Lisps will have
`:DARWIN` in the `*FEATURES*` list when running on MacOS X. This
way, you can write
#+darwin foo #-darwin bar
instead of
#+(or darwin macos macosx) foo
#-(or darwin macos macosx) bar
The included [SPEC.md][1] document describes the set of symbols that
should or should not be present in `CL:*FEATURES*` on certain
circumstances. This specification is implemented by the
TRIVIAL-FEATURES system which supports a handful of Lisps.
The test suite is, in effect, an implementation using [CFFI][2] that
is checked against the various implementations in `src/tf-*.lisp`.
trivial-features is MIT-licenced.
[1]: https://github.com/trivial-features/trivial-features/blob/master/SPEC.md
[2]: http://common-lisp.net/project/cffi

View file

@ -0,0 +1,86 @@
TRIVIAL-FEATURES
================
This is a first *draft* of a description of what symbols should be
present in `CL:*FEATURES*` for various platforms. A possible future
direction of this documentation might be a CDR document, if it turns
out to be a good idea. (Making the language of this document much
more precise will be necessary then.)
We will start by limiting ourselves to OS, CPU and endianness features
on Windows and POSIX platforms.
There are various possible implementation strategies ranging from null
implementations (when the host Lisp already pushes the wanted feature)
to using FFI (e.g. calling uname() to grab system information.
Specification
-------------
### ENDIANNESS
Either `:LITTLE-ENDIAN` or `:BIG-ENDIAN` should present in
`\*FEATURES\*`. For the time being, we will not concern ourselves
with other orderings, switchable endianness, etc.
### OPERATING SYSTEM
On Windows, `:WINDOWS` should be present in `*FEATURES*`.
On POSIX systems, the "sysname" information from uname(3) should be
used to push the appropriate symbol to `*FEATURES*` by upcasing that
string (or downcasing for the "modern" lisps) and interning it in the
keyword package.
Examples:
- `:DARWIN`
- `:LINUX`
- `:NETBSD`
- `:OPENBSD`
- `:FREEBSD`
For convenience, `:UNIX` should be pushed when running on
POSIX/UNIX-like operating system (that doesn't include Windows) and
`:BSD` should be present when running on BSD-based systems (that
includes Darwin)
[add `:MACH` too?]
### CPU
These features should be mutually exclusive:
- `:X86`
- `:X86-64`
- `:PPC`
- `:PPC64`
- `:MIPS`
- `:ALPHA`
- `:SPARC`
- `:SPARC64`
- `:HPPA`
- `:HPPA64`
[add more ...]
[note: it's debatable whether `:X86` shouldn't also be exported on
x86-64, and `:PPC` on ppc64. SBCL doesn't. Other ways
to handle, for example, the x86/x86-64 case would be to export
something like `:PC386` in both cases or have an additional `:X86-32`. Or
finally, have just `:X86`, `:PPC`, etc, and add `:32-BIT-CPU` and
`:64-BIT-CPU` features.]
Unreferenced References
-----------------------
* [CLHS: Variable \*FEATURES\*][1]
* [Maintaining Portable Lisp Programs][2], by Christophe Rhodes
[1]: http://www.lispworks.com/documentation/HyperSpec/Body/v_featur.htm
[2]: http://www-jcsu.jesus.cam.ac.uk/~csr21/papers/features.pdf

View file

@ -0,0 +1,247 @@
#!/usr/bin/env clisp
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
(defpackage :release-script (:use #:cl #:regexp))
(in-package :release-script)
;;;; Configuration ------------------------------------------------------------
(defparameter *project-name* "trivial-features")
(defparameter *asdf-file* (format nil "~A.asd" *project-name*))
(defparameter *host* "common-lisp.net")
(defparameter *release-dir*
(format nil "public_html/tarballs/~A/" *project-name*))
(defparameter *version-file* nil)
(defparameter *version-file-dir* nil)
;;;; --------------------------------------------------------------------------
;;;; Utilities
(defun ensure-list (x)
(if (listp x) x (list x)))
(defmacro string-case (expression &body clauses)
`(let ((it ,expression)) ; yes, anaphoric, deal with it.
(cond
,@(loop for clause in clauses collect
`((or ,@(loop for alternative in (ensure-list (first clause))
collect (or (eq t alternative)
`(string= it ,alternative))))
,@(rest clause))))))
(defparameter *development-mode* t)
(defun die (format-control &rest format-args)
(format *error-output* "~?" format-control format-args)
(if *development-mode*
(cerror "continue" "die")
(ext:quit 1)))
(defun numeric-split (string)
(if (digit-char-p (char string 0))
(multiple-value-bind (number next-position)
(parse-integer string :junk-allowed t)
(cons number (when (< next-position (length string))
(numeric-split (subseq string next-position)))))
(let ((next-digit-position (position-if #'digit-char-p string)))
(if next-digit-position
(cons (subseq string 0 next-digit-position)
(numeric-split (subseq string next-digit-position)))
(list string)))))
(defun natural-string-< (s1 s2)
(labels ((aux< (l1 l2)
(cond ((null l1) (not (null l2)))
((null l2) nil)
(t (destructuring-bind (x . xs) l1
(destructuring-bind (y . ys) l2
(cond ((and (numberp x) (stringp y))
t)
((and (numberp y) (stringp x))
nil)
((and (numberp x) (numberp y))
(or (< x y) (and (= x y) (aux< xs ys))))
(t
(or (string-lessp x y)
(and (string-equal x y)
(aux< xs ys)))))))))))
(aux< (numeric-split s1)
(numeric-split s2))))
;;;; Running commands
(defparameter *dry-run* nil)
(defun cmd? (format-control &rest format-args)
(let ((cmd (format nil "~?" format-control format-args)))
(with-open-stream (s1 (ext:run-shell-command cmd :output :stream))
(loop for line = (read-line s1 nil nil)
while line
collect line))))
;; XXX: quote arguments.
(defun cmd (format-control &rest format-args)
(when *development-mode*
(format *debug-io* "CMD: ~?~%" format-control format-args))
(let ((ret (ext:run-shell-command (format nil "~?" format-control format-args))))
(or (null ret)
(zerop ret))))
(defun cmd! (format-control &rest format-args)
(or (apply #'cmd format-control format-args)
(die "cmd '~?' failed." format-control format-args)))
(defun maybe-cmd! (format-control &rest format-args)
(if *dry-run*
(format t "SUPPRESSING: ~?~%" format-control format-args)
(apply #'cmd! format-control format-args)))
;;;;
(defun find-current-version ()
(subseq (reduce (lambda (x y) (if (natural-string-< x y) y x))
(cmd? "git tag -l v\\*"))
1))
(defun parse-version (string)
(mapcar (lambda (x)
(parse-integer x :junk-allowed t))
(loop repeat 3 ; XXX: parameterize
for el in (regexp-split "\\." (find-current-version))
collect el)))
(defun check-for-unrecorded-changes (&optional force)
(unless (cmd "git diff --exit-code")
(write-line "Unrecorded changes.")
(if force
(write-line "Continuing anyway.")
(die "Aborting.~@
Use -f or --force if you want to make a release anyway."))))
(defun new-version-number-candidates (current-version)
(let ((current-version (parse-version current-version)))
(labels ((alternatives (before after)
(when after
(cons (append before (list (1+ (first after)))
(mapcar (constantly 0) (rest after)))
(alternatives (append before (list (first after)))
(rest after))))))
(loop for alt in (alternatives nil current-version)
collect (reduce (lambda (acc next)
(format nil "~a.~a" acc next))
alt)))))
(defun ask-user-for-version (current-version next-versions)
(format *query-io* "Current version is ~A. Which will be the next one?~%"
current-version)
(loop for i from 1 and version in next-versions
do (format *query-io* "~T~A) ~A~%" i version))
(format *query-io* "? ")
(finish-output *query-io*)
(nth (1- (parse-integer (read-line) :junk-allowed t))
next-versions))
(defun git-tag-tree (version)
(write-line "Tagging the tree...")
(maybe-cmd! "git tag \"v~A\"" version))
(defun add-version-to-system-file (version path-in path-out)
(with-open-file (in path-in :direction :input)
(with-open-file (out path-out :direction :output)
(loop for line = (read-line in nil nil) while line
do (write-line line out)
when (string= #1="(defsystem " line
:end2 (min (length #1#) (length line)))
do (format out " :version ~s~%" version)))))
(defun create-dist (version distname)
(write-line "Creating distribution...")
(cmd! "mkdir \"~a\"" distname)
(cmd! "git archive master | tar xC \"~A\"" distname)
(format t "Updating ~A with new version: ~A~%" *asdf-file* version)
(let* ((asdf-file-path (format nil "~A/~A" distname *asdf-file*))
(tmp-asdf-file-path (format nil "~a.tmp" asdf-file-path)))
(add-version-to-system-file version asdf-file-path tmp-asdf-file-path)
(cmd! "mv \"~a\" \"~a\"" tmp-asdf-file-path asdf-file-path)))
(defun tar-and-sign (distname tarball)
(write-line "Creating and signing tarball...")
(cmd! "tar czf \"~a\" \"~a\"" tarball distname)
(cmd! "gpg -b -a \"~a\"" tarball))
(defparameter *remote-directory* (format nil "~A:~A" *host* *release-dir*))
(defun upload-tarball (tarball signature remote-directory)
(write-line "Copying tarball to web server...")
(maybe-cmd! "scp \"~A\" \"~A\" \"~A\"" tarball signature remote-directory)
(format t "Uploaded ~A and ~A.~%" tarball signature))
(defun update-remote-links (tarball signature host release-dir project-name)
(format t "Updating ~A_latest links...~%" project-name)
(maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz\""
host tarball release-dir project-name)
(maybe-cmd! "ssh \"~A\" ln -sf \"~A\" \"~A/~A_latest.tar.gz.asc\""
host signature release-dir project-name))
(defun upload-version-file (version version-file host version-file-dir)
(format t "Uploading ~A...~%" version-file)
(maybe-cmd! "echo -n \"~A\" > \"~A\"" version version-file)
(maybe-cmd! "scp \"~A\" \"~A\":\"~A\"" version-file host version-file-dir)
(maybe-cmd! "rm \"~A\"" version-file))
(defun maybe-clean-things-up (tarball signature)
(when (y-or-n-p "Clean local tarball and signature?")
(cmd! "rm \"~A\" \"~A\"" tarball signature)))
(defun run (force version)
(check-for-unrecorded-changes force)
;; figure out what version we'll be preparing.
(unless version
(let* ((current-version (find-current-version))
(next-versions (new-version-number-candidates current-version)))
(setf version (or (ask-user-for-version current-version next-versions)
(die "invalid selection.")))))
(git-tag-tree version)
(let* ((distname (format nil "~A_~A" *project-name* version))
(tarball (format nil "~A.tar.gz" distname))
(signature (format nil "~A.asc" tarball)))
;; package things up.
(create-dist version distname)
(tar-and-sign distname tarball)
;; upload.
(upload-tarball tarball signature *remote-directory*)
(update-remote-links tarball signature *host* *release-dir* *project-name*)
(when *version-file*
(upload-version-file version *version-file* *host* *version-file-dir*))
;; clean up.
(maybe-clean-things-up tarball signature)
;; documentation.
;; (write-line "Building and uploading documentation...")
;; (maybe-cmd! "make -C doc upload-docs")
;; push tags and any outstanding changes.
(write-line "Pushing tags and changes...")
(maybe-cmd! "git push --tags origin master")))
;;;; Do it to it
(let ((force nil)
(version nil)
(args ext:*args*))
(loop while args
do (string-case (pop args)
(("-h" "--help")
(write-line "No help, sorry. Read the source.")
(ext:quit 0))
(("-f" "--force")
(setf force t))
(("-v" "--version")
(setf version (pop args)))
(("-n" "--dry-run")
(setf *dry-run* t))
(t
(die "Unrecognized argument '~a'" it))))
(run force version))

View file

@ -0,0 +1,46 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-abcl.lisp --- ABCL trivial-features implementation.
;;;
;;; Copyright (C) 2009, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew (let ((order (jcall "toString"
(jstatic "nativeOrder" "java.nio.ByteOrder"))))
(cond ((string-equal order "LITTLE_ENDIAN")
:little-endian)
((string-equal order "BIG_ENDIAN")
:big-endian)
(t (error "Byte order ~A unknown" order))))
*features*)
;;;; OS
;;; ABCL already pushes :LINUX and :UNIX.
;;;; CPU
;;; ABCL already pushes :x86-64

View file

@ -0,0 +1,49 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-allegro.lisp --- Allegro implementation of trivial-features.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
;;; Allegro already pushes :LITTLE-ENDIAN and :BIG-ENDIAN.
;;;; OS
;;; Allegro already pushes :LINUX and :UNIX.
#+mswindows (pushnew :windows *features*)
#+macosx (pushnew :darwin *features*)
;;; Pushing :BSD. (Make sure this list is complete.)
#+(or macosx darwin freebsd netbsd openbsd)
(pushnew :bsd *features*)
;;;; CPU
;;; Allegro already pushes :X86 and :X86-64.
;;; what about PPC64?
#+powerpc (pushnew :ppc *features*)

View file

@ -0,0 +1,36 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-clasp.lisp --- CLASP implementation of trivial-features.
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
;;; - Set by CLASP directly. Sets :LITTLE-ENDIAN or :BIG-ENDIAN
;;;; OS
;;; - Set by CLASP directly. Already pushes :DARWIN, :LINUX, :UNIX, :BSD
;;;; CPU
;;; - Set by CLASP directly. Already pushes :X86-64 (currently the only
;;; supported platform) - More will be added directly in CLASP as soon as
;;; porting is done.

View file

@ -0,0 +1,72 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-clisp.lisp --- CLISP trivial-features implementation.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew (intern (symbol-name (if sys::*big-endian*
'#:big-endian
'#:little-endian))
'#:keyword)
*features*)
;;;; OS
;;; CLISP already exports :UNIX.
#+win32 (pushnew :windows *features*)
#-win32
(eval-when (:compile-toplevel :load-toplevel :execute)
(pushnew (with-standard-io-syntax
(read-from-string
(format nil ":~(~A~)" (posix:uname-sysname (posix:uname)))))
*features*))
#+(or darwin freebsd netbsd openbsd)
(pushnew :bsd *features*)
;;;; CPU
;;; FIXME: not complete
(let ((cpu (cond
((or (member :pc386 *features*)
(member (machine-type) '("x86" "x86_64")
:test #'string-equal))
(if (member :word-size=64 *features*)
'#:x86-64
'#:x86))
((string= (machine-type) "POWER MACINTOSH")
'#:ppc)
((or (member (machine-type) '("SPARC" "SPARC64")
:test #'string-equal))
(if (member :word-size=64 *features*)
'#:sparc64
'#:sparc)))))
(when cpu
(pushnew (intern (symbol-name cpu) '#:keyword)
*features*)))

View file

@ -0,0 +1,44 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-cmucl.lisp --- CMUCL implementation of trivial-features.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew (alien:with-alien ((ptr (array (alien:unsigned 8) 2)))
(setf (sys:sap-ref-16 (alien:alien-sap ptr) 0) #xfeff)
(ecase (sys:sap-ref-8 (alien:alien-sap ptr) 0)
(#xfe (intern "BIG-ENDIAN" :keyword))
(#xff (intern "LITTLE-ENDIAN" :keyword))))
*features*)
;;;; OS
;;; CMUCL already pushes :UNIX, :BSD, :LINUX and :DARWIN.
;;;; CPU
;;; CMUCL already pushes :PPC and :X86.

View file

@ -0,0 +1,39 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-corman.lisp --- Corman Lisp implementation of trivial-features.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew :little-endian *features*)
;;;; OS
(pushnew :windows *features*)
;;;; CPU
(pushnew :x86 *features*)

View file

@ -0,0 +1,55 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-ecl.lisp --- ECL implementation of trivial-features.
;;;
;;; Copyright (C) 2007-2009, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew (let ((ptr (ffi:allocate-foreign-object :unsigned-short)))
(unwind-protect
(progn
(setf (ffi:deref-pointer ptr :unsigned-short) #xfeff)
(ecase (ffi:deref-pointer ptr :unsigned-byte)
(#xfe (intern "BIG-ENDIAN" "KEYWORD"))
(#xff (intern "LITTLE-ENDIAN" "KEYWORD"))))
(ffi:free-foreign-object ptr)))
*features*)
;;;; OS
;;; ECL already pushes :DARWIN, :LINUX, :UNIX (except on Darwin) and :BSD.
#+darwin (pushnew :unix *features*)
#+win32 (pushnew :windows *features*)
;;;; CPU
;;; FIXME: add more
#+powerpc7450 (pushnew :ppc *features*)
#+x86_64 (pushnew :x86-64 *features*)
#+(or i386 i486 i586 i686) (pushnew :x86 *features*)
#+(or armv5l armv6l armv7l) (pushnew :arm *features*)
#+mipsel (pushnew :mips *features*)

View file

@ -0,0 +1,58 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-lispworks.lisp --- Lispworks implementation of trivial-features.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
;;; Lispworks pushes :LITTLE-ENDIAN.
#-little-endian (pushnew :big-endian *features*)
#-(and)
(pushnew (fli:with-dynamic-foreign-objects ()
(let ((ptr (fli:alloca :type :byte :nelems 2)))
(setf (fli:dereference ptr :type '(:unsigned :short)) #xfeff)
(ecase (fli:dereference ptr :type '(:unsigned :byte))
(#xfe (intern "BIG-ENDIAN" :keyword))
(#xff (intern "LITTLE-ENDIAN" :keyword)))))
*features*)
;;;; OS
;;; Lispworks already pushes :DARWIN, :LINUX and :UNIX.
#+win32 (pushnew :windows *features*)
;;; Pushing :BSD. (Make sure this list is complete.)
#+(or darwin freebsd netbsd openbsd)
(pushnew :bsd *features*)
;;;; CPU
;;; Lispworks already pushes :X86.
#+powerpc (pushnew :ppc *features*)

View file

@ -0,0 +1,41 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-mcl.lisp --- Digitool MCL trivial-features implementation.
;;;
;;; Copyright (C) 2010, Chun Tian (binghe) <binghe.lisp@gmail.com>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew :big-endian *features*)
;;;; OS
;;; MCL already pushes :UNIX and :DARWIN.
(pushnew :bsd *features*)
;;;; CPU
#+ppc-target (pushnew :ppc *features*)

View file

@ -0,0 +1,39 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-mezzano.lisp --- Mezzano trivial-features implementation.
;;;
;;; Copyright (C) 2009, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
;;; Mezzano already pushes :LITTLE-ENDIAN.
;;;; OS
;;; Mezzano already pushes :MEZZANO.
;;;; CPU
;;; Mezzano already pushes :X86-64.

View file

@ -0,0 +1,49 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-mkcl.lisp --- MKCL implementation of trivial-features.
;;;
;;; Copyright (C) 2007-2009, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
#-(or :little-endian :big-endian)
(pushnew (let ((ptr (ffi:allocate-foreign-object :unsigned-short)))
(unwind-protect
(progn
(setf (ffi:deref-pointer ptr :unsigned-short) #xfeff)
(ecase (ffi:deref-pointer ptr :unsigned-byte)
(#xfe (intern "BIG-ENDIAN" "KEYWORD"))
(#xff (intern "LITTLE-ENDIAN" "KEYWORD"))))
(ffi:free-foreign-object ptr)))
*features*)
;;;; OS
;;; MKCL conforms to SPEC
;;;; CPU
;;; MKCL conforms to SPEC

View file

@ -0,0 +1,40 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-mocl.lisp --- MOCL trivial-features implementation.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
;;; MOCL already pushes :LITTLE-ENDIAN.
;;;; OS
;;; MOCL already pushes :IOS, :DARWIN, :BSD, and :UNIX for iOS,
;;; and :ANDROID, :LINUX, and :UNIX for Android.
;;;; CPU
;;; MOCL already pushes :ARM.

View file

@ -0,0 +1,47 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-openmcl.lisp --- OpenMCL trivial-features implementation.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew #+big-endian-target :big-endian
#+little-endian-target :little-endian
*features*)
;;;; OS
;;; OpenMCL already pushes :UNIX and :DARWIN.
#+linux-target (pushnew :linux *features*)
#+darwin (pushnew :bsd *features*)
;;;; CPU
;;; what about ppc64?
#+ppc-target (pushnew :ppc *features*)
#+x8664-target (pushnew :x86-64 *features*)

View file

@ -0,0 +1,51 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-sbcl.lisp --- SBCL trivial-features implementation.
;;;
;;; Copyright (C) 2007-2009, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew (sb-alien:with-alien ((ptr (array (sb-alien:unsigned 8) 2)))
(setf (sb-sys:sap-ref-16 (sb-alien:alien-sap ptr) 0) #xfeff)
(ecase (sb-sys:sap-ref-8 (sb-alien:alien-sap ptr) 0)
(#xfe (intern "BIG-ENDIAN" :keyword))
(#xff (intern "LITTLE-ENDIAN" :keyword))))
*features*)
;;;; OS
;;; SBCL already pushes :DARWIN, :LINUX, :BSD and :UNIX.
#+win32
(progn
;; note: as of 2008 or so, SBCL doesn't push :UNIX and :WIN32
;; simultaneously anymore.
(setq *features* (remove :unix *features*))
(pushnew :windows *features*))
;;;; CPU
;;; SBCL already pushes: :X86, :X86-64, and :PPC

View file

@ -0,0 +1,47 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-scl.lisp --- SCL implementation of trivial-features.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
(pushnew (alien:with-alien ((ptr (array (alien:unsigned 8) 2)))
(setf (sys:sap-ref-16 (alien:alien-sap ptr) 0) #xfeff)
(ecase (sys:sap-ref-8 (alien:alien-sap ptr) 0)
(#xfe (intern (symbol-name '#:big-endian) '#:keyword))
(#xff (intern (symbol-name '#:little-endian) '#:keyword))))
*features*)
;;;; OS
;;; SCL already pushes :unix, :bsd, :linux, :hpux, and :solaris
;;;; CPU
;;; SCL already pushes :amd64, :x86, :sparc, :sparc64, :hppa and :hppa64.
;;; For 64 bit CPUs the SCL pushes: :64bit
#+amd64 (pushnew :x86-64 *features*)

View file

@ -0,0 +1,39 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tf-xcl.lisp --- XCL trivial-features implementation.
;;;
;;; Copyright (C) 2009, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
;;;; Endianness
;;; XCL already pushes :LITTLE-ENDIAN.
;;;; OS
;;; XCL already pushes :LINUX, :UNIX, :FREEBSD, :NETBSD, :BSD and :WINDOWS.
;;;; CPU
;;; XCL already pushes :X86 and :X86-64.

View file

@ -0,0 +1,34 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; package.lisp --- TRIVIAL-FEATURES-TESTS package definition.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :cl-user)
(defpackage :trivial-features-tests
(:use :common-lisp
:regression-test
:alexandria
:cffi)
(:export #:run))

View file

@ -0,0 +1,49 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; sysinfo.lisp --- FFI definitions for GetSystemInfo().
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :trivial-features-tests)
(defctype word :unsigned-short)
(defcenum (architecture word)
(:amd64 9)
(:ia64 6)
(:intel 0)
(:unknown #xffff))
(defcstruct (system-info :size 36)
(processor-architecture architecture))
(load-foreign-library "kernel32.dll")
(defcfun ("GetSystemInfo" %get-system-info :cconv :stdcall) :void
(system-info :pointer))
;;; only getting at the CPU architecture for now.
(defun get-system-info ()
(with-foreign-object (si 'system-info)
(%get-system-info si)
(foreign-slot-value si 'system-info 'processor-architecture)))

View file

@ -0,0 +1,130 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; tests.lisp --- trivial-features tests.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :trivial-features-tests)
(defun run ()
(let ((*package* (find-package :trivial-features-tests)))
(do-tests)
(null (regression-test:pending-tests))))
;;;; Support Code
#-windows
(progn
;; Hmm, why not just use OSICAT-POSIX:UNAME?
(defcfun ("uname" %uname) :int
(buf :pointer))
;; Get system identification.
(defun uname ()
(with-foreign-object (buf '(:struct utsname))
(when (= (%uname buf) -1)
(error "uname() returned -1"))
(macrolet ((utsname-slot (name)
`(foreign-string-to-lisp
(foreign-slot-pointer buf 'utsname ',name))))
(values (utsname-slot sysname)
;; (utsname-slot nodename)
;; (utsname-slot release)
;; (utsname-slot version)
(utsname-slot machine))))))
(defun mutually-exclusive-p (features)
(= 1 (loop for feature in features when (featurep feature) count 1)))
;;;; Tests
(deftest endianness.1
(with-foreign-object (p :uint16)
(setf (mem-ref p :uint16) #xfeff)
(ecase (mem-ref p :uint8)
(#xfe (featurep :big-endian))
(#xff (featurep :little-endian))))
t)
(defparameter *bsds* '(:darwin :netbsd :openbsd :freebsd))
(defparameter *unices* (list* :linux *bsds*))
#+windows
(deftest os.1
(featurep (list* :or :unix *unices*))
nil)
#-windows
(deftest os.1
(featurep (make-keyword (string-upcase (uname))))
t)
(deftest os.2
(if (featurep :bsd)
(mutually-exclusive-p *bsds*)
(featurep `(:not (:or ,@*bsds*))))
t)
(deftest os.3
(if (featurep `(:or ,@*unices*))
(featurep :unix)
t)
t)
(deftest os.4
(if (featurep :windows)
(not (featurep :unix))
t)
t)
(deftest cpu.1
(mutually-exclusive-p '(:ppc :ppc64 :x86 :x86-64 :alpha :mips))
t)
#+windows
(deftest cpu.2
(case (get-system-info)
(:intel (featurep :x86))
(:amd64 (featurep :x86-64))
(:ia64 nil) ; add this feature later!
(t t))
t)
#-windows
(deftest cpu.2
(let ((machine (nth-value 1 (uname))))
(cond ((member machine '("x86" "x86_64") :test #'string=)
(ecase (foreign-type-size :pointer)
(4 (featurep :x86))
(8 (featurep :x86-64))))
(t
(format *debug-io*
"~&; NOTE: unhandled machine type, ~a, in CPU.2 test.~%"
machine)
t)))
t)
;; regression test: sometimes, silly logic leads to pushing nil to
;; *features*.
(deftest nil.1 (featurep nil) nil)
(deftest nil.2 (featurep :nil) nil)

View file

@ -0,0 +1,36 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; utsname.lisp --- Grovel definitions for uname(3).
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(in-package :trivial-features-tests)
(include "sys/utsname.h")
(cstruct utsname "struct utsname"
(sysname "sysname" :type :char)
(nodename "nodename" :type :char)
(release "release" :type :char)
(version "version" :type :char)
(machine "machine" :type :char))

View file

@ -0,0 +1,52 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; trivial-features-tests.asd --- ASDF definition.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
(eval-when (:load-toplevel :execute)
;; We need to load trivial-features this way before the the
;; defsystem form is read for the corner case when someone loads
;; trivial-features-tests before trivial-features since the system
;; definition's got a #+windows reader conditional that is supplied
;; by trivial-features.
(oos 'load-op 'trivial-features))
(defsystem trivial-features-tests
:description "Unit tests for TRIVIAL-FEATURES."
:author "Luis Oliveira <loliveira@common-lisp.net>"
:licence "MIT"
:defsystem-depends-on (cffi-grovel)
:depends-on (trivial-features rt cffi alexandria)
:components
((:module tests
:serial t
:components
((:file "package")
#-windows (:cffi-grovel-file "utsname")
#+windows (:file "sysinfo")
(:file "tests")))))
(defmethod perform ((o test-op) (c (eql (find-system 'trivial-features-tests))))
(let ((*package* (find-package 'trivial-features-tests)))
(funcall (find-symbol (symbol-name '#:do-tests)))))

View file

@ -0,0 +1,59 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; trivial-features.asd --- ASDF system definition.
;;;
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without
;;; restriction, including without limitation the rights to use, copy,
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
;;; of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;;; DEALINGS IN THE SOFTWARE.
#-(or sbcl clisp allegro openmcl mcl mkcl lispworks ecl cmu scl cormanlisp abcl xcl mocl clasp mezzano)
(error "Sorry, your Lisp is not supported. Patches welcome.")
(defsystem trivial-features
:description "Ensures consistent *FEATURES* across multiple CLs."
:author "Luis Oliveira <loliveira@common-lisp.net>"
:licence "MIT"
:components
((:module src
:serial t
:components
(#+allegro (:file "tf-allegro")
#+clisp (:file "tf-clisp")
#+cmu (:file "tf-cmucl")
#+cormanlisp (:file "tf-cormanlisp")
#+ecl (:file "tf-ecl")
#+lispworks (:file "tf-lispworks")
#+openmcl (:file "tf-openmcl")
#+mcl (:file "tf-mcl")
#+mkcl (:file "tf-mkcl")
#+sbcl (:file "tf-sbcl")
#+scl (:file "tf-scl")
#+abcl (:file "tf-abcl")
#+xcl (:file "tf-xcl")
#+mocl (:file "tf-mocl")
#+clasp (:file "tf-clasp")
#+mezzano (:file "tf-mezzano")
))))
#-mezzano
(defmethod perform ((o test-op) (c (eql (find-system 'trivial-features))))
(operate 'load-op 'trivial-features-tests)
(operate 'test-op 'trivial-features-tests))