Gauche:Bugs:log13

Gauche:Bugs:log13


http-getでプロキシを使った場合のリクエスト

teppey (2009/11/21 09:01:57 PST): バグと言ってよいものか迷いましたが、0.9直前ということで書いてみます。何か勘違いしていたらすみません。 http-getを以下のように呼ぶと

  1. (http-get "www.google.com" "/index.html" :proxy "proxy.com")
  2. (http-get "www.google.com" "/index.html" :proxy "proxy.com" :host "www.example.com")

このようなリクエストになります。

1 GET http://www.google.com/index.html HTTP/1.1
Host: proxy.com
2 GET http://www.example.com/index.html HTTP/1.1
Host: proxy.com

1のケースでは、Hostヘッダにオリジンサーバ(www.google.com)が入ってほしいです。これは、バーチャルホストでHostヘッダを見ているときに、問題になることがあるからです。
2のケースでは、Hostヘッダが:hostで指定したホスト名で上書きされず、request-uriに含まれています。

これを、このようなリクエストにしたいと思うのですが、どうでしょうか。

1 GET http://www.google.com/index.html HTTP/1.1
Host: www.google.com
2 GET http://www.google.com/index.html HTTP/1.1
Host: www.example.com

パッチです。

Index: lib/rfc/http.scm
===================================================================
--- lib/rfc/http.scm    (revision 6845)
+++ lib/rfc/http.scm    (working copy)
@@ -375,7 +375,7 @@
 ;; canonicalize host and uri w.r.t. proxy
 (define (consider-proxy conn host uri)
   (if (ref conn'proxy)
-    (values (ref conn'proxy) (uri-compose :scheme "http" :host host :path* uri))
+    (values host (uri-compose :scheme "http" :host (ref conn'server) :path* uri))
     (values host uri)))

 ;; send

#\u00800000 を評価するとSegmentation fault(trunk)

teppey (2009/11/19 10:36:52 PST): gdbで見てみると、文字が負数になっているみたいです。

$ gdb -q src/gosh
(gdb) run -ftest
Starting program: /home/teppey/src/Gauche-trunk/src/gosh -ftest
[Thread debugging using libthread_db enabled]
gosh> #\u00800000

Program received signal SIGSEGV, Segmentation fault.
write_ss_rec (obj=0x80000003, port=0x810eee0, ctx=0xbfffeefc) at write.c:454
454                     if (ch <= 0x20)       Scm_PutzUnsafe(char_names[ch], -1, port);
(gdb) print ch
$1 = -8388608

gdbm のテストで失敗する (trunk(r6831))

齊藤 (2009/11/05 06:20:30 PST): msys+Mingw でビルドしたもので gdbm-copy, gdbm-remove がエラーになっているようです。

Testing dbm ===================================================================
testing bindings in #<module dbm> ... ok
testing bindings in #<module dbm.fsdbm> ... ok
<<fsdbm> dataset 1>------------------------------------------------------------
test #<class <fsdbm>> db-exists? (pre), expects #f ==> ok
test #<class <fsdbm>> make, expects #t ==> ok
test #<class <fsdbm>> db-exists? (post), expects #t ==> ok
test #<class <fsdbm>> put!, expects #t ==> ok
test #<class <fsdbm>> get, expects #t ==> ok
test #<class <fsdbm>> get-exceptional, expects #t ==> ok
test #<class <fsdbm>> for-each, expects #t ==> ok
test #<class <fsdbm>> dict-for-each, expects #t ==> ok
test #<class <fsdbm>> dict-map, expects #t ==> ok
test #<class <fsdbm>> dict-keys, expects #t ==> ok
test #<class <fsdbm>> dict-values, expects #t ==> ok
test #<class <fsdbm>> close, expects #t ==> ok
test #<class <fsdbm>> read-only open, expects #t ==> ok
test #<class <fsdbm>> get again, expects #t ==> ok
test #<class <fsdbm>> read-only, expects #t ==> ok
test #<class <fsdbm>> close again, expects #t ==> ok
test #<class <fsdbm>> delete, expects #t ==> ok
test #<class <fsdbm>> close again, expects #t ==> ok
test #<class <fsdbm>> db-copy, expects #t ==> ok
test #<class <fsdbm>> db-remove, expects #t ==> ok
<<fsdbm> dataset 2>------------------------------------------------------------
test #<class <fsdbm>> db-exists? (pre), expects #f ==> ok
test #<class <fsdbm>> make, expects #t ==> ok
test #<class <fsdbm>> db-exists? (post), expects #t ==> ok
test #<class <fsdbm>> put!, expects #t ==> ok
test #<class <fsdbm>> get, expects #t ==> ok
test #<class <fsdbm>> get-exceptional, expects #t ==> ok
test #<class <fsdbm>> for-each, expects #t ==> ok
test #<class <fsdbm>> dict-for-each, expects #t ==> ok
test #<class <fsdbm>> dict-map, expects #t ==> ok
test #<class <fsdbm>> dict-keys, expects #t ==> ok
test #<class <fsdbm>> dict-values, expects #t ==> ok
test #<class <fsdbm>> close, expects #t ==> ok
test #<class <fsdbm>> read-only open, expects #t ==> ok
test #<class <fsdbm>> get again, expects #t ==> ok
test #<class <fsdbm>> read-only, expects #t ==> ok
test #<class <fsdbm>> close again, expects #t ==> ok
test #<class <fsdbm>> delete, expects #t ==> ok
test #<class <fsdbm>> close again, expects #t ==> ok
test #<class <fsdbm>> db-copy, expects #t ==> ok
test #<class <fsdbm>> db-remove, expects #t ==> ok
testing bindings in #<module dbm.gdbm> ... ok
<<gdbm> dataset 1>-------------------------------------------------------------
test #<class <gdbm>> db-exists? (pre), expects #f ==> ok
test #<class <gdbm>> make, expects #t ==> ok
test #<class <gdbm>> db-exists? (post), expects #t ==> ok
test #<class <gdbm>> put!, expects #t ==> ok
test #<class <gdbm>> get, expects #t ==> ok
test #<class <gdbm>> get-exceptional, expects #t ==> ok
test #<class <gdbm>> for-each, expects #t ==> ok
test #<class <gdbm>> dict-for-each, expects #t ==> ok
test #<class <gdbm>> dict-map, expects #t ==> ok
test #<class <gdbm>> dict-keys, expects #t ==> ok
test #<class <gdbm>> dict-values, expects #t ==> ok
test #<class <gdbm>> close, expects #t ==> ok
test #<class <gdbm>> read-only open, expects #t ==> ok
test #<class <gdbm>> get again, expects #t ==> ok
test #<class <gdbm>> read-only, expects #t ==> ok
test #<class <gdbm>> close again, expects #t ==> ok
test #<class <gdbm>> delete, expects #t ==> ok
test #<class <gdbm>> close again, expects #t ==> ok
test #<class <gdbm>> db-copy, expects #t ==> ERROR: GOT #<<system-error> "read failed on #<iport test.dbm 0x10432a0>: Permission denied">
test #<class <gdbm>> db-remove, expects #t ==> ERROR: GOT #f
<<gdbm> dataset 2>-------------------------------------------------------------
test #<class <gdbm>> db-exists? (pre), expects #f ==> ok
test #<class <gdbm>> make, expects #t ==> ok
test #<class <gdbm>> db-exists? (post), expects #t ==> ok
test #<class <gdbm>> put!, expects #t ==> ok
test #<class <gdbm>> get, expects #t ==> ok
test #<class <gdbm>> get-exceptional, expects #t ==> ok
test #<class <gdbm>> for-each, expects #t ==> ok
test #<class <gdbm>> dict-for-each, expects #t ==> ok
test #<class <gdbm>> dict-map, expects #t ==> ok
test #<class <gdbm>> dict-keys, expects #t ==> ok
test #<class <gdbm>> dict-values, expects #t ==> ok
test #<class <gdbm>> close, expects #t ==> ok
test #<class <gdbm>> read-only open, expects #t ==> ok
test #<class <gdbm>> get again, expects #t ==> ok
test #<class <gdbm>> read-only, expects #t ==> ok
test #<class <gdbm>> close again, expects #t ==> ok
test #<class <gdbm>> delete, expects #t ==> ok
test #<class <gdbm>> close again, expects #t ==> ok
test #<class <gdbm>> db-copy, expects #t ==> ERROR: GOT #<<system-error> "read failed on #<iport test.dbm 0x10981c0>: Permission denied">
test #<class <gdbm>> db-remove, expects #t ==> ERROR: GOT #f
failed.
discrepancies found.  Errors are:
test #<class <gdbm>> db-copy: expects #t => got #<<system-error> "read failed on #<iport test.dbm 0x10432a0>: Permission denied">
test #<class <gdbm>> db-remove: expects #t => got #f
test #<class <gdbm>> db-copy: expects #t => got #<<system-error> "read failed on #<iport test.dbm 0x10981c0>: Permission denied">
test #<class <gdbm>> db-remove: expects #t => got #f

dbm.gdbm,ndbm,odbmのテストが行われない(trunk)

kikuchi(2009/11/04 20:06:14 PST): soファイル名が間違っています。

Index: ext/dbm/test.scm
===================================================================
--- ext/dbm/test.scm    (リビジョン 6830)
+++ ext/dbm/test.scm    (作業コピー)
@@ -260,18 +260,18 @@
 ;; GDBM test
 ;;
 
-(test-if-exists "dbm-gdbm" dbm.gdbm <gdbm>)
+(test-if-exists "dbm--gdbm" dbm.gdbm <gdbm>)
 
 ;;
 ;; NDBM test
 ;;
 
-(test-if-exists "dbm-ndbm" dbm.ndbm <ndbm>)
+(test-if-exists "dbm--ndbm" dbm.ndbm <ndbm>)
 
 ;;
 ;; DBM test
 ;;
 
-(test-if-exists "dbm-odbm" dbm.odbm <odbm>)
+(test-if-exists "dbm--odbm" dbm.odbm <odbm>)
 
 (test-end)

gauche-package generate foo で生成される test-foo が間違っている(trunk)

koguro(2009/10/12 07:06:40 PDT): gauche-package generate foo とすると foolib.stub が作られ、

(define-cproc test-foo ()
  (return "test_foo"))

がデフォルト実装で入っていますが、define-cprocのreturnが廃止されたので、これを実行すると segmentation falut で落ちます。あと、結果が単体テストの内容とも異なるみたいなので、デフォルトでは以下のようになるべきでしょうか。

(define-cproc test-foo ()
  (result (SCM_MAKE_STR_IMMUTABLE "foo is working")))

thread-join!のドキュメントのtypo(0.8.14)

teppey(2009/09/17 06:09:01 PDT): 2箇所です。

--- gauche-refj.texi.orig       2009-09-17 21:52:20.000000000 +0900
+++ gauche-refj.texi    2009-09-17 21:54:01.000000000 +0900
@@ -19692,11 +19692,11 @@
 タイムアウトが指定されていない(デフォルト)は@code{#f}です。

 @var{thread}が正常に終了したら、@code{thread-join!}は@var{thread}の
-結果フィールとに格納されている値を返します。
+結果フィールドに格納されている値を返します。
 @var{thread}が異常終了したら、@code{thread-join!}は@var{thread}の結果例外
 フィールドに格納されている例外を投げます。

-タイムアウトに達すると、@var{timeout-val}が与えられていれば@var{thread-join!}を返し、
+タイムアウトに達すると、@var{timeout-val}が与えられていれば@var{timeout-val}を返し、
 与えられていなければ@code{<join-timeout-exception>}を投げます。
 @end defun

src/repl.cのtypo(0.8.14, trunk)

teppey(2009/09/12 10:34:53 PDT): 冒頭のコメント内のコードです。

--- repl.c.orig 2009-09-13 02:14:11.000000000 +0900
+++ repl.c      2009-09-13 02:14:38.000000000 +0900
@@ -48,7 +48,7 @@
  *          (lambda ()
  *            (prompter)
  *            (let loop2 ((exp (reader)))
- *              (if (eof-object? loop2)
+ *              (if (eof-object? exp)
  *                  #f
  *                  (begin
  *                    (call-with-values

浮動小数点数の変換に関しておかしな結果が現れる(0.8.14)

(2009/08/20 20:32:08 PDT)有理数から浮動小数点数への変換が正確でない場合があります。

gosh> (expt 2.0 -1024)
5.562684646268003e-309
gosh> (exact->inexact (expt 2 -1024))
0.0

絶対値最小の非正規化数 2^(-1074)と-2^(-1074)で、 read/write invarianceが成り立ちません。

gosh> (expt 2.0 -1074)
5.0e-324
gosh> 5.0e-324
0.0
gosh> (let1 x (expt 2.0 -1074)
 (= x (string->number (number->string x))))
#f

数の読み込みで落ちる場合があります。

gosh> 4.94065645841246544e-323
5.0e-323
gosh> 4.940656458412465440e-323
"number.c", line 2760 (iexpt10): Assertion failed: e < IEXPT10_TABLESIZ

FFX演算でスタックが破壊される? (0.8.14, trunk / rev.6441以降)

naoya_t(2009/08/05 20:28:41 PDT): 自作関数inverse-erf(浮動小数点演算を含む)を呼び出す前にスタックに積んだ値(下の例では√2)が破壊される

  1. この問題はtrunkでは起こるが0.8.14リリース版では起こらないので、とりあえずバイナリサーチ的に各リビジョンで試して行ったところ6440→6441の間で問題が発生することを突き止めた
  2. FFX (fast flonum extension) が怪しい
  3. #define GAUCHE_FFX 0でビルドすると問題は起きなくなる

再現コード。inverse-erf自体は正しく値を返していることを示すために#?=を入れてあります

(use math.const) ;; pi
(define *epsilon* 1e-12)
 
;;
;; normal quantile function (probit function)
;;
(define (probit p)
  (define (probit>0 p)
    #?=(* #?=(inverse-erf (- (* p 2) 1)) (sqrt 2))) ;; OK
  (if (< p 0)
      (- 1 (probit>0 (- p)))
      (probit>0 p) ))
 
(define (probit p)
  (define (probit>0 p)
    #?=(* (sqrt 2) #?=(inverse-erf (- (* p 2) 1)))) ;; NG
  (if (< p 0)
      (- 1 (probit>0 (- p)))
      (probit>0 p) ))
 
;;
;; inverse error function (erf-1)
;;
(define (inverse-erf z)
  (define (calc-next-ck k c)
    (let loop ((m 0) (sum 0) (ca c) (cz (reverse c)))
      (if (= m k) sum
          (loop (+ m 1)
                (+ sum (/. (* (car ca) (car cz)) (+ m 1) (+ m m 1)))
                (cdr ca) (cdr cz)))))
  (define (calc-cks k)
    (let loop ((i 0) (cks '(1)))
      (if (= i k) cks
          (loop (+ i 1) (cons (calc-next-ck (+ i 1) cks) cks)))))
  (define (calc-ck k) (car (calc-cks k)))
 
  (define (inverse-erf>0 z)
    (let1 r (* pi z z 1/4) ; (πz^2)/4
      (let loop ((k 0) (cks '(1)) (sum 0) (a 1))
        (let1 delta (* a (/ (car cks) (+ k k 1)))
          (if (< delta (* sum *epsilon*))
              (* 1/2 z (sqrt pi) sum)
              (loop (+ k 1)
                    (cons (calc-next-ck (+ k 1) cks) cks)
                    (+ sum delta)
                    (* a r)))))))
 
  (cond [(< z 0) (- (inverse-erf>0 (- z)))]
        [(= z 0) 0]
        [else (inverse-erf>0 z)]) )
 
;;
;; TEST
;;
(use gauche.test)
(test-start "erf")
(test-section "probit function")
(define ~= (lambda (x y) (< (abs (- x y)) 1e-7)))
(test* "probit(0.025)" -1.959964 (probit 0.025) ~=)
(test* "probit(0.975)" 1.959964 (probit 0.975) ~=)
(test-end)

SolarisでSun Cでのビルドに失敗する (0.8.14, trunk)

2009/04/23 13:58:20 PDT: -hは-oのtypoではないでしょうか? ldに-oが渡らず、a.outとして出力されるため、src/makeverslinkが失敗しているようです。これでSPARCではビルドが通るようになるのではないかと思います。(私の使っているx86でも、gc/configureを修正してAO_USE_PTHREAD_DEFSを指定すればビルドは通りましたが、Boehm GCが正規に対応していないので、結局gccを使いました)

Index: configure.ac
===================================================================
--- configure.ac        (revision 6668)
+++ configure.ac        (working copy)
@@ -509,7 +509,7 @@
       SHLIB_SO_LDFLAGS="-shared -o"
     else
       SHLIB_SO_CFLAGS="-Kpic"
-      SHLIB_SO_LDFLAGS="-G -h"
+      SHLIB_SO_LDFLAGS="-G -o"
     fi
     SHLIB_SO_SUFFIX="so"
     SHLIB_MAIN_LDFLAGS=""

<buffered-input-port>のseek操作 (0.8.14, trunk)

shinya(2009/03/21 02:23:53 PDT): seekスロットを設定していない<buffered-input-port>でport-seekを呼ぶと、 #fが返るにも関わらずポインタが移動してしまいます。

gosh> (use gauche.vport)
#<undef>
gosh> (use gauche.uvector)
#<undef>
gosh> (use gauche.sequence)
#<undef>
gosh> (define in
  (let ((index 0))
    (make <buffered-input-port>
      :fill (lambda (buf)
              #?=index
              (for-each-with-index
               (lambda (i _)
                 (u8vector-set! buf i (logand (+ index i) #xFF)))
               buf)
              (let ((size (u8vector-length buf)))
                (inc! index size)
                size))
      )))
in
gosh> (read-byte in)
#?=index
#?-    0
0
gosh> (read-byte in)
1
gosh> (port-seek in 5 SEEK_SET)
#f
gosh> (read-byte in) ; 2が返ることを期待
#?=index
#?-    8192
0

text.gettext のドキュメントの typo (trunk)

tabe(2009/02/07 07:39:17 PST): コメントに含まれている例と同様です。

Index: ext/text/text-gettext-lib.scm                                                                                                                         
===================================================================
--- ext/text/text-gettext-lib.scm   (revision 6544)                                                                                                          
+++ ext/text/text-gettext-lib.scm   (working copy)                                                                                                           
@@ -66,8 +66,8 @@
 ;; build these closures manually for convenience in using multiple                                                                                          
 ;; separate domains or locales at once (useful for server environments):                                                                                    
 ;;                                                                                                                                                          
-;;  (define my-gettext (make-gettex "myapp"))                                                                                                               
-;;  (define (_ (my-gettext 'getter)))                                                                                                                       
+;;  (define my-gettext (make-gettext "myapp"))                                                                                                              
+;;  (define _ (my-gettext 'getter))                                                                                                                         
 ;;  (_ "Hello, World!")                                                                                                                                     
                                                                                                                                                             
 (define-module text.gettext                                                                                                                                 
Index: doc/modutil.texi                                                                                                                                      
===================================================================
--- doc/modutil.texi    (revision 6544)                                                                                                                      
+++ doc/modutil.texi    (working copy)                                                                                                                       
@@ -12621,8 +12621,8 @@
 @c COMMON                                                                                                                                                   
                                                                                                                                                             
 @example                                                                                                                                                    
-(define my-gettext (make-gettex "myapp"))                                                                                                                   
-(define (_ (my-gettext 'getter)))                                                                                                                           
+(define my-gettext (make-gettext "myapp"))                                                                                                                  
+(define _ (my-gettext 'getter))                                                                                                                             
 (_ "Hello, World!")                                                                                                                                         
 @end example                                                                                                                                                
 @end defun

doc/modsrfi.texi の 552 行目

peanutsjamjam(2009/01/21 10:55:20 PST): doc/modsrfi.texi の 552 行目 に 'c' の一文字が足りないようです。"@ EN" -> "@c EN".

sxml/tree-trans で let*-values がマクロ展開されない (0.8.14,trunk)

2009/01/19 16:41:35 PST: 関数呼び出しになってます。

Index: ext/sxml/sxml/tree-trans.scm.in
===================================================================
--- ext/sxml/sxml/tree-trans.scm.in     (revision 6518)
+++ ext/sxml/sxml/tree-trans.scm.in     (working copy)
@@ -9,6 +9,7 @@
 ;;;
 
 (define-module sxml.tree-trans
+  (use srfi-11)
   (use text.parse)
   (use sxml.adaptor)
   (export SRV:send-reply

openSUSE 11 (gcc 4.3.[12]) へのインストール(0.8.14)

osn(2009/01/15 06:10:02 PST): openSUSE 11.0 と 1 (x86_64)にインストールしようとしたところ、vm.c のコンパイルが終了しないようです。最適化オプションをデフォルトの -O2 から -O に変更したところ、コンパイルできて、テストも pass しました。openSUSE 10.3 (gcc 4.1)にはインストールできてましたので、gcc 4.3.[12] で -O2 を使用した場合の問題かと想像しています。

parameterとマルチスレッド (trunk)

Shiro(2008/12/30 04:29:28 PST): lingrのgauche部屋でRuiさんより指摘されたのでこっちにメモ。

現在、スレッドは親スレッドのパラメータのセットを継承するようになってて、 自スレッドが作られた以降にmake-parameterされたものについてはアクセスできない。 スレッドを作る時は必要なライブラリなどは全部useしてるから、 ライブラリ内で使うパラメータについては問題が出ないだろうと思っていたんだが、 autoloadされるライブラリについてはスレッドが作成された後でmake-parameterが 実行される場合がある。そうすると他のスレッドではそのライブラリが正常に 動作しない。

スレッド内で(eval '(use foo) module)されるようなケースも考えると、 autoloadだけの問題というより、パラメータの設計そのものを見直すべきかも。 現在でも各パラメータはプロセス内ユニークなIDを持っていて、 各スレッドはパラメータIDから スレッドローカルはパラメータのストレージ (密なベクタ) へのマップを持っている。 自スレッドでまだアロケートされていないパラメータが使われたら オンデマンドでパラメータストレージを確保するようにすればいけるんじゃないかな。

gauche/threads.hがコピーされない (0.8.14, trunk)

koguro(2008/12/29 20:32:16 PST): Gaucheをmake installしたときにgauche/threads.hがコピーされません。Cからアクセスしたいので、特に問題なければコピーしてもらえるとうれしいです。あと他にもcharconv.hなどext配下のヘッダファイルでコピーされないものがあるようです。

ScmSyntacticClosureの定義にSCM_HEADERがない (0.8.14, trunk)

koguro(2008/12/22 17:39:33 PST): src/gauche/vm.hにあるScmSyntacticClosureの定義ですが、SCM_HEADERが抜けているみたいです(もしかして、ここではなくてもOKとか)。

Cygwin での format (0.8.14)

Pla(2008/12/02 19:38:10 PST): 手元の環境(Cygwin)で、以下がメモリをひたすら消費します。なお、Linuxでは再現しませんでした。

% uname -r
1.5.25(0.156/4/2)
% gosh    
gosh> (gauche-version)
"0.8.14"
gosh> (while #t (format ""))

gauche-package compileの-oオプション (trunk)

kikuchi(2008/11/13 04:08:04 PST): sofileだけでなくobjのファイル名も変更されてしまいます。

Index: lib/gauche/package/compile.scm
===================================================================
--- lib/gauche/package/compile.scm      (revision 6439)
+++ lib/gauche/package/compile.scm      (working copy)
@@ -125,7 +125,7 @@
         (let1 objs (map (lambda (src)
                           (cond
                            ((equal? (path-extension src) OBJEXT) src)
-                           (else (apply gauche-package-compile src args)
+                           (else (apply gauche-package-compile src (delete-keyword :output args))
                                  (sys-basename (path-swap-extension src OBJEXT)))))
                         `(,head.c ,@files ,tail.c))
           (apply gauche-package-link sofile objs args)
More ...