sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Simplify tests structure

Browse source 
Also "make check" accepts TESTS argument for test suite. For instance:

make check TESTS=ffi

will run FFI tests suite.
This commit is contained in:
Daniel Kochmański 2016-11-17 22:35:37 +01:00
parent c2fb4fdded
commit 085fee3d3b
21 changed files with 94 additions and 472 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Makefile.in
View file

@ -118,9 +118,7 @@ distclean: clean
realclean: distclean
check:
cd build && $(MAKE) check
recheck:
cd build && $(MAKE) recheck
cd build && $(MAKE) check TESTS="$(TESTS)"
# ==================== Various means of distribution ====================

5
src/Makefile.in
View file

@ -369,9 +369,8 @@ test_changes:
# Run test suite
#
check:
cd tests && $(MAKE)
recheck:
cd tests && $(MAKE) clean && $(MAKE)
cd tests && $(MAKE) clean && $(MAKE) check TESTS="$(TESTS)"
#
# Rebuild ECL using its own image and compare. Does not work
# right now.

7
src/tests/Makefile.in
View file

@ -8,9 +8,10 @@ ECL=@prefix@/@bindir@/ecl@EXEEXT@
all: check
check: config.lsp
$(ECL) -norc -load config.lsp \
-eval '(ecl-tests::run-tests)' \
-eval '(ext:quit)' \
$(ECL) -norc \
-load config.lsp \
-eval "(ecl-tests::run-tests '($(TESTS)))" \
-eval "(ext:quit)" \
2>&1 | tee check.log
clean:

32
src/tests/config.lsp.in
View file

@ -21,8 +21,6 @@
when (probe-file "configure.ac")
return *default-pathname-defaults*))
(defvar *test-sources* (merge-pathnames "tests/" *ecl-sources*))
(defvar *here* (merge-pathnames "@builddir@/"))
(defvar *cache* (merge-pathnames "./cache/" *here*))
@ -31,13 +29,6 @@
#+windows (namestring (truename "sys:ecl.exe"))
#-windows "@prefix@/bin/ecl"))
(defvar *test-image-args*
`("-norc"
"-eval" "(print (ext:getenv \"ECLDIR\"))"
"-eval" "(ignore-errors (require :cmp))"
"-load" ,(namestring (merge-pathnames "doit.lsp" *test-sources*))
"-eval" "(quit)"))
#+ecl
(ext:setenv "ECLDIR" (namestring (truename "SYS:")))
@ -82,8 +73,11 @@
;;;
;;; RUNNING TESTS
;;;
(defun run-tests ()
(defun run-tests (suites
&aux (suites (cond
((null suites) "make-check")
((null (cdr suites)) (car suites))
(T suites))))
;; Cleanup stray files
(delete-everything *sandbox*)
(ensure-directories-exist *sandbox*)
@ -91,8 +85,20 @@
(progn
(ext:chdir *sandbox*)
(ext:run-program *test-image*
*test-image-args*
`("-norc"
"-eval" "(print (ext:getenv \"ECLDIR\"))"
"-eval" "(ignore-errors (require :cmp))"
"-load" ,(namestring
(merge-pathnames
"tests/doit.lsp" *ecl-sources*))
"-eval" "(in-package cl-test)"
"-eval" ,(format nil "(2am-ecl:run '~a)" suites)
"-eval" "(ext:exit)")
:input nil
:output t
:error :output))
(ext:chdir *here*)))
(ext:chdir *here*)
#+ (or)
(format t "~%Known fails: ~%~{~a~%~}~%"
'(SEM-SIGNAL-N-PROCESSES
SEM-SIGNAL-ONLY-N-PROCESSES))))

5
src/tests/doit.lsp
View file

@ -1,7 +1,8 @@
(in-package #:common-lisp-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :asdf))
(require :asdf)
(require :package-locks))
(let ((cache (merge-pathnames "./cache/" *default-pathname-defaults*)))
(ensure-directories-exist cache)
@ -9,4 +10,4 @@
(asdf:load-asd (merge-pathnames "ecl-tests.asd" *load-pathname*)))
(asdf:operate 'asdf:load-source-op 'ecl-tests)
(2am-ecl:run 'cl-test::make-check)
#+ (or) (2am-ecl:run 'cl-test::make-check)

26
src/tests/ecl-tests.asd
View file

@ -5,37 +5,33 @@
:author "Daniel Kochmański <daniel@turtleware.eu>"
:license "LGPL-2.1+"
:serial t
:components ((:file "2am") ; continuous integration
:components ((:file "1am") ; for stress tests
(:file "2am") ; continuous integration
(:file "ecl-tests")
(:file "universe")
(:module regressions
(:module normal-tests
:default-component-class asdf:cl-source-file.lsp
:components
((:file "ansi")
(:file "mixed")
(:file "compiler")
(:file "multiprocessing" :if-feature :threads)
(:file "embedding" :if-feature (:not :ecl-bytecmp))
(:file "foreign-interface" :if-feature :ffi)
(:file "metaobject-protocol" :if-feature :clos)
(:file "multiprocessing" :if-feature :threads)))
(:module features
:default-component-class asdf:cl-source-file.lsp
:components
((:file "external-formats" :if-feature :unicode)
(:file "ieee-fp" :if-feature :ieee-floating-point)
(:file "package-locks" :if-feature :package-locks)
(:file "external-process")
(:file "multiprocessing")))))
(:file "external-formats" :if-feature :unicode)))
(:module stress-tests
:default-component-class asdf:cl-source-file.lsp
:components
((:file "multiprocessing" :if-feature :threads)))))
(asdf:defsystem #:ecl-tests/stress
:serial t
:components
((:file "1am") ; for stress tests
(:module stress
:default-component-class asdf:cl-source-file.lsp
:components
(#+threads
(:file "multiprocessing")))))
(
))
;;; General tests
(asdf:defsystem #:ecl-tests/ansi)

31
src/tests/ecl-tests.lisp
View file

@ -21,37 +21,10 @@
;;;; Declare the suites
(suite 'ecl-tests
'(regressions
features))
'(eformat ieee-fp eprocess package-locks ansi+ mixed cmp emb ffi mop mp))
(suite 'make-check
'(features/eformat
features/ieee-fp
features/eprocess
features/package-locks
regressions/ansi+
regressions/mixed
regressions/cmp
regressions/emb
regressions/ffi
regressions/mop
;; disable regressions/mp due to fails
#+ (or) regressions/mp))
(suite 'regressions
'(regressions/ansi+
regressions/mixed
regressions/cmp
regressions/emb
regressions/ffi
regressions/mop
regressions/mp))
(suite 'features
'(features/eformat
features/ieee-fp
features/eprocess
features/mp))
'(ieee-fp eprocess package-locks ansi+ mixed cmp emb ffi mop))
;;; Some syntactic sugar for 2am

27
src/tests/features/external-process.lsp
View file

@ -1,27 +0,0 @@
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil -*-
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
;;;; Author: Daniel Kochmański
;;;; Created: 2016-09-07
;;;; Contains: External process interaction API
;;;;
(in-package :cl-test)
(suite 'features/eprocess)
(test external-process.0001.run-program/wait/terminate
(let ((p (nth-value 2 (ext:run-program #-windows "sleep"
#+windows "timeout"
(list "3") :wait nil))))
(is (eql :running (ext:external-process-wait p nil))
"process doesn't run")
(ext:terminate-process p)
(sleep 1)
(multiple-value-bind (status code)
(ext:external-process-wait p nil)
(is (eql :signaled status)
"status is ~s, should be ~s" status :signalled)
(is (eql ext:+sigterm+ code)
"signal code is ~s, should be ~s" code ext:+sigterm+))
(finishes (ext:terminate-process p))))

28
src/tests/features/multiprocessing.lsp
View file

@ -1,28 +0,0 @@
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil -*-
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
;;;; Author: Daniel Kochmański
;;;; Created: 2016-10-05
;;;; Contains: Multithreading API tests
(in-package :cl-test)
(suite 'features/mp)
;;; Date: 2016-10-05
;;; From: Daniel Kochmański
;;; Description:
;;;
;;; HOLDING-LOCK-P verifies, if the current process holds the
;;; lock.
;;;
(test mp-holding-lock-p
(let ((lock (mp:make-lock :name "mp-holding-lock-p" :recursive nil)))
(is-false (mp:holding-lock-p lock))
(mp:with-lock (lock)
(is-true (mp:holding-lock-p lock))
(mp:process-run-function
"mp-holding-lock-p"
#'(lambda () (is-false (mp:holding-lock-p lock)))))
(is-false (mp:holding-lock-p lock))
(mp:process-run-function
"mp-holding-lock-p"
#'(lambda () (is-false (mp:holding-lock-p lock))))))

2
src/tests/regressions/ansi.lsp → src/tests/normal-tests/ansi.lsp
View file

@ -3,7 +3,7 @@
(in-package :cl-test)
(suite 'regressions/ansi+)
(suite 'ansi+)
;; HyperSpec – 3.*

2
src/tests/regressions/compiler.lsp → src/tests/normal-tests/compiler.lsp
View file

@ -7,7 +7,7 @@
(in-package :cl-test)
(suite 'regressions/cmp)
(suite 'cmp)
;; cl-001

2
src/tests/regressions/embedding.lsp → src/tests/normal-tests/embedding.lsp
View file

@ -7,7 +7,7 @@
(in-package :cl-test)
(suite 'regressions/emb)
(suite 'emb)
(defun test-C-program (c-code &key capture-output)
(ensure-directories-exist "tmp/")

2
src/tests/features/external-formats.lsp → src/tests/normal-tests/external-formats.lsp
View file

@ -10,7 +10,7 @@
(in-package :cl-test)
(suite 'features/eformat)
(suite 'eformat)
;;; eformat-001

2
src/tests/regressions/foreign-interface.lsp → src/tests/normal-tests/foreign-interface.lsp
View file

@ -7,7 +7,7 @@
;;;; Contains: Foreign Function Interface regression tests
(in-package :cl-test)
(suite 'regressions/ffi)
(suite 'ffi)
;;; Date: 23/03/2006
;;; From: Klaus Falb

2
src/tests/features/ieee-fp.lsp → src/tests/normal-tests/ieee-fp.lsp
View file

@ -8,7 +8,7 @@
(in-package :cl-test)
(suite 'features/ieee-fp)
(suite 'ieee-fp)
(test ieee-fp.0001.infinity-eql
(let ((sfni ext:single-float-negative-infinity)

2
src/tests/regressions/metaobject-protocol.lsp → src/tests/normal-tests/metaobject-protocol.lsp
View file

@ -8,7 +8,7 @@
(in-package #:cl-test)
(suite 'regressions/mop)
(suite 'mop)
;; mop-001

23
src/tests/regressions/mixed.lsp → src/tests/normal-tests/mixed.lsp
View file

@ -5,7 +5,7 @@
(in-package :cl-test)
(suite 'regressions/mixed)
(suite 'mixed)
;;; (EXT:PACKAGE-LOCK) returned the wrong value.
@ -174,3 +174,24 @@
"Not-file stream would cause internal error on this ECL (skipped)")))
;;;; Author: Daniel Kochmański
;;;; Created: 2016-09-07
;;;; Contains: External process interaction API
;;;;
(test external-process.0001.run-program/wait/terminate
(let ((p (nth-value 2 (ext:run-program #-windows "sleep"
#+windows "timeout"
(list "3") :wait nil))))
(is (eql :running (ext:external-process-wait p nil))
"process doesn't run")
(ext:terminate-process p)
(sleep 1)
(multiple-value-bind (status code)
(ext:external-process-wait p nil)
(is (eql :signaled status)
"status is ~s, should be ~s" status :signalled)
(is (eql ext:+sigterm+ code)
"signal code is ~s, should be ~s" code ext:+sigterm+))
(finishes (ext:terminate-process p))))

23
src/tests/regressions/multiprocessing.lsp → src/tests/normal-tests/multiprocessing.lsp
View file

@ -7,7 +7,7 @@
(in-package :cl-test)
(suite 'regressions/mp)
(suite 'mp)
;; Auxiliary routines for multithreaded tests
@ -542,3 +542,24 @@ creating stray processes."
;;; Description: CLASS-OF called on rwlock crashed lisp process
(test rwlock
(finishes (class-of (mp:make-rwlock))))
;;; Date: 2016-10-05
;;; From: Daniel Kochmański
;;; Description:
;;;
;;; HOLDING-LOCK-P verifies, if the current process holds the
;;; lock.
;;;
(test mp-holding-lock-p
(let ((lock (mp:make-lock :name "mp-holding-lock-p" :recursive nil)))
(is-false (mp:holding-lock-p lock))
(mp:with-lock (lock)
(is-true (mp:holding-lock-p lock))
(mp:process-run-function
"mp-holding-lock-p"
#'(lambda () (is-false (mp:holding-lock-p lock)))))
(is-false (mp:holding-lock-p lock))
(mp:process-run-function
"mp-holding-lock-p"
#'(lambda () (is-false (mp:holding-lock-p lock))))))

2
src/tests/features/package-locks.lsp → src/tests/normal-tests/package-locks.lsp
View file

@ -8,7 +8,7 @@
(in-package :cl-test)
(suite 'features/package-locks)
(suite 'package-locks)
(defmacro with-fresh-package (name &body body)
`(progn

339
src/tests/regressions/external-formats.lsp
View file

@ -1,339 +0,0 @@
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil -*-
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
;;;; Author: Juan Jose Garcia-Ripoll
;;;; Created: Sat Jan 03 2:56:03 CEST 2007
;;;; Contains: External format tests
;;;;
;;;; Based on the code and files from FLEXI-STREAMS 1.0.7
;;;;
(in-package :cl-test)
(suite 'features/eformat)
;;; eformat-001
(defconstant +buffer-size+ 8192
"Size of buffers for COPY-STREAM* below.")
(defparameter *copy-function* 'copy-stream
"Which function to use when copying from one stream to the other -
see for example COPY-FILE below.")
(defparameter *eformat-test-files*
'(("unicode_demo" (:utf8 :ucs2 :ucs4))
("kafka" (:utf8 :latin1 :cp1252))
("hebrew" (:utf8 :latin8))
("russian" (:utf8 :koi8r))
("tilton" (:utf8 :ascii))
)
"A list of test files where each entry consists of the name
prefix and a list of encodings.")
(defun create-file-variants (file-name symbol)
"For a name suffix FILE-NAME and a symbol SYMBOL denoting an
encoding returns a list of pairs where the car is a full file
name and the cdr is the corresponding external format. This list
contains all possible variants w.r.t. to line-end conversion and
endianness."
(let ((variants (ecase symbol
(:ascii '(:us-ascii))
(:latin1 '(:latin-1))
(:latin8 '(:iso-8859-8))
(:cp1252 '(:windows-cp1252))
(:koi8r '(:koi8-r))
(:utf8 '(:utf-8))
(:ucs2 '(:ucs-2be :ucs-2le))
(:ucs4 '(:ucs-4be :ucs-4le)))))
(loop for arg in variants
nconc (let* ((endian-suffix (case arg
((:ucs-2be :ucs-4be) "_be")
((:ucs-2le :ucs-4le) "_le")
(t ""))))
(loop for eol-style in '(:lf :cr :crlf)
collect (cons (format nil "~A_~(~A~)_~(~A~)~A.txt"
file-name symbol eol-style endian-suffix)
(list eol-style arg)))))))
(defun create-test-combinations (file-name symbols &optional simplep)
"For a name suffix FILE-NAME and a list of symbols SYMBOLS denoting
different encodings of the corresponding file returns a list of lists
which can be used as arglists by DO-EFORMAT-TEST-001. If SIMPLEP is true, a
list which can be used for the string and sequence tests below is
returned."
(let ((file-variants (loop for symbol in symbols
nconc (create-file-variants file-name symbol))))
(loop for (name-in . external-format-in) in file-variants
when simplep
collect (list name-in external-format-in)
else
nconc (loop for (name-out . external-format-out) in file-variants
collect (list name-in external-format-in name-out external-format-out)))))
(defun file-equal (file1 file2)
"Returns a true value iff FILE1 and FILE2 have the same
contents \(viewed as binary files)."
(with-open-file (stream1 file1 :element-type '(unsigned-byte 8))
(with-open-file (stream2 file2 :element-type '(unsigned-byte 8))
(if (= (file-length stream1) (file-length stream2))
(loop for p1 = (file-position stream1)
for byte1 = (read-byte stream1 nil nil)
for byte2 = (read-byte stream2 nil nil)
while (and byte1 byte2)
unless (= byte1 byte2)
do (return (values nil p1))
finally (return (values t 0)))
(values nil -1)))))
(defun copy-stream (in out)
"Copies the contents of the binary stream STREAM-IN to the
binary stream STREAM-OUT using flexi streams - STREAM-IN is read
with the external format EXTERNAL-FORMAT-IN and STREAM-OUT is
written with EXTERNAL-FORMAT-OUT."
(loop for line = (read-line in nil nil)
while line
do (write-line line out)))
(defun copy-stream* (in out)
"Like COPY-STREAM, but uses READ-SEQUENCE and WRITE-SEQUENCE instead
of READ-LINE and WRITE-LINE."
(let ((buffer (make-array +buffer-size+ :element-type 'char*)))
(loop
(let ((position (read-sequence buffer in)))
(when (zerop position) (return))
(write-sequence buffer out :end position)))))
(defun do-eformat-test-001 (*copy-function*)
"Each test in this suite copies the contents of one file \(in the
`test' directory) to another file \(in a temporary directory) using
flexi streams with different external formats. The resulting file is
compared with an existing file in the `test' directory to check if the
outcome is as expected. Uses various variants of the :DIRECTION
keyword when opening the files.
Returns a true value iff all tests succeeded. Prints information
about each individual comparison if VERBOSE is true."
(labels
((copy-file (path-in external-format-in path-out external-format-out
direction-out direction-in)
(with-open-file (in path-in
:element-type 'character
:direction direction-in
:if-does-not-exist :error
:if-exists :overwrite
:external-format external-format-in)
(with-open-file (out path-out
:element-type 'character
:direction direction-out
:if-does-not-exist :create
:if-exists :supersede
:external-format external-format-out)
(funcall *copy-function* in out))))
(one-comparison (path-in external-format-in path-out external-format-out)
(loop with full-path-in = (merge-pathnames path-in "./eformat-tests/")
and full-path-out = (ensure-directories-exist
(merge-pathnames path-out "./eformat-tmp/"))
and full-path-orig = (merge-pathnames path-out "./eformat-tests/")
for direction-out in '(:output :io)
nconc (loop for direction-in in '(:input :io)
for args = (list path-in external-format-in direction-in
path-out external-format-out direction-out)
with ok = nil
with pos = 0
unless (progn
(copy-file full-path-in external-format-in
full-path-out external-format-out
direction-out direction-in)
(is (multiple-value-setq (ok pos)
(file-equal full-path-out full-path-orig))
"~%~A -> ~A" path-in path-out))
collect (progn
(format t "~%;;; Discordance at pos ~D~%between ~A~% and ~A~%"
pos full-path-out full-path-orig)
args)))))
(loop with do-eformat-test-001-args-list =
(loop for (file-name symbols) in *eformat-test-files*
nconc (create-test-combinations file-name symbols))
for (path-in external-format-in path-out external-format-out) in do-eformat-test-001-args-list
nconc (one-comparison path-in external-format-in path-out external-format-out))))
;;; Date: 02/01/2007
;;; From: Juanjo
;;; Fixed: Not a bug
;;; Description:
;;;
;;; Test external formats by transcoding several files into all possible
;;; supported formats and checking against the expected results. This
;;; test uses READ/WRITE-CHAR via READ/WRITE-LINE.
;;;
(test external-format.0001-transcode-read-char
(is-false (do-eformat-test-001 'copy-stream)))
;;; Date: 02/01/2007
;;; From: Juanjo
;;; Fixed: Not a bug
;;; Description:
;;;
;;; Test external formats by transcoding several files into all possible
;;; supported formats and checking against the expected results. This
;;; test uses READ/WRITE-CHAR via READ/WRITE-LINE.
;;;
(test external-format.0002-transcode-read-char
(is-false (do-eformat-test-001 'copy-stream*)))
;;; eformat-002
(load "sys:encodings;tools")
(setf *print-circle* t) ; some mappings contain circular structures
(defun binary-dump (filename &optional (position 0) (limit nil))
(format t "~%FILE: ~A from ~D, ~D bytes" filename position limit)
(with-open-file (file filename :element-type '(unsigned-byte 8))
(file-position file position)
(loop for i from 0
for byte = (read-byte file nil nil)
for c = (and byte (code-char byte))
while (and byte (or (null limit) (< i limit)))
do (progn (when (zerop (mod i 8)) (terpri))
(format t "~5X ~3A" byte
(cond ((and (< 31 byte 127) (standard-char-p c))
c)
((eql c #\Esc) "ESC")
(t " ")))
)))
(terpri)
(force-output))
(defun random-strings (char-bag n)
(if (consp char-bag)
(apply #'concatenate 'string
(loop for i from 0 below 2
for actual-bag = (elt char-bag (random (length char-bag)))
collect (random-strings actual-bag (random n))))
(concatenate 'string
(loop for i from 0 to n
for c = (char char-bag (random (length char-bag)))
unless (eql c #\Newline)
collect c))))
(defun compare-files (a b &optional all-chars)
(with-open-file (sa a :direction :input :element-type '(unsigned-byte 8))
(with-open-file (sb b :direction :input :element-type '(unsigned-byte 8))
(loop for b1 = (read-byte sa nil nil)
for b2 = (read-byte sb nil nil)
while (or b1 b2)
do (unless (eql b1 b2)
(let* ((position (1- (file-position sa)))
(start-dump (max 0 (- position 8))))
(setf position (logandc2 position 3))
(binary-dump a start-dump 32)
(binary-dump b start-dump 32)
(format t "~%Mismatch between~%~T~A~% and~T~A~% at file position ~D~%"
a b position)
(when all-chars
(loop with imin = (floor start-dump 4)
with imax = (min (+ imin 9) (length all-chars))
for i from imin below imax
for j from 0
for c = (char all-chars i)
do (progn (when (zerop (mod j 8)) (terpri))
(format t "~4X " (char-code c))))
(terpri))
(return nil)))
finally (return t)))))
(defun test-output (format-name &optional iconv-name (nlines 128) (nchars 10))
(set 'ext::foo format-name)
(let* ((*print-circle* t)
(mappings (loop for table = (ext::make-encoding format-name)
while (and table (symbolp table))
do (setf format-name table)
finally (return (or table format-name))))
(char-bags (all-valid-unicode-chars mappings))
(encoded-filename (format nil "eformat-tmp/iconv-~A.txt" format-name))
(decoded-filename (format nil "eformat-tmp/iconv-~A-utf32.txt" format-name))
(iconv-filename (format nil "eformat-tmp/iconv-~A-iconv-utf32.txt" format-name))
(random-lines (loop for line from 1 to nlines
collect (random-strings char-bags nchars)))
(all-chars (apply #'concatenate 'string
(loop for i in random-lines
nconc (list i (list #\Newline))))))
(ensure-directories-exist encoded-filename)
;; Output in that format
(with-open-file (out encoded-filename :direction :output :external-format format-name
:if-exists :supersede)
(loop for i in random-lines
do (write-line i out)))
(with-open-file (out decoded-filename :direction :output :external-format :ucs-4be
:if-exists :supersede)
(loop for i in random-lines
do (write-line i out)))
(with-open-file (in encoded-filename :direction :input :external-format format-name)
(loop for line = (read-line in nil nil)
for i in random-lines
for n from 1
while line
unless (string= i line)
do (progn
(format t "Mismatch on line ~D between~% ~S and~% ~S" n line i)
(return-from test-output nil))))
(when iconv-name
(let ((command (format nil "iconv -f ~A -t UTF-32BE ~A > ~A"
iconv-name encoded-filename iconv-filename)))
(if (zerop
(si::system command))
(compare-files decoded-filename iconv-filename all-chars)
(prog1 T
(format t "~&;;; iconv command failed:~A~%" command)))))))
;;; Date: 09/01/2007
;;; From: Juanjo
;;; Fixed: Not a bug
;;; Description:
;;;
;;; Test external formats by transcoding random sequences of characters using
;;; ECL and iconv.
;;;
#-msvc
;; In Windows SYSTEM does not fail with a nonzero code when it
;; fails to execute a command. Hence in that case we assume
;; we simply can not run these tests
(when (zerop (si::system "iconv -l >/dev/null 2>&1"))
(test external-format.simple-iconv-check
(is-false
(loop for name in '(:ISO-8859-1 :ISO-8859-2 :ISO-8859-3 :ISO-8859-4
:ISO-8859-5 :ISO-8859-6 :ISO-8859-7 :ISO-8859-8
:ISO-8859-9 :ISO-8859-10 :ISO-8859-11 :ISO-8859-13
:ISO-8859-14 :ISO-8859-15 :ISO-8859-16
:KOI8-R :KOI8-U
:IBM437 :IBM850 :IBM852 :IBM855 :IBM857 :IBM860
:IBM861 :IBM862 :IBM863 :IBM864 :IBM865 :IBM866
:IBM869
:CP936 :CP949 :CP950
:WINDOWS-1250 :WINDOWS-1251 :WINDOWS-1252 :WINDOWS-1253
:WINDOWS-1254 :WINDOWS-1256 :WINDOWS-1257
;; :CP932 :WINDOWS-1255 :WINDOWS-1258 with
;; iconv may output combined characters, when ECL would
;; output the base and the comibining one. Hence, no simple
;; comparison is possible.
:ISO-2022-JP
;; :ISO-2022-JP-1
;; iconv doesn't support ISO-2022-JP-1 (hue hue hue)
)
unless (progn
(loop for i from 1 to 10
always (is (test-output name (symbol-name name))
"iconv test ~s failed" name)))
collect name))))

0
src/tests/stress/multiprocessing.lsp → src/tests/stress-tests/multiprocessing.lsp
View file