Kazuki Tsujimoto
kazuk****@callc*****
2006年 3月 22日 (水) 01:38:56 JST
辻本です。
gauche.testのtest-moduleを拡張して、トップレベルにバインドされている
クロージャの中から未束縛な変数を参照しているものを洗い出せるようにして
みました。
Index: lib/gauche/test.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/gauche/test.scm,v
retrieving revision 1.15
diff -u -r1.15 test.scm
--- lib/gauche/test.scm 9 Feb 2006 08:52:12 -0000 1.15
+++ lib/gauche/test.scm 21 Mar 2006 16:08:51 -0000
@@ -66,6 +66,7 @@
;;
(define-module gauche.test
+ (use srfi-1)
(export test test* test-start test-end test-section test-module
*test-error* *test-report-error* test-error? prim-test))
(select-module gauche.test)
@@ -131,6 +132,23 @@
;; Toplevel binding sanity check ----------------------------------
+(define (toplevel-closures module)
+ (filter closure?
+ (map (lambda (sym)
+ (with-error-handler (lambda (e) #f)
+ (lambda () (eval sym module))))
+ (hash-table-keys (module-table module)))))
+
+(define (gloc? obj)
+ (eq? (class-of obj) <gloc>))
+
+(define (grefes closure)
+ (filter (lambda (i)
+ (or (identifier? i)
+ (gloc? i)))
+ ((with-module gauche.internal vm-code->list)
+ (closure-code closure))))
+
;; Try to catch careless typos. Suggested by Kimura Fuyuki.
(define (test-module module)
@@ -144,6 +162,7 @@
(format #t "testing bindings in ~a ... " mod) (flush)
(let ((bad-autoload '())
(bad-export '())
+ (bad-gref '())
(report '()))
;; 1. Check if there's no dangling autoloads.
(hash-table-for-each (module-table mod)
@@ -158,6 +177,29 @@
(lambda (e) (push! bad-export sym))
(lambda () (eval sym mod))))
(module-exports mod)))
+ ;; 3. Check if all global references are resolved.
+ (for-each (lambda (closure)
+ (for-each (lambda (gref)
+ (with-error-handler
+ (lambda (e)
+ (push! bad-gref
+ (format #f "~a(~a)"
+ (if (identifier? gref)
+ (ref gref 'name)
+ gref)
+ (ref closure 'info))))
+ ;; also need to apply gloc-ref,
+ ;; but it is hard to compare its return value with #<unbound>.
+ (lambda ()
+ (cond
+ ((identifier? gref)
+ (or ((with-module gauche.internal find-binding)
+ (ref gref 'module) (ref gref 'name) #f)
+ (error "unbound variable: " gref " (" closure ")")))
+ ((gloc? gref)
+ gref)))))
+ (grefes closure)))
+ (toplevel-closures mod))
;; report discrepancies
(unless (null? bad-autoload)
(push! report
@@ -166,6 +208,10 @@
(unless (null? report) (push! report " AND "))
(push! report
(format #f "symbols exported but not defined: ~a" bad-export)))
+ (unless (null? bad-gref)
+ (unless (null? report) (push! report " AND "))
+ (push! report
+ (format #f "unbound variables: ~a" bad-gref)))
(if (null? report)
(format #t "ok\n")
(let ((s (apply string-append report)))
非公開APIのオンパレードになっているのがうれしくないところですが、単純な
typoはかなり楽に検出できるようになると思います。標準添付ライブラリについて
テストしてみたところ、次のものが見つかりました。
Index: ext/srfi/srfi-19-lib.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/ext/srfi/srfi-19-lib.scm,v
retrieving revision 1.4
diff -u -r1.4 srfi-19-lib.scm
--- ext/srfi/srfi-19-lib.scm 28 Oct 2005 02:53:10 -0000 1.4
+++ ext/srfi/srfi-19-lib.scm 21 Mar 2006 16:08:51 -0000
@@ -336,7 +336,7 @@
(define (time-monotonic->time-utc! time-in)
(tm:check-time-type time-in 'time-monotonic 'time-monotonic->time-utc!)
(set-time-type! time-in time-tai)
- (tm:time-tai->time-utc! ntime ntime 'time-monotonic->time-utc))
+ (tm:time-tai->time-utc! time-in time-in 'time-monotonic->time-utc))
(define (time-monotonic->time-tai time-in)
(tm:check-time-type time-in 'time-monotonic 'time-monotonic->time-tai)
@@ -1224,7 +1224,7 @@
(let ( (port (open-input-file filename))
(table '()) )
(let loop ((line (read-line port)))
- (if (not (eq? line eof))
+ (if (not (eof-object? line))
(begin
(let* ( (data (read (open-input-string (string-append "(" line ")"))))
(year (car data))
Index: ext/sxml/sxml/tree-trans.scm.in
===================================================================
RCS file: /cvsroot/gauche/Gauche/ext/sxml/sxml/tree-trans.scm.in,v
retrieving revision 1.1
diff -u -r1.1 tree-trans.scm.in
--- ext/sxml/sxml/tree-trans.scm.in 25 Aug 2005 04:32:54 -0000 1.1
+++ ext/sxml/sxml/tree-trans.scm.in 21 Mar 2006 16:08:51 -0000
@@ -9,6 +9,7 @@
;;;
(define-module sxml.tree-trans
+ (use srfi-11)
(use text.parse)
(use sxml.adaptor)
(export SRV:send-reply
Index: ext/uvector/matrix.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/ext/uvector/matrix.scm,v
retrieving revision 1.3
diff -u -r1.3 matrix.scm
--- ext/uvector/matrix.scm 9 Feb 2006 09:16:39 -0000 1.3
+++ ext/uvector/matrix.scm 21 Mar 2006 16:08:51 -0000
@@ -256,10 +256,10 @@
(eq? class <f64array>)
(eq? class <array>))
(determinant! (copy-object a))
- (let ((rank (s32vector-length (start-vector-of a)))
- (b (tabulate-array (array-shape a)
- (lambda (ind) (array-ref a ind))
- (make-vector rank))))
+ (let* ((rank (s32vector-length (start-vector-of a)))
+ (b (tabulate-array (array-shape a)
+ (lambda (ind) (array-ref a ind))
+ (make-vector rank))))
(determinant! b)))))
Index: lib/gauche/serializer.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/gauche/serializer.scm,v
retrieving revision 1.3
diff -u -r1.3 serializer.scm
--- lib/gauche/serializer.scm 5 Jul 2003 03:29:11 -0000 1.3
+++ lib/gauche/serializer.scm 21 Mar 2006 16:08:51 -0000
@@ -95,7 +95,7 @@
(define (input-serializer? obj)
(and (serializer? obj) (eq? (direction-of obj) :in)))
(define (output-serializer? obj)
- (and (serializer? obj) (eq? (direction-of self) :out)))
+ (and (serializer? obj) (eq? (direction-of obj) :out)))
;; Utility method
Index: libsrc/srfi-13.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/libsrc/srfi-13.scm,v
retrieving revision 1.3
diff -u -r1.3 srfi-13.scm
--- libsrc/srfi-13.scm 10 Feb 2006 22:40:38 -0000 1.3
+++ libsrc/srfi-13.scm 21 Mar 2006 16:08:51 -0000
@@ -960,7 +960,7 @@
(define (string-kmp-partial-search pat rv s i . args)
(let-optionals* args ((c= char=?) (p-start 0) start end)
(let ((patlen (vector-length rv)))
- (let lp ((si s-start)
+ (let lp ((si start)
(vi i))
(cond ((= vi patlen) (- si))
((= si end) vi)
----
Kazuki Tsujimoto