Changeset 36757 in project


Ignore:
Timestamp:
11/04/18 18:10:04 (10 days ago)
Author:
kooda
Message:

Port the z3 egg to CHICKEN 5

Location:
release/5
Files:
4 added
4 deleted
5 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/5/egg-locations

    r36744 r36757  
    207207(with-current-directory "https://git.foldling.org/chicken-with-current-directory.git/release")
    208208(yasos "http://code.call-cc.org/release-info?egg={egg-name};release={chicken-release}")
     209(z3 "http://code.call-cc.org/release-info?egg={egg-name};release={chicken-release}")
  • release/5/z3/tags/2.0/tests/run.scm

    r35034 r36757  
    1 (use posix z3 testeez utils)
     1(import
     2  z3
     3  test
     4  (chicken file posix)
     5  (chicken io)
     6  (chicken port)
     7  (chicken process)
     8  (chicken string))
    29
    310(system "cp ../BSD-LICENCE .")
    4 (define BSD-LICENCE (read-all "BSD-LICENCE"))
     11(system "cp ../chip.jpg .")
     12(define BSD-LICENCE (with-input-from-file "BSD-LICENCE" read-string))
    513(system* "gzip -c BSD-LICENCE >BSD-LICENCE.gz")
    614
    7 (testeez
    8  "z3"
    915
    10  (test-eval "compressing empty buffer" (z3:encode-buffer ""))
    11  (test-eval "compressing single char buffer" (z3:encode-buffer "0"))
     16(test-assert "compressing empty buffer" (z3:encode-buffer ""))
     17(test-assert "compressing single char buffer" (z3:encode-buffer "0"))
    1218
    13  (test-define "opening file" fd (file-open "BSD-LICENCE.gz" (+ open/trunc open/wronly)))
    14  (test-define "init" z3 (z3:encode-file fd level: 8))
    15  (test-eval "writing" (z3:write-encoded z3 (substring BSD-LICENCE 0 100)))
    16  (test-eval "writing (2)" (z3:write-encoded z3 (substring BSD-LICENCE 100)))
    17  (test-eval "writing (3)" (z3:write-encoded z3 #f))
    18  (test-eval "closing" (file-close fd))
    19  (test/equal "testing result" (system "gunzip -c BSD-LICENCE.gz >tmp && cmp tmp BSD-LICENCE") 0)
     19(define fd)
     20(define z3)
    2021
    21  (test-define "opening file" fd (file-open "BSD-LICENCE.gz" open/read))
    22  (test-define "init" z3 (z3:decode-file fd))
    23  (test/equal "reading" (string=? (let loop ()
    24                          (let ((x (z3:read-decoded z3)))
    25                            (if (eof-object? x)
    26                                ""
    27                                (string-append x (loop)) ) ) )
    28                                  BSD-LICENCE)
    29              #t)
    30  (test-eval "closing file" (file-close fd))
    31  
    32  (test-define "compression destination" dest (open-output-string))
    33  (test-define "definining compression receiver" r (lambda (x) (display x dest)))
    34  (test-define "prepare compression" ze (z3:encode-init))
    35  (test-eval "compressing ..." (let loop ((c BSD-LICENCE))
    36                                 (let ((t (z3:encode ze r c)))
    37                                   (when t
    38                                     (print* ".")
    39                                     (loop (substring c t)) ) ) ) )
    40  (test-define "compressed" compressed (get-output-string dest))
    41  (test-eval "compressed size" (conc (string-length BSD-LICENCE) " -> " (string-length compressed)))
     22(test-assert "opening file" (set! fd (file-open "BSD-LICENCE.gz" (+ open/trunc open/wronly))))
     23(test-assert "init" (set! z3 (z3:encode-file fd level: 8)))
    4224
    43  (test-define "prepare decompression" z (z3:decode-init))
    44  (test-eval "decomp. destination" (set! dest (open-output-string)))
    45  (test-eval "decompressing..." (let loop ((c compressed))
    46                                  (let ((t (z3:decode z r c)))
    47                                    (when t
    48                                      (print* "(" (string-length c) ")")
    49                                      (loop (substring c t)) ) ) ) )
    50  (test/equal "comparing results" (string=? BSD-LICENCE (get-output-string dest)) #t)
     25(test-assert "writing" (z3:write-encoded z3 (substring BSD-LICENCE 0 100)))
     26(test-assert "writing (2)" (z3:write-encoded z3 (substring BSD-LICENCE 100)))
     27(test-assert "writing (3)" (z3:write-encoded z3 #f))
     28(test-assert "closing" (file-close fd))
     29(test "testing result" 0 (system "gunzip -c BSD-LICENCE.gz >tmp && cmp tmp BSD-LICENCE"))
    5130
    52  (test-define "load jpeg" chip (with-input-from-string "chip.jpg" read-string))
    53  (test-define "compressed jpeg" chipc (z3:encode-buffer chip))
    54  (test-define "uncompressed jpeg" chip2 (z3:decode-buffer chipc))
    55  (test/equal "compare uncompressed jpeg to original" (string=? chip chip2) #t)
     31(test-assert "opening file" (set! fd (file-open "BSD-LICENCE.gz" open/read)))
     32(test-assert "init" (set! z3 (z3:decode-file fd)))
    5633
    57 )
     34(test "reading" BSD-LICENCE (let loop ()
     35                              (let ((x (z3:read-decoded z3)))
     36                                (if (eof-object? x)
     37                                    ""
     38                                    (string-append x (loop)) ) ) ))
     39(test-assert "closing file" (file-close fd))
     40
     41(define dest)
     42(define r)
     43(define ze)
     44
     45(test-assert "compression destination" (set! dest (open-output-string)))
     46(test-assert "definining compression receiver" (set! r (lambda (x) (display x dest))))
     47(test-assert "prepare compression" (set! ze (z3:encode-init)))
     48(test-assert "compressing" (let loop ((c BSD-LICENCE))
     49                                 (let ((t (z3:encode ze r c)))
     50                                   (when t
     51                                     (print* ".")
     52                                     (loop (substring c t)) ) ) ) )
     53
     54(define compressed)
     55(test-assert "compressed" (set! compressed (get-output-string dest)))
     56(test-assert "compressed size" (conc (string-length BSD-LICENCE) " -> " (string-length compressed)))
     57
     58(define z)
     59(test-assert "prepare decompression" (set! z (z3:decode-init)))
     60(test-assert "decomp. destination" (set! dest (open-output-string)))
     61(test-assert "decompressing" (let loop ((c compressed))
     62                                  (let ((t (z3:decode z r c)))
     63                                    (when t
     64                                      (print* "(" (string-length c) ")")
     65                                      (loop (substring c t)) ) ) ) )
     66(test "comparing results" BSD-LICENCE (get-output-string dest))
     67
     68(define chip)
     69(define chipc)
     70(define chip2)
     71
     72(test-assert "load jpeg" (set! chip (with-input-from-file "chip.jpg" read-string)))
     73(test-assert "compressed jpeg" (set! chipc (z3:encode-buffer chip)))
     74(test-assert "uncompressed jpeg" (set! chip2 (z3:decode-buffer chipc)))
     75(test "compare uncompressed jpeg to original" chip chip2)
     76
     77(test-exit)
  • release/5/z3/tags/2.0/z3.scm

    r35034 r36757  
    1313          z3:decode-file z3:read-decoded)
    1414
    15 (import scheme)
    16 (import chicken)
    17 (import foreign)
    18 (require-extension data-structures ports posix bind)
     15(import
     16  scheme
     17  (chicken base)
     18  (chicken bitwise)
     19  (chicken blob)
     20  (chicken condition)
     21  (chicken file posix)
     22  (chicken fixnum)
     23  (chicken foreign)
     24  (chicken port)
     25  (chicken time)
     26  bind)
    1927
    2028#>
  • release/5/z3/trunk/tests/run.scm

    r35034 r36757  
    1 (use posix z3 testeez utils)
     1(import
     2  z3
     3  test
     4  (chicken file posix)
     5  (chicken io)
     6  (chicken port)
     7  (chicken process)
     8  (chicken string))
    29
    310(system "cp ../BSD-LICENCE .")
    4 (define BSD-LICENCE (read-all "BSD-LICENCE"))
     11(system "cp ../chip.jpg .")
     12(define BSD-LICENCE (with-input-from-file "BSD-LICENCE" read-string))
    513(system* "gzip -c BSD-LICENCE >BSD-LICENCE.gz")
    614
    7 (testeez
    8  "z3"
    915
    10  (test-eval "compressing empty buffer" (z3:encode-buffer ""))
    11  (test-eval "compressing single char buffer" (z3:encode-buffer "0"))
     16(test-assert "compressing empty buffer" (z3:encode-buffer ""))
     17(test-assert "compressing single char buffer" (z3:encode-buffer "0"))
    1218
    13  (test-define "opening file" fd (file-open "BSD-LICENCE.gz" (+ open/trunc open/wronly)))
    14  (test-define "init" z3 (z3:encode-file fd level: 8))
    15  (test-eval "writing" (z3:write-encoded z3 (substring BSD-LICENCE 0 100)))
    16  (test-eval "writing (2)" (z3:write-encoded z3 (substring BSD-LICENCE 100)))
    17  (test-eval "writing (3)" (z3:write-encoded z3 #f))
    18  (test-eval "closing" (file-close fd))
    19  (test/equal "testing result" (system "gunzip -c BSD-LICENCE.gz >tmp && cmp tmp BSD-LICENCE") 0)
     19(define fd)
     20(define z3)
    2021
    21  (test-define "opening file" fd (file-open "BSD-LICENCE.gz" open/read))
    22  (test-define "init" z3 (z3:decode-file fd))
    23  (test/equal "reading" (string=? (let loop ()
    24                          (let ((x (z3:read-decoded z3)))
    25                            (if (eof-object? x)
    26                                ""
    27                                (string-append x (loop)) ) ) )
    28                                  BSD-LICENCE)
    29              #t)
    30  (test-eval "closing file" (file-close fd))
    31  
    32  (test-define "compression destination" dest (open-output-string))
    33  (test-define "definining compression receiver" r (lambda (x) (display x dest)))
    34  (test-define "prepare compression" ze (z3:encode-init))
    35  (test-eval "compressing ..." (let loop ((c BSD-LICENCE))
    36                                 (let ((t (z3:encode ze r c)))
    37                                   (when t
    38                                     (print* ".")
    39                                     (loop (substring c t)) ) ) ) )
    40  (test-define "compressed" compressed (get-output-string dest))
    41  (test-eval "compressed size" (conc (string-length BSD-LICENCE) " -> " (string-length compressed)))
     22(test-assert "opening file" (set! fd (file-open "BSD-LICENCE.gz" (+ open/trunc open/wronly))))
     23(test-assert "init" (set! z3 (z3:encode-file fd level: 8)))
    4224
    43  (test-define "prepare decompression" z (z3:decode-init))
    44  (test-eval "decomp. destination" (set! dest (open-output-string)))
    45  (test-eval "decompressing..." (let loop ((c compressed))
    46                                  (let ((t (z3:decode z r c)))
    47                                    (when t
    48                                      (print* "(" (string-length c) ")")
    49                                      (loop (substring c t)) ) ) ) )
    50  (test/equal "comparing results" (string=? BSD-LICENCE (get-output-string dest)) #t)
     25(test-assert "writing" (z3:write-encoded z3 (substring BSD-LICENCE 0 100)))
     26(test-assert "writing (2)" (z3:write-encoded z3 (substring BSD-LICENCE 100)))
     27(test-assert "writing (3)" (z3:write-encoded z3 #f))
     28(test-assert "closing" (file-close fd))
     29(test "testing result" 0 (system "gunzip -c BSD-LICENCE.gz >tmp && cmp tmp BSD-LICENCE"))
    5130
    52  (test-define "load jpeg" chip (with-input-from-string "chip.jpg" read-string))
    53  (test-define "compressed jpeg" chipc (z3:encode-buffer chip))
    54  (test-define "uncompressed jpeg" chip2 (z3:decode-buffer chipc))
    55  (test/equal "compare uncompressed jpeg to original" (string=? chip chip2) #t)
     31(test-assert "opening file" (set! fd (file-open "BSD-LICENCE.gz" open/read)))
     32(test-assert "init" (set! z3 (z3:decode-file fd)))
    5633
    57 )
     34(test "reading" BSD-LICENCE (let loop ()
     35                              (let ((x (z3:read-decoded z3)))
     36                                (if (eof-object? x)
     37                                    ""
     38                                    (string-append x (loop)) ) ) ))
     39(test-assert "closing file" (file-close fd))
     40
     41(define dest)
     42(define r)
     43(define ze)
     44
     45(test-assert "compression destination" (set! dest (open-output-string)))
     46(test-assert "definining compression receiver" (set! r (lambda (x) (display x dest))))
     47(test-assert "prepare compression" (set! ze (z3:encode-init)))
     48(test-assert "compressing" (let loop ((c BSD-LICENCE))
     49                                 (let ((t (z3:encode ze r c)))
     50                                   (when t
     51                                     (print* ".")
     52                                     (loop (substring c t)) ) ) ) )
     53
     54(define compressed)
     55(test-assert "compressed" (set! compressed (get-output-string dest)))
     56(test-assert "compressed size" (conc (string-length BSD-LICENCE) " -> " (string-length compressed)))
     57
     58(define z)
     59(test-assert "prepare decompression" (set! z (z3:decode-init)))
     60(test-assert "decomp. destination" (set! dest (open-output-string)))
     61(test-assert "decompressing" (let loop ((c compressed))
     62                                  (let ((t (z3:decode z r c)))
     63                                    (when t
     64                                      (print* "(" (string-length c) ")")
     65                                      (loop (substring c t)) ) ) ) )
     66(test "comparing results" BSD-LICENCE (get-output-string dest))
     67
     68(define chip)
     69(define chipc)
     70(define chip2)
     71
     72(test-assert "load jpeg" (set! chip (with-input-from-file "chip.jpg" read-string)))
     73(test-assert "compressed jpeg" (set! chipc (z3:encode-buffer chip)))
     74(test-assert "uncompressed jpeg" (set! chip2 (z3:decode-buffer chipc)))
     75(test "compare uncompressed jpeg to original" chip chip2)
     76
     77(test-exit)
  • release/5/z3/trunk/z3.scm

    r35034 r36757  
    1313          z3:decode-file z3:read-decoded)
    1414
    15 (import scheme)
    16 (import chicken)
    17 (import foreign)
    18 (require-extension data-structures ports posix bind)
     15(import
     16  scheme
     17  (chicken base)
     18  (chicken bitwise)
     19  (chicken blob)
     20  (chicken condition)
     21  (chicken file posix)
     22  (chicken fixnum)
     23  (chicken foreign)
     24  (chicken port)
     25  (chicken time)
     26  bind)
    1927
    2028#>
Note: See TracChangeset for help on using the changeset viewer.