mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-04-25 02:50:24 -07:00
Code Issues Projects Releases Packages Wiki Activity

Adapt the tools files for being used by the test suite

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-01-09 11:11:44 +01:00
parent 392cb901f6
commit f4eb4dc68c
1 changed files with 17 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

26
contrib/encodings/tools.lisp
View file

@ -13,7 +13,10 @@
(defconstant +source-pathname+
(make-pathname :name nil :type nil
:defaults (merge-pathnames "ext:;sources;" *load-pathname*)))
:directory (append (pathname-directory *load-pathname*)
(list "sources"))
:host (pathname-host *load-pathname*)
:device (pathname-device *load-pathname*)))
(defconstant +all-mappings+
'(("ATARIST" "http://unicode.org/Public/MAPPINGS/VENDORS/MISC/ATARIST.TXT")
@ -172,14 +175,19 @@
do (write-sequence buffer sout :end nbytes))))))
(defun all-valid-unicode-chars (mapping)
(if (consp mapping)
(loop for sublist on mapping
for i from 0 below 10
until (and (eq sublist mapping) (plusp i))
collect (all-valid-unicode-chars (first sublist)))
(concatenate 'string (loop for key being the hash-key in mapping
when (characterp key)
collect key))))
(cond ((consp mapping)
(loop for sublist on mapping
for i from 0 below 10
until (and (eq sublist mapping) (plusp i))
collect (all-valid-unicode-chars (first sublist))))
((hash-table-p mapping)
(concatenate 'string (loop for key being the hash-key in mapping
when (characterp key)
collect key)))
((eq mapping :iso-8859-1)
(coerce 'string (loop for i from 0 to 255 collect (code-char i))))
(t
(error "Unknown encoding"))))
(defun compare-hashes (h1 h2)
(flet ((h1-in-h2 (h1 h2)