Kouhei Sutou
kou****@cozmi*****
2004年 4月 15日 (木) 01:26:18 JST
須藤です． In <20040****@mbox0*****> "[Anthy-dev 748] Re: uim 0.3.4.2 released" on Thu, 08 Apr 2004 23:02:19 +0900, YamaKen <yamak****@bp*****> wrote: > これを防ぐには、テストを自動化して仕様をテストパターンとして記述 > しておくのが効果的だと思いますが、Schemeで定番のテスト用ツールの > ようなものはあるでしょうか? クレクレ君まる出しですが、良いものを > 知っている方はぜひ教えて下さい。 uim-shellを別プロセスで起動して，他のScheme処理系から uim-shellに対してwrite/readして，その結果をテストしてはどう でしょうか？ サンプルとして，Gaucheでテストが書けるようになるパッチを添付 します(trunk用)． たぶん，以下の様にすればテストが実行できると思います． # テストはGaucheに付いているgauche.testではなく，GaUnitを使っ # ているので実行するまでに少し作業が増えてしまいます． # すいません． % cd /tmp % wget http://www.cozmixng.org/~kou/download/gaunit.tar.gz % cd gaunit-0.0.4 % sudo gosh install/install.scm % cd - % svn co http://freedesktop.org:8080/svn/uim/trunk uim % cd uim % patch -p0 < uim-test.diff % ./autogen.sh % make % gosh test/run-test.scm ちなみに，test/以下はこんな感じになっています． test/run-test.scm - テスト起動スクリプト /test-*.scm - テストが記述されたスクリプト /その他 - テストを記述するための補助スクリプト test/以下のファイルはgosh test/run-test.scmというように，トッ プのディレクトリから起動されることを想定して書かれています． -------------- next part -------------- Index: test/run-test.scm =================================================================== --- test/run-test.scm (revision 0) +++ test/run-test.scm (revision 0) @@ -0,0 +1,19 @@ +#!/usr/bin/env gosh + +(use gauche.interactive) +(use file.util) +(use test.unit) + +(if (symbol-bound? 'main) + (define _main main)) + +(define (main args) + (let ((dir (sys-dirname (car args)))) + (for-each (lambda (test-script) + (load (string-join (list dir test-script) "/"))) + (directory-list dir + :filter (lambda (x) (rxmatch #/^test-/ x))) + ) + (if (symbol-bound? '_main) + (_main `(,(car args) "-vp" ,@(cdr args))) + (run-all-test)))) Property changes on: test/run-test.scm ___________________________________________________________________ Name: svn:executable + * Index: test/uim-test-utils.scm =================================================================== --- test/uim-test-utils.scm (revision 0) +++ test/uim-test-utils.scm (revision 0) @@ -0,0 +1,81 @@ +(use gauche.process) +(use gauche.charconv) +(use test.unit) + +(sys-putenv "LIBUIM_SCM_FILES" "./scm") + +(define (**default-test-suite**) + (with-module test.unit *default-test-suite*)) +(define <test-case> + (with-module test.unit <test-case>)) +(define make-tests + (with-module test.unit make-tests)) +(define add-test-case! + (with-module test.unit add-test-case!)) + +(define *uim-process* #f) +(define (uim sexp) + (write sexp (process-input *uim-process*)) + (flush-all-ports) + (let ((output (process-output *uim-process*)) + (err (wrap-with-input-conversion (process-error *uim-process*) + #f + :buffer-size 0))) + (while (char-ready? err) + (sys-nanosleep 100)) + (read err))) + +(define (uim-bool sexp) + (not (null? (uim sexp)))) + +(define (make-uim-setup-proc . args) + (let-optionals* args ((additional-setup-proc (lambda () #f))) + (lambda () + (set! *uim-process* (run-process "uim/uim-shell" + :input :pipe + :output :pipe + :error :pipe)) + (additional-setup-proc)))) + +(define (make-uim-teadown-proc . args) + (let-optionals* args ((additional-teardown-proc (lambda () #f))) + (lambda () + (close-input-port (process-input *uim-process*)) + (set! *uim-process* #f) + (additional-teardown-proc)))) + +(define-syntax define-uim-test-case + (syntax-rules () + ((_ name) #f) + ((_ name rest ...) + (add-test-case! (**default-test-suite**) + (make-uim-test-case name rest ...))))) + +(define-syntax make-uim-test-case + (syntax-rules (setup teardown) + ((_ name (setup setup-proc) (teardown teardown-proc) test ...) + (make <test-case> + :name name + :setup (make-uim-setup-proc setup-proc) + :teardown (make-uim-teadown-proc teardown-proc) + :tests (make-tests test ...))) + ((_ name (setup proc) test ...) + (make <test-case> + :name name + :setup (make-uim-setup-proc proc) + :teardown (make-uim-teadown-proc) + :tests (make-tests test ...))) + ((_ name (teardown proc) test ...) + (make <test-case> + :name name + :setup (make-uim-setup-proc) + :teardown (make-uim-teadown-proc proc) + :tests (make-tests test ...))) + ((_ name test ...) + (make <test-case> + :name name + :setup (make-uim-setup-proc) + :teardown (make-uim-teadown-proc) + :tests (make-tests test ...))))) + +(provide "test/uim-test-utils") \ No newline at end of file Index: test/test-uim.scm =================================================================== --- test/test-uim.scm (revision 0) +++ test/test-uim.scm (revision 0) @@ -0,0 +1,13 @@ +#!/usr/bin/env gosh + +(use test.unit) + +(require "test/uim-test-utils") + +(define-uim-test-case "test uim" + ("test control-char?" + (assert-true (uim-bool '(control-char? 31))) + (assert-false (uim-bool '(control-char? 33)))) + ("test control-char?" + (assert-true (uim-bool '(control-char? 31))) + (assert-false (uim-bool '(control-char? 33))))) Property changes on: test/test-uim.scm ___________________________________________________________________ Name: svn:executable + * Index: scm/uim-shell.scm =================================================================== --- scm/uim-shell.scm (revision 0) +++ scm/uim-shell.scm (revision 0) @@ -0,0 +1,51 @@ +;;; uim-shell.scm: uim interactive shell for debugging, batch +;;; processing and serving as generic inferior process +;;; +;;; Copyright (c) 2003,2004 uim Project http://uim.freedesktop.org/ +;;; +;;; All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. +;;; 3. Neither the name of authors nor the names of its contributors +;;; may be used to endorse or promote products derived from this software +;;; without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +;;; SUCH DAMAGE. +;;;; + +(define uim-shell-prompt "uim> ") + +(define uim-shell-loop + (lambda () + ;; (puts uim-shell-prompt) + (let* ((expr (read)) + (eof (= (eof-val) expr))) + (if (not eof) + (begin + (print (eval expr)) + (uim-shell-loop)) + #f)))) + +(define uim-shell + (lambda () + (if (*catch + 'all + (uim-shell-loop)) + (uim-shell)))) Index: scm/Makefile.am =================================================================== --- scm/Makefile.am (revision 699) +++ scm/Makefile.am (working copy) @@ -19,4 +19,5 @@ latin.scm \ hk.scm \ zaurus.scm \ - romaja.scm pyunihan.scm pyload.scm m17nlib.scm + romaja.scm pyunihan.scm pyload.scm m17nlib.scm \ + uim-shell.scm Index: uim/uim-shell.c =================================================================== --- uim/uim-shell.c (revision 0) +++ uim/uim-shell.c (revision 0) @@ -0,0 +1,80 @@ +/* + uim-shell.c: uim interactive shell for debugging, batch processing + and serving as generic inferior process + + Copyright (c) 2003,2004 uim Project http://uim.freedesktop.org/ + + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + 3. Neither the name of authors nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + SUCH DAMAGE. + +*/ + +/* + * To compile: + * gcc -Wl,--rpath,$PREFIX/lib -I$PREFIX/include -L$PREFIX/lib -luim -o uim-shell uim-shell.c + * + * Debugging with Emacs: + * (setq scheme-program-name "uim-shell") + * (run-scheme) + */ + +#include <uim/uim.h> + +extern int uim_siod_fatal; + +static void +load_file(char *fn) +{ + long want_init = 0, want_print = 0; + char *ln = alloca(strlen(fn)+40); + sprintf(ln, "(*catch 'errobj (load \"%s\" #f #f))", fn); + uim_repl_c_string(ln, want_init, want_print); +} + +int +main(int argc, char *argv[]) { + /* TODO: forward the args to scheme world as (uim-shell args) */ + + /* TODO: be able to supress ordinary initialization process */ + uim_init(); + + uim_set_verbose_level(1); + load_file("uim-shell.scm"); + /* currently not worked. outermost *catch affects me? */ + if (uim_siod_fatal) + return 1; + + uim_set_verbose_level(5); + uim_repl_c_string("(uim-shell)", 0, 1); + /* currently not worked. outermost *catch affects me? */ + if (uim_siod_fatal) + return 1; + + uim_quit(); + + return 0; +} Index: uim/uim.h =================================================================== --- uim/uim.h (revision 699) +++ uim/uim.h (working copy) @@ -292,6 +292,14 @@ uim_ipc_open_command(int old_pid, FILE **read_handler, FILE **write_handler, char *command); char *uim_symbol_value_str(const char *symbol_str); +long +uim_repl_c_string(char *str, long want_init, long want_print); +long +uim_get_verbose_level(void); +void +uim_set_verbose_level(long new_value); + + /* an uim_code_converter implementation using iconv */ extern struct uim_code_converter *uim_iconv; Index: uim/Makefile.am =================================================================== --- uim/Makefile.am (revision 699) +++ uim/Makefile.am (working copy) @@ -28,10 +28,19 @@ libuim_la_LIBADD = @LIBICONV@ @M17NLIB_LIBS@ -bin_PROGRAMS = uim-helper-server +bin_PROGRAMS = uim-helper-server uim-shell uim_helper_server_LIBS = uim_helper_server_CFLAGS = uim_helper_server_SOURCES = uim-helper.c uim-helper-server.c + +uim_shell_LIBS = + +uim_shell_CFLAGS = + +uim_shell_LDADD = libuim.la @LIBICONV@ + +uim_shell_SOURCES = uim-shell.c + Index: uim/slib.c =================================================================== --- uim/slib.c (revision 699) +++ uim/slib.c (working copy) @@ -2105,30 +2105,30 @@ for (j = 0; j < nheaps; ++j) if (!heaps[j]) { - flag = no_interrupt (1); - if (gc_status_flag && (siod_verbose_level >= 4)) - fprintf (siod_output, "[allocating heap %ld]\n", j); - heaps[j] = (LISP) must_malloc (sizeof (struct obj) * heap_size); - ptr = heaps[j]; - end = heaps[j] + heap_size; - while (1) - { - (*ptr).type = tc_free_cell; - next = ptr + 1; - if (next < end) - { - CDR (ptr) = next; - ptr = next; - } - else - { - CDR (ptr) = freelist; - break; - } - } - freelist = heaps[j]; - flag = no_interrupt (flag); - return (sym_t); + flag = no_interrupt (1); + if (gc_status_flag && (siod_verbose_level >= 4)) + fprintf (siod_output, "[allocating heap %ld]\n", j); + heaps[j] = (LISP) must_malloc (sizeof (struct obj) * heap_size); + ptr = heaps[j]; + end = heaps[j] + heap_size; + while (1) + { + (*ptr).type = tc_free_cell; + next = ptr + 1; + if (next < end) + { + CDR (ptr) = next; + ptr = next; + } + else + { + CDR (ptr) = freelist; + break; + } + } + freelist = heaps[j]; + flag = no_interrupt (flag); + return (sym_t); } return (NIL); } Index: uim/uim.c =================================================================== --- uim/uim.c (revision 699) +++ uim/uim.c (working copy) @@ -593,3 +593,21 @@ siod_quit(); uim_initialized = 0; } + +long +uim_repl_c_string(char *str, long want_init, long want_print) +{ + return repl_c_string(str, want_init, want_print); +} + +long +uim_get_verbose_level(void) +{ + return siod_verbose_level; +} + +void +uim_set_verbose_level(long new_value) +{ + siod_verbose_level = new_value; +}
