Gauche:Bugs:log17

Gauche:Bugs:log17

Gauche 0.9.4以前のバグ

Windowsコンソール処理の修正と要望 (0.9.4-rc0)

h(2014/06/22 12:21:27 UTC):以下は Gauche v0.9.4-rc0 でWindowsのコンソール制御のプログラムを作っていて気がついたものです。

(1)sys-read-console-input を呼ぶとエラーになる
→ Scm_WinHandle の第2引数が '#t になっているが '#f が正しそう。

(2)<win:input-record> の key.virtual-key-code が VirtualScanCode を返してくる
→ VirtualKeyCode が device-independent で、
VirtualScanCode が device-dependent とのこと。
key.virtual-scan-code を追加してみた。

(3)画面クリアとキー入力クリア用のAPIが使いたい(要望)
→ sys-fill-console-output-character
sys-fill-console-output-attribute
sys-flush-console-input-buffer
を追加してみた(難しくて自信なし)。

作成した console.stub と windows.scm のパッチは以下です。
https://gist.github.com/Hamayama/5dc4b376103bc6919bfd

作成したコンソール制御のプログラムは以下です。(テストはWindowsコンソールで花火の表示をします)
https://github.com/Hamayama/mscon

確認環境は Windows XP SP3, Windows 8(64bit) です。

sys-get-std-handleの後、標準入出力が使えなくなる on Windows (0.9.4-rc0)

h(2014/06/14 05:00:00 UTC):以下のコードを実行すると、標準入力でエラーが発生します。 

 (use os.windows)
 (sys-get-std-handle STD_INPUT_HANDLE)
 (gc) ; GCが起こるような処理であれば何でもよい
 (read-line)

エラー内容： 

 *** SYSTEM-ERROR: read failed on #<iport (standard input) 00d6ef50>: Bad file descriptor

コードの2行目を、 

 (define stdin-handle (sys-get-std-handle STD_INPUT_HANDLE))

としてハンドルを保持しておくようにすると、エラーは発生しなくなります。

同様の現象は、標準出力や標準エラー出力でも発生します。

環境は、Windows XP SP3, Windows 8(64bit), Gauche v0.9.3.3, Gauche v0.9.4-rc0 です。

サンプルのgears.scmでキー操作後の角度がおかしい on Windows (0.9.3.3)

h(2014/05/26 06:05:08 UTC):インストール時にできたexamplesフォルダのgears.scmを実行すると、歯車の3D表示が出ます。
矢印キーで表示の角度を変えられるのですが、変更後しばらくすると角度がぴょこぴょこと変わる現象が出ます。
gosh を -fno-inline を付けて起動した場合は発生しないようです。
Windows XP SP3 と Windows 8 で確認しました。

h(2014/05/26 10:39:12 UTC):gears.scmを編集して、
206行目に (print #`"rotx ,*view-rotx*") を挿入し、
283行目の (set! *view-rotx* (fmod (+ *view-rotx* 5.0) 360)) (q)) を、
(set! *view-rotx* (fmod (+ *view-rotx* 5.0) 360)) (print #`"rotx ,*view-rotx*") (q)) に変更しました。
これを実行して上を1回だけ押すと、コマンドプロンプト側の表示は以下のようになりました。
見ていると3～4秒に1回くらい角度が変わります。
角度は、gears.scmを実行するたびに変わるようです。 また、上を1回も押さなければ、rotx 20.0 のままで正常です。

 2438 in 5.0 seconds = 487.6 FPS
 rotx 20.0
 rotx 25.0
 2591 in 5.0 seconds = 518.2 FPS
 rotx -703.0
 2659 in 5.0 seconds = 531.8 FPS
 rotx -542.0
 2680 in 5.001 seconds = 535.8928214357128 FPS
 rotx -381.0
 2574 in 5.0 seconds = 514.8 FPS
 rotx -220.0
 2510 in 5.0 seconds = 502.0 FPS
 rotx -619.0
 2485 in 5.001 seconds = 496.90061987602473 FPS
 rotx -458.0

Shiro(2014/05/26 10:49:02 UTC): ますます謎の挙動ですね。*view-rotx*が正規ルート以外で 更新されてる? にしても値が綺麗すぎるような。とりあえず、現在のHEADをインストーラに パッケージしたものを http://practical-scheme.net/vault/Gauche-mingw-0.9.4-rc0.msi に上げたので、良ければこれで試して頂けますか。

h(2014/05/26 13:50:09 UTC):対応ありがとうございます。上記のインストーラで、
Windows XP と Windows 8 の両方で、正常に動作することを確認しました。
(Windows XP のPCは、OS付属の Windows Installer がこわれていたらしく、
インストーラを実行すると「msiexec.exe でハンドルされていない例外が発生しました。」
というようなエラーが出ました。これは、Windows Installer を Microsoftのサイトから取ってきて
入れなおしたところ、インストールできました。
(http://www.microsoft.com/ja-jp/download/details.aspx?id=8483
から WindowsXP-KB942288-v3-x86.exe をダウンロードして実行))

可変長引数の関数が変な引数を受け取る (e6432c02)

(2014/03/16 19:36:09 UTC): 以下のコードで、 call が変な引数を受け取ります 

(let ()
  (define (call object message . args)
    (unless (list? args)
      (error "Strange arguments: "
             `(call (object ,object) (message ,message) (args ,args))))
    (and-let* ((it (object message)))
      (apply it object args)))

  (define (foo)
    (define (bar) (lambda _ (lambda _2 'bar)))

    (define (baz x) (call x 'baz))
    (define (baz2 x) (call x 'baz))

    (define (test x) (baz x))
    (define (test2 x) (baz x))
    (test (bar)))
  (foo))

*** ERROR: Strange arguments:  (call (object #<compiled-code load@0x7f4a7bf041b0>) (message #<closure (call bar)>) (args baz))

matchのelseの中でrxmatch-caseのelseを使うとコンパイルエラーになる (64c98029)

koguro(2013/12/31 12:38:03 UTC): マクロ展開器の既知のバグかもしれませんが、以下のコードでコンパイルエラーになります。 

% gosh
gosh> (use util.match)
#<undef>
gosh> (use gauche.regexp)
#<undef>
gosh> (gauche-version)
"0.9.4_pre3"
gosh>
(match '()
  (('foo)
   0)
  (else
   (rxmatch-case "bbb"
     (#/aaa/ (_)
      1)
     (else
      2
      ;; (begin 2)
      ))))
*** ERROR: Compile Error: malformed #<identifier gauche.regexp#rxmatch-if>: (#<identifier gauche.regexp#rxmatch-if> (#<identifier gauche.regexp#and> #0=#<identifier gauche.regexp#strp> (#<identifier gauche.regexp#rxmatch> else #1=#<identifier gauche.regexp#temp>)) 2 (#<identifier gauche.regexp#begin>) (#<identifier gauche.regexp#rxmatch-case> #t #1# #0#))
"(standard input)":5:(match '() (('foo) 0) (else (rxmatch ...

Stack Trace:
_______________________________________
  0  (eval expr env)
        At line 179 of "/usr/local/share/gauche-0.9/0.9.4_pre3/lib/gauche/interactive.scm"

Shiro(2013/12/31 21:46:38 UTC): なるほどこれはわかりにくい。

たまたま(else 2) だったからsyntax errorになりましたが、 (else (foo bar)) だったとすれば(foo bar)部分がbindingと 解釈されてコンパイルは通り、実行時のエラーになります (rxmatch-ifが regexpを期待してるところに、matchで束縛された値が渡ってくるから)

これはエラーの出し方を何とか頑張るしかないかなあ。今の出力では何が原因だかさっぱりですから。

let-values の動作　

2013/12/23 07:25:27 UTC: 中国人剰余定理を試すための以下のコードでエラーになりました。 SagittariusとNormalでは動作しました。コード、おかしいですか？ sasagawa?

gosh -V Gauche scheme shell, version 0.9.3.3 [utf-8,wthreads], i686-pc-mingw32 

(define (ex-gcd a b)
  (ex-gcd1 a b 1 0 0 1))

(define (ex-gcd1 r0 r1 a0 a1 b0 b1)
  (if (= r1 0)
      (values a0 b0 r0)
      (let* ((q1 (quotient r0 r1))
             (r2 (remainder r0 r1))
             (a2 (- a0 (* q1 a1)))
             (b2 (- b0 (* q1 b1))))
        (ex-gcd1 r1 r2 a1 a2 b1 b2))))

(define (chinese a1 a2 m1 m2)
  (let-values (((y t c)(ex-gcd m1 m2)))
    (unless (= c 1) (error "chinese require coprime numbers"))
    (let ((x (+ a1 (* (- a2 a1) y m1))))
      (if (positive? x)
          x
          (modulo x (* m1 m2))))))

gosh> (chinese 30910 44464 67409 73679)
*** ERROR: unbound variable: t
Stack Trace:
__

(use foo) で強制終了 on Windows (0.9.3.3)

2012/09/29 18:05:37 UTC: windows 用バイナリなんですが、存在しないモジュールを読み込むとエラーが出たあと強制終了します(require も同様)。

h(2013/10/18 17:02:06 UTC):同じ現象が起きています。 Gauche-mingw-0.9.3.3.msiをWindows XP SP3にインストールしています。 コマンドプロンプトで、 

  gosh> (use foo)

を実行すると、 

  *** ERROR: Compile Error: cannot find "foo" in ("C:\\Program Files\\Gauche\\shar
  e\\gauche-0.9\\site\\lib" "C:\\Program Files\\Gauche\\share\\gauche-0.9\\0.9.3.3
  \\lib" "C:\\Program Files\\Gauche\\share\\gauche/site/lib" "C:\\Program Files\\G
  auche\\share\\gauche/0.9/lib")
  "(stdin)":1:(use foo)
  Stack Trace:

と表示した後に、 「gosh.exe [13232] でハンドルされていない Win32 の例外が発生しました。」 というように実行エラーのウィンドウが出ます。

同様に、 

  gosh> (car)

を実行すると、 

  *** ERROR: Compile Error: wrong number of arguments: car requires 1, but got 0
  "(stdin)":2:(car)
  Stack Trace:

と表示した後に、 「gosh.exe [13352] でハンドルされていない Win32 の例外が発生しました。」 というように実行エラーのウィンドウが出ます。

一方、 

  gosh> (x)

では、 

  *** ERROR: unbound variable: x
  Stack Trace:

と表示しますが、実行エラーのウィンドウは出ません。

h(2013/12/13 18:17:23 UTC):現象の発生するPCでコンパイルしたところエラーが出なくなりました。 以下はそのメモです。 

 Windows XP SP3のPCで作業
 
 (1)事前に
    Gauche-mingw-0.9.3.3.msi
    をインストール済み
    (C:\Program Files\Gauche)
 
    Gaucheのショートカットを起動して、
      (use foo) または (car)
    で実行エラーになることを確認
 
 (2)MinGWをインストール
    MinGWのダウンロードページ
    http://sourceforge.net/projects/mingw/files/
    から mingw-get-setup.exe (2013-10-04版) をダウンロードしてきて実行
      Basic Setup で以下を選択
        mingw-developer-toolkit  (v2013072300)
        mingw32-base             (v2013072200)
        mingw32-gcc-g++          (v4.8.1-4)
        msys-base                (v2013072300)
      All Packages で以下を追加選択
        mingw32-libz dev         (v1.2.8-1)
      メニューの Installation - Apply Changes を選択して、
      Applyボタンをクリックしてインストール
 
    システム環境変数PATHを編集し、最後のところに
      ;C:\MinGw\bin;C:\MinGW\msys\1.0\bin
    を追加
 
    C:\MinGW\msys\1.0\msys.batを実行
    すると、以下のフォルダができる
      C:\MinGW\msys\1.0\home\(ユーザ名)
 
    C:\MinGW\msys\1.0\home\(ユーザ名) に
    テキストエディタ(TeraPad)で .bashrc を作成。内容は以下
      alias ls='ls --color=auto --show-control-chars'
 
    C:\MinGW\msys\1.0\home\(ユーザ名) に
    テキストエディタ(TeraPad)で .profile を作成。内容は以下
      source .bashrc
 
    C:\MinGW\msys\1.0\home\(ユーザ名) の
    .inputrc を テキストエディタ(TeraPad)で編集。変更内容は以下
      set output-meta off  →  on
      set convert-meta on  →  off
 
    C:\MinGW\msys\1.0\etc に
    テキストエディタ(TeraPad)で fstab を作成(拡張子なし)。内容は以下
      c:/mingw  /mingw
 
 (3)Gaucheのソースをダウンロード
    http://practical-scheme.net/gauche/download-j.html
    から Gauche-0.9.3.3.tgz をダウンロードしてきて、解凍ソフト(Lhaplus)で、
    c:\Gaucheの下に展開
    c:\Gauche\Gauche-0.9.3.3 ができた。
 
 (4)c:\Gauche\Gauche-0.9.3.3\src\mingw-dist.sh の内容を一部変更
      utf8  →  sjis
 
 (5)c:\Gauche\Gauche-0.9.3.3\ext\net のコンパイルエラー対応
    c:\Gauche\Gauche-0.9.3.3\src\gauche\win-compat.h の
    #include <windows.h> の前に以下の2行を追加
      #include <winsock2.h>
      #define HAVE_STRUCT_SOCKADDR_STORAGE
 
    ( -lws2_32 で winsock2 のライブラリを使う場合、
      windows.h 内で古い winsock.h を読み込んでいるため、
      その前に winsock2.h を読み込む必要があるらしい )
 
 (6)Gaucheをコンパイル
    コマンドプロンプトを開いて以下を実行
      bash
      cd /c/Gauche/Gauche-0.9.3.3/
      src/mingw-dist.sh
 
 (7)テストを実行
    コマンドプロンプトを開いて以下を実行
      bash
      cd /c/Gauche/Gauche-0.9.3.3/
      make check
      (結果をファイルにも残すときは、
         make check 2>&1 | tee test_result.txt
       のようにする)
 
    結果は、
      Total: 12569 tests, 12561 passed,     8 failed,     0 aborted.
    となり、8件失敗しているみたい。。。
      Testing file.util ...                                            failed.
      discrepancies found.  Errors are:
      test touch-file :time :type: expects (60000 50001) => got (4294940896 50001)
      test touch-file :time :type: expects (60000 70000) => got (4294940896 4294950896)
      Testing gettext ...                                              failed.
      discrepancies found.  Errors are:
      test get-en: "Menu|File|Quit": expects "Quit" => got "Menu|File|Quit"
      test gettext-en: "Menu|File|Quit": expects "Quit" => got "Menu|File|Quit"
      test dcgettext-en: "Menu|File|Quit": expects "Quit" => got "Menu|File|Quit"
      test get-en: "Menu|File|Quit": expects "Quit" => got "Menu|File|Quit"
      test gettext-en: "Menu|File|Quit": expects "Quit" => got "Menu|File|Quit"
      test dcgettext-en: "Menu|File|Quit": expects "Quit" => got "Menu|File|Quit"
    とのことだが、よく分からない。。。
 
 (8)生成したファイルをコピー
    生成した
      C:\Gauche\Gauche-mingw-dist\Gauche
    の中身を、すべて
      C:\Program Files\Gauche
    に上書き
 
 (9)起動確認
    Gaucheのショートカットを起動して、
      (use foo) または (car)
    で実行エラーにならないことを確認
 
    また、この環境で、以前の gosh.exe は、
      (use foo) または (car)
    で実行エラーになることを確認
 
 (その他)
   (6)でbashを起動しないと、make等でハングアップした。
      シェルを起動しないといけないことに、なかなか気付けなかった。。。
   (4)でutf-8のままにして、minttyで動かそうとしてみたが、
      インタラクティブモードでバックスペースで削除したりすると、
      入力がおかしくなった。
      Windowsのコンソールプログラムでsjis以外に対応するのは相当難しいのか。。。
      あきらめてsjisにした。。。

h(2014/01/11 11:52:00 UTC):コンパイルすれば正常動作したのでもうよいのですが、 以下は元のgosh.exeのエラーの原因について、気になってもう少し調べたものです。

h(2013/12/18 00:29:28 UTC):gdbを使って、元のgosh.exeでエラーを出させると以下になりました。 

 Program received signal SIGSEGV, Segmentation fault.
 0x77be554a in msvcrt!_abnormal_termination ()
    from C:\WINDOWS\system32\msvcrt.dll

それで、ネット上で調べたところ、以下の情報がありました。 

 (a) http://mingw.5.n7.nabble.com/USE-32BIT-TIME-T-and-legacy-MSVCRT-DLL-td31533.html
 (b) http://mingw.5.n7.nabble.com/quot-msvcrt-abnormal-termination-quot-in-XP-but-not-win7-td29464.html
 (c) http://gcc.1065356.n5.nabble.com/gcc-auto-omit-frame-pointer-vs-msvc-longjmp-td700403.html
 
 (a)は msvcrt.dll にはOSによって非互換性があるという情報です(2013-5-22)。
 (b)は Windows XP で類似のエラーが発生した件の情報です(2012-9-30)。
       setjmp/longjmpの問題ではないかとのことでした。
 (c)は gcc 4.6 で setjmp の呼び出しを修正したという情報です(2011-10-25)。
       古い msvcrt.dll の setjmp には、frame-pointer が必要だが、
       gcc の最適化等により -fomit-frame-pointer オプションがONになって、
       frame-pointer が設定されない場合がある。
       このため、32ビットのsetjmpの場合は、常に frame-pointer を設定するように修正した。
       ということのようです。

実際に gdb で longjmp にブレークポイントを貼って元のgosh.exeを実行すると、
確かに msvcrt!longjmp → msvcrt!_abnormal_termination → エラー(SIGSEGV)
という流れになっていました。(ただし、longjmp 自体は何度も呼ばれていて、 エラーにならないケースも多いようでした。)
また、発生箇所で逆アセンブルすると 0x77be554a <+51>: mov 0x8(%ebp),%ecx
というところでエラーになっており、確かにフレームポインタ ebp の値が不正(0x0)になっているようでした。

以上のことから、今回のエラーは、Windows XP の msvcrt.dll の setjmp/longjmp の内部動作と、
MinGWのgccの出力するコードに起因するものだと思います。
そして、新しいMinGWのgcc(v4.6.2以降?)では修正されているのだと思います。

(#/(a)*\1/ "aa") がマッチしない (6a90c05)

leque(2013/11/08 02:39:47 UTC): 

gosh> (#/(a)*\1/ "aa")
#f

サブマッチがずれているみたいです。 

gosh> (#/(a)*a/ "aaa")
#<<regmatch> 0x10071c420>
gosh> ((#/(a)*a/ "aaa") 1)
"aa" ;; ← "a" のはず

パッチ: https://gist.github.com/leque/7365349

#/(?(cond)ypat)/ の動作 (cc35730)

leque(2013/10/19 10:00:41 UTC): #/(?(cond)ypat)/ は #/(?(cond)ypat|)/ と同じ意味だと思うのですが、そのようになっていません。例えば、 http://www.pcre.org/pcre.txt の "Checking for a used subpattern by number" の例がマッチしません。 

gosh> (#/(\()?[^()]+(?(1)\)|)/ "ab")
#<<regmatch> 0x10071c3f0>
gosh> (#/(\()?[^()]+(?(1)\)|)/ "(ab)")
#<<regmatch> 0x10071c0c0>
gosh> (#/(\()?[^()]+(?(1)\))/ "(ab)")
#<<regmatch> 0x100722ab0>
gosh> (#/(\()?[^()]+(?(1)\))/ "ab") ;; ←これもマッチしてほしい
#f

test/regexp.scm の (test-re #/(?(?<=a)b)/ "ab" '("b")) 等も cl-ppcre 等と食い違っています（ '("") になるはず）。 

* (ql:quickload :cl-ppcre)
* (cl-ppcre:scan-to-strings "(?(?<=a)b)" "ab")

""
#()

パッチ: https://gist.github.com/leque/7053723

http-compose-query のエラーメッセージ

ryoakg(2013/08/22 12:37:11 UTC): 

gosh> (use rfc.http)
#<undef>
gosh> (http-compose-query "abc" '((1 2 3 4)))
*** ERROR: invalid request-uri form: ~s ((1 2 3 4))

http-compose-query の中の query-1 で
errorf じゃなくて error が使われているので、
引数がフォーマットされないで ~s がそのまま出ている様でした。

current-directory と parameterize (e5ce2abb)

leque(2013/02/11 05:25:16 UTC): file.util の current-directory が変更時にもとのディレクトリを返してくれると parameterize できてうれしいと思うのですがどうでしょう？ （Chez Scheme や Racket では current-directory は parameter になっているようです）

現在の動作: 

gosh> (gauche-version)
"0.9.4_pre3"
gosh> (use gauche.parameter)
#<undef>
gosh> (use file.util)
#<undef>
gosh> (current-directory)
"/private/tmp"
gosh> (current-directory "/var")
#<undef>
gosh> (parameterize ((current-directory "/")) (current-directory))
*** ERROR: directory name should be a string #<undef>
Stack Trace:
_______________________________________
  0  (%restore-parameter P S)
        [unknown location]
  1  (^ () (set! L (%restore-parameter P S)))
        [unknown location]
  2  (eval expr env)
        At line 173 of "/usr/local/share/gauche-0.9/0.9.4_pre3/lib/gauche/interactive.scm"

パッチ: 

diff --git a/doc/modgauche.texi b/doc/modgauche.texi
index 2282775..9d23d8e 100644
--- a/doc/modgauche.texi
+++ b/doc/modgauche.texi
@@ -8305,7 +8305,8 @@ netdbインタフェースのScheme APIは必要な箇所ではこれらの関
 A @emph{parameter} is something like a stateful procedure that takes zero or
 one argument.
 If no argument is given, the parameter returns the current value it is keeping.
-If single argument is given, it will be the current value of the parameter.
+If single argument is given, it will be the current value of the parameter,
+and the previous value is returned.
 A parameter has several advantages over global variables to store
 states.
 @c JP
diff --git a/doc/modutil.texi b/doc/modutil.texi
index 2e7c070..a409410 100644
--- a/doc/modutil.texi
+++ b/doc/modutil.texi
@@ -4007,7 +4007,8 @@ Gaucheでは@emph{両方の}名前を提供することにしました。
 @c EN
 When called with no argument, this returns the pathname of the current
 working directory.  When called with a string argument @var{new-directory},
-this sets the current working directory of the process to it.
+this sets the current working directory of the process to it,
+and returns the previous working directory.
 If the process can't change directory to @var{new-directory}, an error is
 signaled.
 
@@ -4016,7 +4017,8 @@ implementations.
 @c JP
 引数無しで呼ばれた場合、カレントディレクトリを返します。
 文字列@var{new-directory}が与えられた場合はプロセスのカレントディレクトリを
-@var{new-directory}に変更します。変更が出来なかった場合はエラーとなります。
+@var{new-directory}に変更し、変更前のカレントディレクトリを返します。
+変更が出来なかった場合はエラーとなります。
 
 この関数はChezSchemeやMzSchemeなどいくつかのScheme処理系に見られます。
 @c COMMON
diff --git a/libsrc/file/util.scm b/libsrc/file/util.scm
index f9a65de..852b16f 100644
--- a/libsrc/file/util.scm
+++ b/libsrc/file/util.scm
@@ -92,7 +92,10 @@
 (define (current-directory :optional (newdir #f))
   (match newdir
     [#f (sys-getcwd)]
-    [(? string?) (sys-chdir newdir)]
+    [(? string?)
+     (begin0
+       (sys-getcwd)
+       (sys-chdir newdir))]
     [_ (error "directory name should be a string" newdir)]))
 
 (define (home-directory :optional (user (sys-getuid)))

hmac-sha512の値 (0.9.3.3)

es (2012/12/04 13:18:57 UTC):

rfc/hmac.scm において (block-size 64) と決め打ちになっているため、 sha512 や sha384 が渡された場合に違う値が返るようです。 (左の二つはブロックサイズが128の模様です。) パッチがなくてすみませんがご報告致します。

(case 1 (() #t) (else #f)) がエラーになる (0.9.3.3)

leque (2012/11/29 04:46:43 UTC): 

gosh> (case 1 (() #t) (else #f))
*** ERROR: Compile Error: syntax-error: bad clause in case: (case 1 (() #t) (else #f))

RnRS 的には case の <clause> は ((<datum1> ...) <expression1> <expression2> ...) なのでエラーにならず #f が返るべきだと思います。

leque(2013/01/01 15:41:54 UTC) こんな感じでしょうか 

diff --git a/src/compile.scm b/src/compile.scm
index 9a7912e..19162b1 100644
--- a/src/compile.scm
+++ b/src/compile.scm
@@ -2088,13 +2088,15 @@
       [((elts exprs ...) . rest)
        (let ([nelts (length elts)]
              [elts  (map unwrap-syntax elts)])
-         (unless (> nelts 0) (error "syntax-error: bad clause in case:" form))
          ($if (car cls)
-              (if (> nelts 1)
-                ($memv #f ($lref tmpvar) ($const elts))
-                (if (symbol? (car elts))
-                  ($eq? #f  ($lref tmpvar) ($const (car elts)))
-                  ($eqv? #f ($lref tmpvar) ($const (car elts)))))
+              (case nelts
+                [(0) ($const-f)]
+                [(1)
+                 (if (symbol? (car elts))
+                     ($eq? #f  ($lref tmpvar) ($const (car elts)))
+                     ($eqv? #f ($lref tmpvar) ($const (car elts))))]
+                [else
+                 ($memv #f ($lref tmpvar) ($const elts))])
               (match exprs
                 ;; (elts => proc) -- SRFI-87 case clause
                 [((? (cut global-eq? <> '=> cenv)) proc)
diff --git a/test/primsyn.scm b/test/primsyn.scm
index 4b40d7e..630486f 100644
--- a/test/primsyn.scm
+++ b/test/primsyn.scm
@@ -43,6 +43,9 @@
 
 (prim-test "case" #t (lambda ()  (case (+ 2 3) ((1 3 5 7 9) #t) ((0 2 4 6 8) #f))))
 (prim-test "case" #t (lambda () (undefined? (case 1 ((2 3) #t)))))
+(prim-test "case" #t (lambda () (case 1 (() #f) ((1) #t))))
+(prim-test "case" #t (lambda () (case 1 (() #f) (else #t))))
+(prim-test "case" #t (lambda () (undefined? (case 1 (() #t)))))
 (prim-test "case (srfi-87)" 0 (lambda () (case (+ 2 3) ((1 3 5) 0) (else => values))))
 (prim-test "case (srfi-87)" 6 (lambda () (case (+ 2 3) ((1 3 5) => (cut + 1 <>)) (else => values))))
 (prim-test "case (srfi-87)" 5 (lambda () (case (+ 2 3) ((2 4 6) 0) (else => values))))

(/ 複素数 0) がエラーになる (58d2d4615)

leque(2012/10/07 07:48:21 UTC): 

gosh> (gauche-version)
"0.9.3.3"
gosh> (/ 1+2i 0)
*** ERROR: Compile Error: real number required, but got 1.0+2.0i
...
gosh> (/ 1+2i 0.0)
*** ERROR: Compile Error: real number required, but got 1.0+2.0i
...

パッチ: 

diff --git a/src/number.c b/src/number.c
index d4d0479..a379303 100644
--- a/src/number.c
+++ b/src/number.c
@@ -2129,7 +2129,8 @@ scm_div(ScmObj arg0, ScmObj arg1, int inexact, int compat, int vmp)
     }
     if (SCM_COMPNUMP(arg0)) {
         if (SCM_INTP(arg1)) {
-            if (SCM_EXACT_ZERO_P(arg1)) goto anormal;
+            // NB: Gauche has no exact compnum
+            if (SCM_EXACT_ZERO_P(arg1)) goto anormal_comp;
             if (SCM_EXACT_ONE_P(arg1)) return arg0;
             return Scm_MakeComplex(SCM_COMPNUM_REAL(arg0)/SCM_INT_VALUE(arg1),
                                    SCM_COMPNUM_IMAG(arg0)/SCM_INT_VALUE(arg1));
@@ -2140,7 +2141,7 @@ scm_div(ScmObj arg0, ScmObj arg1, int inexact, int compat, int vmp)
                                    SCM_COMPNUM_IMAG(arg0)/z);
         }
         if (SCM_FLONUMP(arg1)) {
-            if (SCM_FLONUM_VALUE(arg1) == 0.0) goto anormal;
+            if (SCM_FLONUM_VALUE(arg1) == 0.0) goto anormal_comp;
             return Scm_MakeComplex(SCM_COMPNUM_REAL(arg0)/SCM_FLONUM_VALUE(arg1),
                                    SCM_COMPNUM_IMAG(arg0)/SCM_FLONUM_VALUE(arg1));
         }
@@ -2206,6 +2207,20 @@ scm_div(ScmObj arg0, ScmObj arg1, int inexact, int compat, int vmp)
         if (s < 0)  return SCM_NEGATIVE_INFINITY;
         else        return SCM_POSITIVE_INFINITY;
     }
+  anormal_comp:
+    {
+        double r0 = SCM_COMPNUM_REAL(arg0);
+        double i0 = SCM_COMPNUM_IMAG(arg0);
+        double r =
+            r0 > 0.0 ? SCM_DBL_POSITIVE_INFINITY
+            : r0 < 0.0 ? SCM_DBL_NEGATIVE_INFINITY
+            : SCM_DBL_NAN;
+        double i =
+            i0 > 0.0 ? SCM_DBL_POSITIVE_INFINITY
+            : i0 < 0.0 ? SCM_DBL_NEGATIVE_INFINITY
+            : SCM_DBL_NAN;
+        return Scm_MakeComplex(r, i);
+    }
   do_complex:
     {
         double r1 = SCM_COMPNUM_REAL(arg1);
diff --git a/test/number.scm b/test/number.scm
index bf59d43..defed59 100644
--- a/test/number.scm
+++ b/test/number.scm
@@ -1237,6 +1237,21 @@
 (test* "division by zero" #t (nan? (divide. 0.0 0.0)))
 (test* "division by zero" +inf.0 (divide. 0.5 0))
 
+(test* "division by zero" +inf.0+inf.0i (/ 1+2i 0.0))
+(test* "division by zero" +inf.0-inf.0i (/ 1-2i 0.0))
+(test* "division by zero" -inf.0+inf.0i (/ -1+2i 0.0))
+(test* "division by zero" -inf.0-inf.0i (/ -1-2i 0.0))
+
+(test* "division by zero" #t
+       (let ((r (/ 0+1i 0)))
+         (and (nan? (real-part r))
+              (= (imag-part r) +inf.0))))
+
+(test* "division by zero" #t
+       (let ((r (/ 0+1i 0.0)))
+         (and (nan? (real-part r))
+              (= (imag-part r) +inf.0))))
+
 (define (almost=? x y)
   (define (flonum=? x y)
     (let ((ax (abs x)) (ay (abs y)))

(/ 0) (/ 1 0) 等が +inf.0 になる (58d2d4615)

leque(2012/10/07 07:41:28 UTC): exact な 0 の場合はエラーになってほしいような気がします。 

gosh> (gauche-version)
"0.9.3.3"
gosh> (/ 0)
+inf.0
gosh> (/ 1 0)
+inf.0

パッチ: 

diff --git a/src/number.c b/src/number.c
index dcd7561..d4d0479 100644
--- a/src/number.c
+++ b/src/number.c
@@ -554,6 +554,9 @@ ScmObj Scm_MakeRatnum(ScmObj numer, ScmObj denom)
     if (!SCM_INTEGERP(denom)) {
         Scm_Error("denominator must be an exact integer, but got %S", denom);
     }
+    if (SCM_EXACT_ZERO_P(denom)) {
+        Scm_Error("attempt to calculate a division by zero");
+    }
     r = SCM_NEW(ScmRatnum);
     SCM_SET_CLASS(r, SCM_CLASS_RATIONAL);
     r->numerator = numer;
@@ -572,6 +575,9 @@ ScmObj Scm_MakeRational(ScmObj numer, ScmObj denom)
     if (!SCM_INTEGERP(denom)) {
         Scm_Error("denominator must be an exact integer, but got %S", denom);
     }
+    if (SCM_EXACT_ZERO_P(denom)) {
+        Scm_Error("attempt to calculate a division by zero");
+    }
     if (SCM_EXACT_ONE_P(denom)) return numer;
     if (SCM_EXACT_ZERO_P(numer)) return SCM_MAKE_INT(0);
     else return Scm_ReduceRational(Scm_MakeRatnum(numer, denom));
@@ -2000,7 +2006,10 @@ scm_div(ScmObj arg0, ScmObj arg1, int inexact, int compat, int vmp)
 
     if (SCM_INTP(arg0)) {
         if (SCM_INTP(arg1)) {
-            if (SCM_EXACT_ZERO_P(arg1)) goto anormal;
+            if (SCM_EXACT_ZERO_P(arg1)) {
+                if (inexact) goto anormal;
+                else goto div_by_zero;
+            }
             if (SCM_EXACT_ZERO_P(arg0)) SIMPLE_RETURN(arg0);
             if (SCM_EXACT_ONE_P(arg1))  SIMPLE_RETURN(arg0);
             if (compat) {
@@ -2038,7 +2047,10 @@ scm_div(ScmObj arg0, ScmObj arg1, int inexact, int compat, int vmp)
     }
     if (SCM_BIGNUMP(arg0)) {
         if (SCM_INTP(arg1)) {
-            if (SCM_EXACT_ZERO_P(arg1)) goto anormal;
+            if (SCM_EXACT_ZERO_P(arg1)) {
+                if (inexact) goto anormal;
+                else goto div_by_zero;
+            }
             if (SCM_EXACT_ONE_P(arg1)) SIMPLE_RETURN(arg0);
             goto ratnum_return;
         }
@@ -2061,7 +2073,10 @@ scm_div(ScmObj arg0, ScmObj arg1, int inexact, int compat, int vmp)
     }
     if (SCM_RATNUMP(arg0)) {
         if (SCM_INTP(arg1)) {
-            if (SCM_EXACT_ZERO_P(arg1)) goto anormal;
+            if (SCM_EXACT_ZERO_P(arg1)) {
+                if (inexact) goto anormal;
+                else goto div_by_zero;
+            }
             if (SCM_EXACT_ONE_P(arg1)) SIMPLE_RETURN(arg0);
             arg1 = Scm_Mul(SCM_RATNUM_DENOM(arg0), arg1);
             arg0 = SCM_RATNUM_NUMER(arg0);
@@ -2180,6 +2195,10 @@ scm_div(ScmObj arg0, ScmObj arg1, int inexact, int compat, int vmp)
         if (inexact) return Scm_Inexact(r);
         else return r;
     }
+  div_by_zero:
+    {
+      Scm_Error("attempt to calculate a division by zero");
+    }
   anormal:
     {
         int s = Scm_Sign(arg0);
diff --git a/test/number.scm b/test/number.scm
index bee2157..bf59d43 100644
--- a/test/number.scm
+++ b/test/number.scm
@@ -1211,6 +1211,32 @@
 (test* "exact reciprocal" -5/6 (/ -6/5))
 (test* "exact reciprocal" 7/4692297364841 (/ 4692297364841/7))
 
+;; avoid inlining
+(define (divide . args)
+  (apply / args))
+
+(define (divide. . args)
+  (apply /. args))
+
+(test* "division by zero" (test-error) (divide 0))
+(test* "division by zero" (test-error) (divide 0 0))
+(test* "division by zero" (test-error) (divide 3 0))
+(test* "division by zero" (test-error) (divide 1/2 0))
+(test* "division by zero" +inf.0 (divide 0.0))
+(test* "division by zero" #t (nan? (divide 0.0 0)))
+(test* "division by zero" #t (nan? (divide 0 0.0)))
+(test* "division by zero" #t (nan? (divide 0.0 0.0)))
+(test* "division by zero" +inf.0 (divide 0.5 0))
+
+(test* "division by zero" +inf.0 (divide. 0))
+(test* "division by zero" #t (nan? (divide. 0 0)))
+(test* "division by zero" +inf.0 (divide. 3 0))
+(test* "division by zero" +inf.0 (divide. 1/2 0))
+(test* "division by zero" #t (nan? (divide. 0.0 0)))
+(test* "division by zero" #t (nan? (divide. 0 0.0)))
+(test* "division by zero" #t (nan? (divide. 0.0 0.0)))
+(test* "division by zero" +inf.0 (divide. 0.5 0))
+
 (define (almost=? x y)
   (define (flonum=? x y)
     (let ((ax (abs x)) (ay (abs y)))

(integer? +inf.0) の戻り値 (4a61d3)

leque(2012/07/20 09:57:36 UTC): (integer? +inf.0) と (integer? -inf.0) が #t を返しますが、 R6RS / SRFI-70 的には #f だと思います。 

gosh> (integer? +inf.0)
#t
gosh> (rational? +inf.0)
#f
gosh> (real? +inf.0) 
#t

diff --git a/src/number.c b/src/number.c
index 05f965a..adce258 100644
--- a/src/number.c
+++ b/src/number.c
@@ -1296,6 +1296,7 @@ int Scm_IntegerP(ScmObj obj)
 {
     if (SCM_INTP(obj) || SCM_BIGNUMP(obj)) return TRUE;
     if (SCM_RATNUMP(obj)) return FALSE; /* normalized ratnum never be integer */
+    if (Scm_InfiniteP(obj)) return FALSE;
     if (SCM_FLONUMP(obj)) {
         double d = SCM_FLONUM_VALUE(obj);
         double f, i;
diff --git a/test/number.scm b/test/number.scm
index b5ad471..638d612 100644
--- a/test/number.scm
+++ b/test/number.scm
@@ -584,6 +584,9 @@
 (test* "integer?" #f (integer? 3+4i))
 (test* "integer?" #t (integer? 3+0i))
 (test* "integer?" #f (integer? #f))
+(test* "integer?" #f (integer? +inf.0))
+(test* "integer?" #f (integer? -inf.0))
+(test* "integer?" #f (integer? +nan.0))
 
 (test* "rational?" #t (rational? 0))
 (test* "rational?" #t (rational? 85736847562938475634534245))

SRFI-19 の閏秒テーブルの更新 (0.9.3.3)

leque(2012/07/07 14:28:32 UTC): 2012/07/01 の閏秒の分です 

diff --git a/ext/srfi/srfi-19.scm b/ext/srfi/srfi-19.scm
index cf3a499..9fb36b0 100644
--- a/ext/srfi/srfi-19.scm
+++ b/ext/srfi/srfi-19.scm
@@ -110,7 +110,8 @@
 ;; note they go higher to lower, and end in 1972.
 ;; See srfi-19/read-tai.scm to update this list.
 (define-constant tm:leap-second-table
-  '((1230768000 . 34)
+  '((1341100800 . 35)
+    (1230768000 . 34)
     (1136073600 . 33)
     (915148800 . 32)
     (867715200 . 31)

string-scan-rightの挙動がおかしい (0.9.3.3)

2012/06/27 13:04:32 UTC 

gosh> (string-scan-right "ab" "cd")
-1
gosh> (string-scan-right "abcd" "cd")
-1
gosh> (string-scan-right "cdcd" "cd")
#f

など

match-defineが動かない (~0.9.3.3)

rallentando?2012/06/10 13:40:38 UTC:初めましてですみません、見つけたので。(いつからなのか分かりませんが、少なくとも0.9.1でも動きませんでした。) 

gosh> (use util.match)
#<undef>
gosh> (match-define (x . xs) (list 1 2))
*** ERROR: unbound variable: code
Stack Trace:
_______________________________________
gosh>

のようにmatch-defineが動きませんでした。 ソースを見てみると、 

(define (gendefine pat exp match-expr)
  (let* ((eb-errf (error-maker match-expr))
         (x (bound (validate-pattern pat)))
         (p (car x))
         (bv (cadr x))
         (bindings (caddr x))
         (code (gensym))
         (plist (list (list p code bv #f #f)))
         (x (gensym))
         (m (gen x '() plist (cdr eb-errf) (gensym)))
         (gs (map (lambda (_) (gensym)) bv)))
    (unreachable plist match-expr)
    `(begin ,@(map (lambda (v) `(define ,v #f)) bv)
            ;;ここ
            `(let ((,x ,exp)
                  (,code (lambda ,gs
                           ,@(map (lambda (v g) `(set! ,v ,g)) bv gs)
                           (cond (#f #f))))
                  ,@bindings
                  ,@(car eb-errf))
              ,m))))

`(let ((,x ,exp)... の行頭の準クオート一個はずしたら動きました。

部分継続の動作が怪しい (0.9.3.2)

Shiro(2012/05/26 09:55:25 UTC): lequeさんの指摘: https://twitter.com/dico_leque/status/204755081936125952

『shift/reset プログラミング入門』の A 正規形変換の例が Gauche だと attempt to return from a ghost continuation. で叱られるのはどうしてだろう。 Racket だと動く http://ideone.com/ub0UW

leque (2012/05/29 05:12:15 UTC): 別の例を探してみました。 Typed Printf via Delimited Continuations を Gauche で書いてみると、 

(use gauche.partcont)

(define (sprintf format)
  (reset (format)))

(define (fmt dir)
  (shift k
    (lambda (v)
      (k (dir v)))))

(define s values)

((sprintf (lambda () (string-append "hello, " (fmt s)))) "world")
;; => "hello, world"

は値を返しますが、 

;; "world" を返してほしい
((sprintf (lambda () (fmt s))) "world")
;; -> *** ERROR: attempt to return from a ghost continuation.

はエラーになります。

iota に負数を与えたときの errorf のフォーマットがおかしい (0e669e)

cryks(2012/05/21 13:04:36 UTC): おそらく意図されているのは error だと思います。 

gosh> (iota -1)
*** ERROR: too many arguments for format string: "count must be nonnegative: "

diff --git a/src/liblist.scm b/src/liblist.scm
index 0f470a8..279aba9 100644
--- a/src/liblist.scm
+++ b/src/liblist.scm
@@ -221,7 +221,7 @@
 (define (last lis) (car (last-pair lis))) ;srfi-1
 
 (define (iota count :optional (start 0) (step 1)) ;srfi-1
-  (when (< count 0) (errorf "count must be nonnegative: " count))
+  (when (< count 0) (error "count must be nonnegative: " count))
   (if (and (exact? start) (exact? step))
     (do ([c count (- c 1)]
          [v (+ start (* (- count 1) step)) (- v step)]

every / stream-every の戻り値（0e669e）

leque(2012/05/20 00:40:00 UTC): たぶん 0035eb の変更以降、 every にふたつ以上のリストを渡した場合に、最後の pred の呼び出しの戻り値でなく #t を返すようになっています。 

gosh> (every string->number '("2"))
2
gosh> (every string->number '("2") '(10))
#t

パッチ: https://gist.github.com/2732942

stream-every の場合は、引数に渡したストリームの個数によらず常に真値（として引数のストリームのうち最初に空になったもの）が返ります。 

gosh> (use util.stream)
#<undef>
gosh> (stream-every string->number (list->stream '("2")))
#<promise(stream) 0x10111d9e0 (forced)>
gosh> (stream-every string->number (list->stream '("2")) (list->stream '(10)))
#<promise(stream) 0x10111d520 (forced)>

こちらは特にドキュメントに何も書かれていないのですが、 SRFI 1 と同じ挙動の方がわかりやすいと思います。

パッチ: https://gist.github.com/2733012

MacOSX 10.7.3でfork中にGCが起こると"thread_suspend failed"エラーで止まる [0.9.3.2]

koguro(2012/05/19 10:58:38 UTC): MacOSX 10.7.3で以下のプログラムを実行すると"thread_suspend failed"エラーで止まってしまいます。BoehmGC側の問題かと思いますが、GC_stop_worldでthread_suspendがKERN_SUCCESS以外の値を返した時にアボートするようなコードに変更されていて、ここで引っかかっているんだと思います。 再現プログラムは以下のとおりです。 

;; err.scm
(receive (in out) (sys-pipe)
  (if (= (sys-fork) 0)
      (begin
        (dotimes (i 1000)
          (make-vector 10000))
        (sys-exit 0))
      (sys-wait)))

% gosh err.scm
thread_suspend failed

なお、Linux (Linux ubuntu64 3.0.0-13-generic #22-Ubuntu SMP Wed Nov 2 13:27:26 UTC 2011 x86_64 x86_64 x86_64 GNU/Linux) とFreeBSD (FreeBSD freebsd64.koguro.net 8.1-RELEASE FreeBSD 8.1-RELEASE #0)で試したところ正常に動作しました。

--enable-multibyte=utf8 以外のエンコーディングでconfigureするとドキュメントのビルドに失敗する [0.9.3]

Shiro(2012/05/11 18:10:04 UTC): out-of-tree buildのサポートをした時にエンバグしてました。 コンパイルで引っかかると不便なので、新たなtarballを0.9.3.2としてリリースしました。

ビルド時の問題以外はほぼ変わってないので、utf-8でコンパイルする分には急いでアップデート する必要はありません。

Topics
Sponsored Links
Search
Recent Changes
More ...
Last modified : 2015/06/30 13:22:27 UTC
WiLiKi 0.8.3 running on Gauche 0.9.15-p2