Commit ea385d74 authored by Erick's avatar Erick

Fixed the tests again...

parent fa41e29a
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 23-Dec-2010 18:47 (eg)
;;;; Last file update: 23-Mar-2018 17:42 (eg)
;;;; Last file update: 15-Jun-2018 19:40 (eg)
;;;;
(require "test")
......@@ -55,15 +55,5 @@
``(,@(append ,@'((list 2 3) (list 5 7)))))
;;---- Test the lambda form with λ symbol
(test "lambda symbol.1"
'(1 2 3)
( (λ l l) 1 2 3))
(test "lambda symbol.2"
'(1 2 3)
( (λ λ λ) 1 2 3))
;;------------------------------------------------------------------
(test-section-end)
;;;; -*- coding utf-8 -*-
;;;; test-utf8.stk -- Test of UTF-8 strings
;;;; -*- coding utf-8 -*-
;;;; test-utf8.stk -- Test of UTF-8 strings
;;;;
;;;; Copyright © 2011-2012 Erick Gallesio - Polytech'Nice-Sophia <eg@unice.fr>
;;;; Copyright © 2011-2018 Erick Gallesio - Polytech'Nice-Sophia <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,20 +21,20 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 27-May-2011 23:35 (eg)
;;;; Last file update: 26-Feb-2012 23:33 (eg)
;;;; Last file update: 15-Jun-2018 19:41 (eg)
;;;;
(require "test")
;;(define *lang-is-utf8?* (let ((lang (getenv "LANG")))
;; (and lang
;; (or (string-find? "UTF8" lang)
;; (string-find? "utf8" lang)))))
;; (and lang
;; (or (string-find? "UTF8" lang)
;; (string-find? "utf8" lang)))))
(define *lang-is-utf8?* #t) ;; In fact, we force it, since it must work even if
;; user doesn't use UTF-8 when launch the test.
;; STklos is now called with with -u=1 option
;; user doesn't use UTF-8 when launch the test.
;; STklos is now called with with -u=1 option
(define *is-C?* (equal? (%get-locale) "C"))
......@@ -92,23 +92,23 @@
(test "gambit.1" #\I (char-upcase #\i))
(test "gambit.2" #\i (char-downcase #\i))
#;(test "gambit.3" #\I (char-titlecase #\i)) ;; not R7
#;(test "gambit.3" #\I (char-titlecase #\i)) ;; not R7
(test "gambit.4" #\i (char-foldcase #\i))
(test "gambit.5" #\xDF (char-upcase #\xDF))
(test "gambit.6" #\xDF (char-downcase #\xDF))
#;(test "gambit.7" #\xDF (char-titlecase #\xDF)) ;; not R7
#;(test "gambit.7" #\xDF (char-titlecase #\xDF)) ;; not R7
(test "gambit.8" #\xDF (char-foldcase #\xDF))
(test "gambit.9" #\x3A3 (char-upcase #\x3A3))
(unless *is-C?* (test "gambit.10" #\x3C3 (char-downcase #\x3A3)))
#;(test "gambit.11" #\x3A3 (char-titlecase #\x3A3)) ;; not R7
#;(test "gambit.11" #\x3A3 (char-titlecase #\x3A3)) ;; not R7
(unless *is-C?*
(test "gambit.12" #\x3C3 (char-foldcase #\x3A3))
(test "gambit.13" #\x3A3 (char-upcase #\x3C2)))
(test "gambit.14" #\x3C2 (char-downcase #\x3C2))
#;(test "gambit.15" #\x3A3 (char-titlecase #\x3C2)) ;; not R7
#;(test "gambit.15" #\x3A3 (char-titlecase #\x3C2)) ;; not R7
(test "gambit.16" #\x3C3 (char-foldcase #\x3C2))
(test "gambit.17" #f (char-ci<? #\z #\Z))
......@@ -136,7 +136,7 @@
(test "gambit.38" #t (char-numeric? #\1))
(test "gambit.39" #f (char-numeric? #\a))
(test "gambit.40" #t (char-whitespace? #\space))
#;(test "gambit.41" #t (char-whitespace? #\x00A0)) ;; not clear
#;(test "gambit.41" #t (char-whitespace? #\x00A0)) ;; not clear
(test "gambit.42" #f (char-whitespace? #\a))
(test "gambit.43" #f (char-upper-case? #\a))
(test "gambit.44" #t (char-upper-case? #\A))
......@@ -147,13 +147,13 @@
(test "gambit.47" #f (char-lower-case? #\A))
(unless *is-C?*
(test "gambit.48" #t (char-lower-case? #\x3C3)))
#;(test "gambit.49" #t (char-lower-case? #\x00AA)) ;; not clear
#;(test "gambit.50" #f (char-title-case? #\a)) ;; Not R7
#;(test "gambit.51" #f (char-title-case? #\A)) ;; Not R7
#;(test "gambit.52" #f (char-title-case? #\I)) ;; Not R7
#;(test "gambit.53" #t (char-title-case? #\x01C5)) ;; Not R7
#;(test "gambit.49" #t (char-lower-case? #\x00AA)) ;; not clear
#;(test "gambit.50" #f (char-title-case? #\a)) ;; Not R7
#;(test "gambit.51" #f (char-title-case? #\A)) ;; Not R7
#;(test "gambit.52" #f (char-title-case? #\I)) ;; Not R7
#;(test "gambit.53" #t (char-title-case? #\x01C5)) ;; Not R7
#;(test "gambit.54" 'Ll (char-general-category #\a)) ;; Not R7
#;(test "gambit.54" 'Ll (char-general-category #\a)) ;; Not R7
#;(test "gambit.55" 'Zs (char-general-category #\space)) ;; Not R7
#;(test "gambit.56" 'Cn (char-general-category #\x10FFFF)) ;; Not R7
......@@ -165,9 +165,9 @@
(test "gambit.G2" "hi" (string-foldcase "HI"))
(test "gambit.63" "hi" (string-foldcase "hi"))
#; (test "gambit.64" "STRASSE" (string-upcase "Stra\xDF;e")) ;; not R7
#; (test "gambit.64" "STRASSE" (string-upcase "Stra\xDF;e")) ;; not R7
(test "gambit.65" "stra\xDF;e" (string-downcase "Stra\xDF;e"))
#;(test "gambit.66" "strasse" (string-foldcase "Stra\xDF;e")) ;; not R7
#;(test "gambit.66" "strasse" (string-foldcase "Stra\xDF;e")) ;; not R7
(test "gambit.67" "strasse" (string-downcase "STRASSE"))
(unless *is-C?*
......@@ -175,24 +175,24 @@
(test "gambit.69" "\x39E;\x391;\x39F;\x3A3;"
(string-upcase "\x39E;\x391;\x39F;\x3A3;"))
#;(test "gambit.70" "\x3BE;\x3B1;\x3BF;\x3C2;" ;; not R7
#;(test "gambit.70" "\x3BE;\x3B1;\x3BF;\x3C2;" ;; not R7
(string-downcase "\x39E;\x391;\x39F;\x3A3;"))
#;(test "gambit.71" "\x3BE;\x3B1;\x3BF;\x3C3;\x3C2;" ;; not R7
#;(test "gambit.71" "\x3BE;\x3B1;\x3BF;\x3C3;\x3C2;" ;; not R7
(string-downcase "\x39E;\x391;\x39F;\x3A3;\x3A3;"))
#;(test "gambit.72" "\x3BE;\x3B1;\x3BF;\x3C2; \x3C3;"
(string-downcase "\x39E;\x391;\x39F;\x3A3; \x3A3;")) ;; not R7
(string-downcase "\x39E;\x391;\x39F;\x3A3; \x3A3;")) ;; not R7
(unless *is-C?*
(test "gambit.73" "\x3BE;\x3B1;\x3BF;\x3C3;"
(string-foldcase "\x39E;\x391;\x39F;\x3A3;"))
(string-foldcase "\x39E;\x391;\x39F;\x3A3;"))
(test "gambit.74" "\x39E;\x391;\x39F;\x3A3;"
(string-upcase "\x3BE;\x3B1;\x3BF;\x3C3;"))
(string-upcase "\x3BE;\x3B1;\x3BF;\x3C3;"))
(test "gambit.75" "\x39E;\x391;\x39F;\x3A3;"
(string-upcase "\x3BE;\x3B1;\x3BF;\x3C2;"))
(string-upcase "\x3BE;\x3B1;\x3BF;\x3C2;"))
)
(test "gambit.76" "Knock Knock" (string-titlecase "kNock KNoCK"))
#;(test "gambit.77" "Who's There?" ;; not clear
#;(test "gambit.77" "Who's There?" ;; not clear
(string-titlecase "who's there?") equal?)
(test "gambit.78" "R6Rs" (string-titlecase "r6rs"))
(test "gambit.79" "R6Rs" (string-titlecase "R6RS"))
......@@ -213,13 +213,13 @@
(test "gambit.92" #f (string-ci>? "Z" "z"))
(test "gambit.93" #t (string-ci=? "z" "Z"))
(test "gambit.94" #f (string-ci=? "z" "a"))
#;(test "gambit.95" #t (string-ci=? "Stra\xDF;e" "Strasse")) ;; Not R7
#;(test "gambit.96" #t (string-ci=? "Stra\xDF;e" "STRASSE")) ;; Not R7
#;(test "gambit.97" #t (string-ci=? "\x39E;\x391;\x39F;\x3A3;" ;; Not R7
"\x3BE;\x3B1;\x3BF;\x3C2;"))
#;(test "gambit.95" #t (string-ci=? "Stra\xDF;e" "Strasse")) ;; Not R7
#;(test "gambit.96" #t (string-ci=? "Stra\xDF;e" "STRASSE")) ;; Not R7
#;(test "gambit.97" #t (string-ci=? "\x39E;\x391;\x39F;\x3A3;" ;; Not R7
"\x3BE;\x3B1;\x3BF;\x3C2;"))
(unless *is-C?*
(test "gambit.98" #t (string-ci=? "\x39E;\x391;\x39F;\x3A3;"
"\x3BE;\x3B1;\x3BF;\x3C3;")))
"\x3BE;\x3B1;\x3BF;\x3C3;")))
(test "gambit.99" #t (string-ci<=? "a" "Z"))
(test "gambit.100" #t (string-ci<=? "A" "z"))
......@@ -247,6 +247,16 @@
;;//
(unless *is-C?*
;;---- Test the lambda form with λ symbol
(test "lambda symbol.1"
'(1 2 3)
( (λ l l) 1 2 3))
(test "lambda symbol.2"
'(1 2 3)
( (λ λ λ) 1 2 3)))
;;------------------------------------------------------------------
(test-section-end)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment