Gauche 0.9.4以前のバグ
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) です。
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 です。
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 をダウンロードして実行))
(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))
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): なるほどこれはわかりにくい。
match は else を特別扱いしません。なのでmatchのelse節は
単にフォーム全体を変数elseに束縛する動作になります。
rxmatch-caseはhygienic macroなので、elseが特別な効果を
発揮するのはそれがグローバルな束縛をさしている時だけです。今回、elseは
matchによってローカルに束縛されているので、意味のあるelseとは認識されず、
この節全体が (regexp binding form ...) のパターンに一致するものと
考えてrxmatch-ifの呼び出しへと展開されます。
rxmatch-ifの呼び出しでは、bindingを期待してるところに2が
渡ってくるのでmalformed syntaxエラーになります。
たまたま(else 2) だったからsyntax errorになりましたが、
(else (foo bar)) だったとすれば(foo bar)部分がbindingと
解釈されてコンパイルは通り、実行時のエラーになります (rxmatch-ifが
regexpを期待してるところに、matchで束縛された値が渡ってくるから)
これはエラーの出し方を何とか頑張るしかないかなあ。今の出力では何が原因だかさっぱりですから。
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:
__
gosh> (use srfi-11) #<undef> gosh> #t gosh> (chinese 30910 44464 67409 73679) 123456789 gosh>
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
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 がそのまま出ている様でした。
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)))
with-directoryとか別の名前にしたいところです。
es (2012/12/04 13:18:57 UTC):
rfc/hmac.scm において (block-size 64) と決め打ちになっているため、 sha512 や sha384 が渡された場合に違う値が返るようです。 (左の二つはブロックサイズが128の模様です。) パッチがなくてすみませんがご報告致します。
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))))
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)))
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)))
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))
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)
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
など
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)... の行頭の準クオート一個はずしたら動きました。
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.
はエラーになります。
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)]
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
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)で試したところ正常に動作しました。
diff --git a/gc/configure.ac b/gc/configure.ac index f422e4d..f691f52 100644 --- a/gc/configure.ac +++ b/gc/configure.ac @@ -660,7 +660,7 @@ AC_DEFINE(LARGE_CONFIG) dnl [SK] this may also needed to use sys-fork safely in multithreaded dnl Gauche, but this seems to hang on some platforms. So I don't put dnl it in by default. -dnl AC_DEFINE(HANDLE_FORK) +AC_DEFINE(HANDLE_FORK) AC_SUBST(UNWINDLIBS)
Shiro(2012/05/11 18:10:04 UTC): out-of-tree buildのサポートをした時にエンバグしてました。 コンパイルで引っかかると不便なので、新たなtarballを0.9.3.2としてリリースしました。
ビルド時の問題以外はほぼ変わってないので、utf-8でコンパイルする分には急いでアップデート する必要はありません。