Raymond Toy pushed to branch rtoy-unicode-collation-ducet at cmucl / cmucl

Commits:

1 changed file:

Changes:

  • tests/unicode-collation.lisp
    ... ... @@ -26,16 +26,26 @@
    26 26
     (defun collation-hex-list (string)
    
    27 27
       "Parse all space-separated hexadecimal numbers in STRING into a list of
    
    28 28
     integers, in order.  Non-hex runs are skipped."
    
    29
    -  (let ((result nil) (i 0) (n (length string)))
    
    29
    +  (let ((result nil)
    
    30
    +        (i 0)
    
    31
    +        (n (length string)))
    
    30 32
         (loop
    
    31
    -      (loop while (and (< i n) (not (digit-char-p (char string i) 16)))
    
    33
    +      ;; Skip any non-hexadecimal characters.
    
    34
    +      (loop while (and (< i n)
    
    35
    +                       (null (digit-char-p (char string i) 16)))
    
    32 36
                 do (incf i))
    
    33 37
           (when (>= i n) (return))
    
    34
    -      (let ((j i))
    
    35
    -        (loop while (and (< j n) (digit-char-p (char string j) 16))
    
    36
    -              do (incf j))
    
    37
    -        (push (parse-integer string :start i :end j :radix 16) result)
    
    38
    -        (setf i j)))
    
    38
    +      ;; Accumulate one hexadecimal number.  PARSE-INTEGER is avoided
    
    39
    +      ;; here because it conses, and this runs several times per line
    
    40
    +      ;; over hundreds of thousands of conformance lines; the values are
    
    41
    +      ;; 16-bit and fit in a fixnum.
    
    42
    +      (let ((val 0)
    
    43
    +            (d nil))
    
    44
    +        (loop while (and (< i n)
    
    45
    +                         (setf d (digit-char-p (char string i) 16)))
    
    46
    +              do (setf val (+ (* val 16) d))
    
    47
    +                 (incf i))
    
    48
    +        (push val result)))
    
    39 49
         (nreverse result)))
    
    40 50
     
    
    41 51
     (defun collation-split-on-bar (string)
    
    ... ... @@ -133,3 +143,18 @@ must match the expected key in the line's comment."
    133 143
       (:tag :unicode)
    
    134 144
       (run-collation-conformance (ducet) *collation-non-ignorable-test*
    
    135 145
                                  :non-ignorable))
    
    146
    +
    
    147
    +;; A DEFINE-TEST body is stored as source and run interpreted, and the
    
    148
    +;; test runner (tests/run-tests.lisp) loads this file as source, so its
    
    149
    +;; functions would otherwise run interpreted.  The per-line parsing and
    
    150
    +;; string building run on every one of several hundred thousand
    
    151
    +;; conformance lines, so interpreted they make the suite about ten times
    
    152
    +;; slower.  Compile the hot functions on load.
    
    153
    +(eval-when (:load-toplevel :execute)
    
    154
    +  (dolist (name '(collation-hex-list
    
    155
    +                  collation-split-on-bar
    
    156
    +                  collation-parse-expected-key
    
    157
    +                  collation-parse-test-line
    
    158
    +                  collation-test-string
    
    159
    +                  run-collation-conformance))
    
    160
    +    (compile name)))