2012-08-26

infoのひと手間

Gauche

Gaucheのreplではinfo手続きを使ってinfoドキュメントを参照することができます。関数の引数を確認したりするのに便利なんですが、知りたい関数の名前を含んだページ全体が表示されるので、ページャをスクロールさせないと見えない場合があります。そこで、~/.gauchercに以下のマクロを追加して、ページャの起動時に検索パターンを渡すようにしてみました。

;; ~/.gaucherc
(use gauche.interactive.info)
(define-macro (info fn)
  (define (%info fn)
    (with-module gauche.interactive.info
      (or (and-let* ([string? *pager*]
                     [orig *pager*]
                     [alt (case (string->symbol (sys-basename *pager*))
                            [(more) (^p (list orig "-p" #`"+/^ --.+: ,p"))]
                            [(less) (^p (list orig "-p" #`"^ --.+: ,p"))]
                            [(lv)   (^p (list orig #`"+/^ --.+: ,p"))]
                            [else #f])])
            (dynamic-wind
              (^[] (set! *pager* (alt (regexp-quote (x->string fn)))))
              (^[] (info fn))
              (^[] (set! *pager* orig)))
            (values))
          (info fn))))
  (let1 fn (if (pair? fn) (cadr fn) fn)
    `(,%info ',fn)))

more・less・lvそれぞれで以下のように動作が微妙に異なるので、場合分けしています。

moreは"-p"オプションが指定されていないと、パイプから読んだ内容にマッチさせた場合1行下にずれる
lessで"+/..."という形式で指定すると"$"を含んだパターンの検索に失敗する

あと、マクロにしているのは、引数のクオートを忘れがちなので、クオートしなくても検索できるようにするためです。
よかったらreplのお供にどうぞ。

2012-07-29

バイナリアンになる

Gauche

スラッシュドットジャパン: Binary Dayに寄せて（2008年11月11日高田浩和） - Binary Day 2008 より。

それでは、最後に、Binary Dayにちなんで、あの名言を引用しておきます。

0101010001101000011001010111001001100101001000000110000101110010
0110010100100000011011110110111001101100011110010010000000110001
0011000000100000011101000111100101110000011001010111001100100000
0110111101100110001000000111000001100101011011110111000001101100
0110010100100000011010010110111000100000011101000110100001100101
0010000001110111011011110111001001101100011001000011101000001010
0101010001101000011011110111001101100101001000000111011101101000
0110111100100000011101010110111001100100011001010111001001110011
0111010001100001011011100110010000100000011000100110100101101110
0110000101110010011110010010000001100001011011100110010000100000
0111010001101000011011110111001101100101001000000111011101101000
0110111100100000011001000110111101101110001001110111010000101110
スラッシュドットジャパン: Binary Dayに寄せて（2008年11月11日高田浩和） - Binary Day 2008

$ cat binary-day.scm
(use rfc.http)
(use gauche.generator)
(receive (_ _ html)
  (http-get "slashdot.jp" "/sp/binary2008/bin2008_takada.shtml")
  (do-generator [m (grxmatch #/[01]{8}/ html)]
    (display (integer->char (string->number (m) 2)))))
$ gosh binary-day.scm
There are only 10 types of people in the world:
Those who understand binary and those who don't.

正規表現がマッチする限り繰り返して何かする場合、今までは明示的にループを書いていたけど、grxmatchは簡潔に書けていいですね。

2011-07-30

unpackと\xNNエスケープシーケンス

Gauche

次のコードは(255)が返ってくると思ったんだけど、(195)が返ってきた。

$ gosh -u binary.pack
gosh> (unpack "C" :from-string "\xff")
(195)
gosh>

文字列をユニフォームベクタに変換してみると、やはり195と191になっている。

gosh> (use gauche.uvector)
#<undef>
gosh> (string->u8vector "\xff")
#u8(195 191)
gosh>

なぜだろう。リーダーが文字列を読んでいるのはsrc/read.cのread_stringだ。

static ScmObj read_string(ScmPort *port, int incompletep,
                      ScmReadContext *ctx)
{
int c = 0;
ScmDString ds;
Scm_DStringInit(&ds);

#define FETCH(var)                                      \
if (incompletep) { var = Scm_GetbUnsafe(port); }    \
else             { var = Scm_GetcUnsafe(port); }
#define ACCUMULATE(var)                                 \
if (incompletep) { SCM_DSTRING_PUTB(&ds, var); }    \
else             { SCM_DSTRING_PUTC(&ds, var); }
#define INTRALINE_WS(var)                               \
((var)==' ' || (var)=='\t' || SCM_CHAR_EXTRA_WHITESPACE_INTRALINE(var))

/* 中略 */
        case 'x': {
            int cc = read_string_xdigits(port, 2, 'x', incompletep);
            ACCUMULATE(cc);
            break;
        }

src/read.c - read_string

read_string_xdigitsで"x"以降の2バイトを16進数として読んでいるから、ccは255となって、それをACCUMULATEマクロに渡している。ここでリーダーが読んでいるのは不完全文字列ではないから、SCM_DSTRING_PUTCが呼ばれる。これはsrc/gauche/string.hで定義されたマクロで、ScmDString(文字列をチャンクのリストとして管理しているデータ構造。たぶん)に文字をひとつ追加する。

#define SCM_DSTRING_PUTC(dstr, ch)                      \
do {                                                \
    ScmChar ch_DSTR = (ch);                         \
    ScmDString *d_DSTR = (dstr);                    \
    int siz_DSTR = SCM_CHAR_NBYTES(ch_DSTR);        \
    if (d_DSTR->current + siz_DSTR > d_DSTR->end)   \
        Scm__DStringRealloc(d_DSTR, siz_DSTR);      \
    SCM_CHAR_PUT(d_DSTR->current, ch_DSTR);         \
    d_DSTR->current += siz_DSTR;                    \
    if (d_DSTR->length >= 0) d_DSTR->length++;      \
} while (0)

src/gauche/string.h - SCM_DSTRING_PUTC

この中で使われているSCM_CHAR_PUTマクロは、コンパイル時に指定した内部エンコーディングがUTF-8ならsrc/gauche/char_utf_8.hに定義されたものが使われる。

#define SCM_CHAR_PUT(cp, ch)                            \
do {                                                \
    if (ch >= 0x80) {                               \
        Scm_CharUtf8Putc((unsigned char*)cp, ch);   \
    } else {                                        \
        *(cp) = (unsigned char)(ch);                \
    }                                               \
} while (0)

src/gauche/char_utf_8.h - SCM_CHAR_PUT

ここでchは255(ff)だから、Scm_CharUtf8Putcが呼ばれる。

void Scm_CharUtf8Putc(unsigned char *cp, ScmChar ch)
{
if (ch < 0x80) {
    *cp = (u_char)ch;
}
else if (ch < 0x800) {
    *cp++ = (u_char)((ch>>6)&0x1f) | 0xc0;
    *cp = (u_char)(ch&0x3f) | 0x80;
}
else if (ch < 0x10000) {

src/gauche/char_utf_8.h - Scm_CharUtf8Putc

0x80 < ch < 0x800だから2番目の条件式が成立して、chは2バイトを使ってUTF-8 エンコードされる。UTF-8 - Wikipediaによると、2バイトでエンコードする場合は、1バイト目の上位3ビットと2バイト目の上位2ビットがフラグとして使われて、残りの11ビットにchのビットパターンが右詰めでセットされる。上記のコードはそれをやっていて、その結果エンコードされた2バイトのビットパターンは

11000011 10111111

となり、これを10進数で表せば

gosh> #b11000011
195
gosh> #b10111111
191

だから、冒頭のコードは"\xff"をUTF-8 エンコードした結果の1バイト目を返していたということだった。

ここまで書いて気づいたけど、リファレンスにちゃんと書いてあったorz

\xNN

2桁の16進数NNで指定されるバイト。このバイトは内部エンコーディングによって解釈されます。

Gauche ユーザリファレンス: 6.11 文字列

2011-07-22

[Gauche] rfc.pop

GaucheでSMTPを扱うコードは見かけるんですが(Gauche:メール, GaucheでSMTPクライアントを書いてみる(1))、POP3は見たことがなかったので、クライアントライブラリを書きました。多くの手続きはRFC1939の各コマンドに一対一で対応したものですが、call-with-pop3-connectionのようにやや高水準の手続きもあります。

(use rfc.822)
(use rfc.mime)
(use rfc.pop)

;; 各メールのSubjectを表示
(call-with-pop3-connection "pop.example.com"
  (lambda (conn)
    (for-each (lambda (msgnum)
                (let* ([str (pop3-top conn msgnum 0)]
                       [hdrs (call-with-input-string str rfc822-read-headers)])
                  (if-let1 subject (rfc822-header-ref hdrs "subject")
                    (format #t "~d: ~a\n" msgnum (mime-decode-text subject))
                    (format #t "(no subject)\n"))))
              (map car (pop3-list conn))))
  :username "your_username"
  :password "your_password")

残念ながらPOP over SSLには対応していないので、SSLを使うにはstunnelなどのトンネリングツールを使います。以下はちょっと長いですが、スクリプト内からstunnel4を使う例です。信用できる証明書が/etc/ssl/certsにあると仮定しています。

(use file.util)
(use gauche.process :only (run-process))
(use rfc.pop :only (call-with-pop3-connection))
(use srfi-27)

(define (main args)
  (unless (= (length args) 3)
    (format #t "Usage: gosh ~a host port\n" *program-name*)
    (exit 1))
  (let ([host (cadr args)]
        [port (caddr args)])
    (call-with-ssl-connection (string-append host ":" port)
     (lambda (port)
       (call-with-pop3-connection #`"localhost:,port"
         (lambda (conn)
          ;; POP3サーバ接続時のメッセージを表示
           (print (~ conn'greeting))))))))

(define (call-with-ssl-connection host:port proc)
  (define (write-config remote local)
    (current-directory (temporary-directory))
    (receive (out path) (sys-mkstemp "myssl-")
      (let1 pid-path (build-path (temporary-directory) #`",|path|.pid")
        (for-each (^s (display s out) (newline out))
                  (list #`"pid = ,pid-path"
                        "foreground = no"
                        "client = yes"
                        "[pop_over_ssl]"
                        "verify = 2"
                        "CApath = /etc/ssl/certs"
                        #`"connect = ,remote"
                        #`"accept = ,local"))
        (close-output-port out)
        (values path pid-path))))
  (define (cleanup config-path pid-path)
    (sys-kill (string->number (car (file->string-list pid-path))) SIGTERM)
    (remove-files (list config-path pid-path)))

  (let1 local-port (begin (random-source-randomize! default-random-source)
                          (+ 10000 (random-integer 1000)))
    (or (and-let* ([stunnel4 (find-file-in-paths "stunnel4")])
          (receive (config-path pid-path)
            (write-config host:port local-port)
            (if (zero? (sys-fork))
              (run-process `(,stunnel4 ,config-path) :fork #f)
              (dynamic-wind
                (lambda ()
                  (define (try count)
                    (cond [(file-exists? pid-path)]
                          [(> count 10) (error "something wrong")]
                          [else (sys-sleep 1) (try (+ count 1))]))
                  (try 0))
                (lambda () (proc local-port))
                (lambda () (cleanup config-path pid-path))))))
        (error "command not found: stunnel4"))))

インストール

Gauche 0.9.1以降で動きます。

# gauche-package install http://github.com/downloads/teppey/Gauche-rfc-pop/Gauche-rfc-pop-0.1.tgz

もしくは git cloneしてください。

# git clone git://github.com/teppey/Gauche-rfc-pop.git
# cd Gauche-rfc-pop
# ./DIST gen
# ./configure
# make
# make -s check
# make install

現在ではIMAPやWebメールが一般的となりましたが、YahooメールやGmailでもPOP3サーバへのアクセスを提供していますし、もうしばらくはPOP3 プロトコルの出番がありそうです。

2011-06-25

text.json 0.2

Gauche

text.json 0.2をリリースします。もともとrfc.jsonが標準ライブラリに入るまでのつなぎのつもりでしたが、マッピングを変更できたらうれしいかも、と魔が差してもう少し書いてみることにしました。インストール方法やアーカイブはこちら:

Gauche-text-json @ Github

※ Gauche 0.9.1よりJSONのパーズ／構築を行うrfc.jsonが標準で提供されています。したがって、通常このモジュールをインストールする必要はありません。rfc.jsonで今のところ提供されていない機能(マッピングのカスタマイズ・Pretty-Print)が使いたいという場合、このモジュールが役に立つかもしれません。

マッピングのカスタマイズ

json-readではオブジェクトと配列をそれぞれ連想リストとベクタにマッピングしていましたが、パラメータを使ってこのマッピングを変更できるようになりました。

(use gauche.parameter)

(define text "{\"foo\": 1, \"bar\": [2, 3]}")

;; デフォルトでオブジェクトは連想リストに、配列はベクタにマッピングされる
(let1 alist (json-read text)
  (write alist)                      ; => (("foo" . 1) ("bar" . #(2 3)))
  (print (cdr (assoc "foo" alist)))  ; => 1
  (print (cdr (assoc "bar" alist)))  ; => #(2 3)
 )

;; ハッシュテーブルとリストに変更
(parameterize ((json-object-fn (cut make-hash-table 'string=?))
               (json-array-fn (cut values <list> #f)))
  (let1 ht (json-read text)
    (write ht)                         ; => #<hash-table string=? 0x1900280>
    (newline)
    (print (hash-table-get ht "foo"))  ; => 1
    (print (hash-table-get ht "bar"))  ; => (2 3)
   ))

読み込み時のマッピングは json-object-fn, json-array-fn パラメータに引数を取らない手続きを与えることで変更できます。

一方SchemeオブジェクトをJSONへ書き出す場合、(is-a? obj )が真となるobjはオブジェクトに、
(is-a? obj )が真となるオブジェクトは配列と見なされます。しかし、いくつかの例外があります。

文字列()はのサブクラスですが、(JSONの)文字列となります。
リスト()ものサブクラスですが、デフォルトでは連想リストと見なされ、オブジェクトとして書き出されます。この挙動はlist-as-json-arrayパラメータに真の値を与えることで変更することができます。

詳しくはREADMEを見てみてください。

Pretty Print

新しい手続きjson-write*を追加しました。json-writeと同様にSchemeオブジェクトをJSONとして出力しますが、出力にはインデントと改行が補われます。インデントに使用される文字列はjson-indent-stringパラメータで変更可能です。

gosh> (define obj '(("foo" . 1) ("bar" . #(2 3))))
obj
gosh> (use text.json)
#<undef>
gosh> (json-write obj)
{"foo":1,"bar":[2,3]}#<undef>
gosh> (json-write* obj)
{
  "foo": 1,
  "bar": [
    2,
    3
  ]
}#<undef>
gosh> (use gauche.parameter)
#<undef>
gosh> (parameterize ((json-indent-string "-->")) (json-write* obj))
{
-->"foo": 1,
-->"bar": [
-->-->2,
-->-->3
-->]
}#<undef>

というわけで、気が向いたら使ってみてください！

2011-05-27

Gaucheのリファレンスを検索するlocal CGI

Gauche w3m

w3mからローカルのGauche リファレンスマニュアルを検索するlocal CGIです。REPLから使えるinfoやaproposで十分なことも多いですが、w3mも一緒に使うことが多いので書いてみました。Gauche 0.9.1以降が必要です。

インストール

w3m-gref-0.1.tar.gzをダウンロードして展開します。

$ curl -L http://github.com/downloads/teppey/w3m-gref/w3m-gref-0.1.tgz | tar xzf -
$ cd w3m-gref-0.1
$ ls
MIT-LICENSE.txt  README  setup.scm  w3m-gref.cgi

もしくはgithubからcloneしてください。

$ git clone git://github.com/teppey/w3m-gref.git
$ cd w3m-gref

次にデータベースを作成します。setup.scmにリファレンスマニュアルのアーカイブのURLを渡すと、ダウンロード・展開したのち、それを元に$HOME/.w3m-gref/内へデータベースを作成します。すでにリファレンスマニュアルのアーカイブやそれを展開したディレクトリを持っている場合、setup.scmにそれらを指定することもできます。

$ gosh setup.scm http://practical-scheme.net/gauche/vault/gauche-refj.tgz
$ cp w3m-gref.cgi $HOME/.w3m/cgi-bin
$ chmod +x $HOME/.w3m/cgi-bin/w3m-gref.cgi
$ echo "gref: file:/cgi-bin/w3m-gref.cgi?%s" >> $HOME/.w3m/urimethodmap

w3m-gref.cgiをコピーして、urimethodmapにエントリを追加すれば完了です。
ちなみに"gref:"というprefixは好みのものに変更してもらって構いません。

使い方

gref:<トピック>で検索します。<トピック>には手続き名・モジュール名・リファレンスのセクション名などが指定できます。結果が一意に決まる場合は該当するページを表示し、複数の検索結果があった場合はそれらがリスト表示されます。

gref:/<パターン> あるいは gref:<パターン>/とすると、<パターン>を正規表現と見なして検索します(前後を'/'ではさんでもOK)。

末尾の'/'の後に'i'が与えられると大文字小文字を区別せずに検索します。

'/'で終わるパターンは、末尾の'/'をバックスラッシュでエスケープしてください。
gref:call/

gref:call\//

よかったら使ってみてください。おかしなところを見つけたら、コメントやTwitterで教えてもらえるとありがたいです。

2011-05-17

相対URIを絶対URIにする

Gauche

Gaucheのrfc.uriには"Relative -> Absolute"というコメントが入っていますが、まだ実装されていないので書いてみました。

参考: RFC3986, RFC3986 日本語訳

(use rfc.uri)
(use srfi-11)
(use srfi-13)

(define (uri-relative->absolute rel-uri base-uri)
  (define (split uri)
    (receive (scheme specific)
      (uri-scheme&specific uri)
      (receive (authority path query fragment)
        (uri-decompose-hierarchical specific)
        (values scheme authority path query fragment))))

  ; RFC3986, Section 5.2.3
  (define (merge base-path rel-path base-authority)
    (if (and base-authority (not base-path))
      (string-append "/" rel-path)
      (if-let1 m (#/^(.*)\/[^\/]*$/ base-path)
        (string-append (m 1) "/" rel-path)
        rel-path)))

  ; RFC3986, Section 5.2.4
  (define (remove-dot-segments path)
    (let loop ((input path) (output '()))
      (cond ((not input)
             (string-join (reverse! output) ""))
            ; RFC3986, Section 5.2.4, 2A
            ((#/^\.{1,2}\/(.*)$/ input)
             => (^m (loop (m 1) output)))
            ; RFC3986, Section 5.2.4, 2B
            ((#/^(?:\/\.\/(.*)|\/\.)$/ input)
             => (^m (loop (string-append "/" (or (m 1) "")) output)))
            ; RFC3986, Section 5.2.4, 2C
            ((#/^(?:\/\.\.\/(.*)|\/\.\.)$/ input)
             => (^m (loop (string-append "/" (or (m 1) ""))
                          (if (not (null? output)) (cdr output) output))))
            ; RFC3986, Section 5.2.4, 2D
            ((#/^\.{1,2}$/ input)
             (loop #f output))
            ; RFC3986, Section 5.2.4, 2E
            ((#/^(\/?[^\/]+)(\/.*)?$/ input)
             => (^m (loop (m 2) (cons (m 1) output))))
            (else
              (loop #f (cons input output))))))

  ; RFC3986, Section 5.3
  (define (recompose scheme authority path query fragment)
    (with-output-to-string
      (lambda ()
        (when scheme    (display scheme) (display ":"))
        (when authority (display "//") (display authority))
        (display path)
        (when query     (display "?") (display query))
        (when fragment  (display "#") (display fragment)))))

  (let-values ([(r.scheme r.authority r.path r.query r.fragment) (split rel-uri)]
               [(b.scheme b.authority b.path b.query b.fragment) (split base-uri)])
    (let ([t.scheme #f] [t.authority #f] [t.path #f] [t.query #f] [t.fragment #f])
      ; RFC3986, Section 5.2.2
      (cond
        (r.scheme
         (set! t.scheme r.scheme)
         (set! t.authority r.authority)
         (set! t.path (remove-dot-segments r.path))
         (set! t.query r.query))
        (else
          (cond
            (r.authority
             (set! t.authority r.authority)
             (set! t.path (remove-dot-segments r.path))
             (set! t.query r.query))
            (else
              (cond
                ((not r.path)
                 ; lemniscusさんのコメントでの指摘を受けて、空文字列を返すように修正
                 (set! t.path (or b.path ""))
                 (if r.query
                   (set! t.query r.query)
                   (set! t.query b.query)))
                (else
                  (cond
                    ((string-prefix? "/" r.path)
                     (set! t.path (remove-dot-segments r.path)))
                    (else
                      (set! t.path (merge b.path r.path b.authority))
                      (set! t.path (remove-dot-segments t.path))))
                  (set! t.query r.query)))
              (set! t.authority b.authority)))
          (set! t.scheme b.scheme)))
      (set! t.fragment r.fragment)
      (recompose t.scheme t.authority t.path t.query t.fragment))))


;; ---------------------------------------------------------
;; Test cases from RFC3986 Section 5.4
;;
(use gauche.test)
(define (test-relative-uri-resolution resolver)
  (define base "http://a/b/c/d;p?q")
  (test-start "Relative URI resolution")
  (test-section "Normal")
  (test* "\"g:h\" -> \"g:h\"" "g:h" (resolver "g:h" base))
  (test* "\"g\" -> \"http://a/b/c/g\"" "http://a/b/c/g" (resolver "g" base))
  (test* "\"./g\" -> \"http://a/b/c/g\"" "http://a/b/c/g" (resolver "./g" base))
  (test* "\"g/\" -> \"http://a/b/c/g/\"" "http://a/b/c/g/" (resolver "g/" base))
  (test* "\"/g\" -> \"http://a/g\"" "http://a/g" (resolver "/g" base))
  (test* "\"//g\" -> \"http://g\"" "http://g" (resolver "//g" base))
  (test* "\"?y\" -> \"http://a/b/c/d;p?y\"" "http://a/b/c/d;p?y" (resolver "?y" base))
  (test* "\"g?y\" -> \"http://a/b/c/g?y\"" "http://a/b/c/g?y" (resolver "g?y" base))
  (test* "\"#s\" -> \"http://a/b/c/d;p?q#s\"" "http://a/b/c/d;p?q#s" (resolver "#s" base))
  (test* "\"g#s\" -> \"http://a/b/c/g#s\"" "http://a/b/c/g#s" (resolver "g#s" base))
  (test* "\"g?y#s\" -> \"http://a/b/c/g?y#s\"" "http://a/b/c/g?y#s" (resolver "g?y#s" base))
  (test* "\";x\" -> \"http://a/b/c/;x\"" "http://a/b/c/;x" (resolver ";x" base))
  (test* "\"g;x\" -> \"http://a/b/c/g;x\"" "http://a/b/c/g;x" (resolver "g;x" base))
  (test* "\"g;x?y#s\" -> \"http://a/b/c/g;x?y#s\"" "http://a/b/c/g;x?y#s" (resolver "g;x?y#s" base))
  (test* "\"\" -> \"http://a/b/c/d;p?q\"" "http://a/b/c/d;p?q" (resolver "" base))
  (test* "\".\" -> \"http://a/b/c/\"" "http://a/b/c/" (resolver "." base))
  (test* "\"./\" -> \"http://a/b/c/\"" "http://a/b/c/" (resolver "./" base))
  (test* "\"..\" -> \"http://a/b/\"" "http://a/b/" (resolver ".." base))
  (test* "\"../\" -> \"http://a/b/\"" "http://a/b/" (resolver "../" base))
  (test* "\"../g\" -> \"http://a/b/g\"" "http://a/b/g" (resolver "../g" base))
  (test* "\"../..\" -> \"http://a/\"" "http://a/" (resolver "../.." base))
  (test* "\"../../\" -> \"http://a/\"" "http://a/" (resolver "../../" base))
  (test* "\"../../g\" -> \"http://a/g\"" "http://a/g" (resolver "../../g" base))
  (test-section "Abnormal")
  (test* "\"../../../g\" -> \"http://a/g\"" "http://a/g" (resolver "../../../g" base))
  (test* "\"../../../../g\" -> \"http://a/g\"" "http://a/g" (resolver "../../../../g" base))
  (test* "\"/./g\" -> \"http://a/g\"" "http://a/g" (resolver "/./g" base))
  (test* "\"/../g\" -> \"http://a/g\"" "http://a/g" (resolver "/../g" base))
  (test* "\"g.\" -> \"http://a/b/c/g.\"" "http://a/b/c/g." (resolver "g." base))
  (test* "\".g\" -> \"http://a/b/c/.g\"" "http://a/b/c/.g" (resolver ".g" base))
  (test* "\"g..\" -> \"http://a/b/c/g..\"" "http://a/b/c/g.." (resolver "g.." base))
  (test* "\"..g\" -> \"http://a/b/c/..g\"" "http://a/b/c/..g" (resolver "..g" base))
  (test* "\"./../g\" -> \"http://a/b/g\"" "http://a/b/g" (resolver "./../g" base))
  (test* "\"./g/.\" -> \"http://a/b/c/g/\"" "http://a/b/c/g/" (resolver "./g/." base))
  (test* "\"g/./h\" -> \"http://a/b/c/g/h\"" "http://a/b/c/g/h" (resolver "g/./h" base))
  (test* "\"g/../h\" -> \"http://a/b/c/h\"" "http://a/b/c/h" (resolver "g/../h" base))
  (test* "\"g;x=1/./y\" -> \"http://a/b/c/g;x=1/y\"" "http://a/b/c/g;x=1/y" (resolver "g;x=1/./y" base))
  (test* "\"g;x=1/../y\" -> \"http://a/b/c/y\"" "http://a/b/c/y" (resolver "g;x=1/../y" base))
  (test* "\"g?y/./x\" -> \"http://a/b/c/g?y/./x\"" "http://a/b/c/g?y/./x" (resolver "g?y/./x" base))
  (test* "\"g?y/../x\" -> \"http://a/b/c/g?y/../x\"" "http://a/b/c/g?y/../x" (resolver "g?y/../x" base))
  (test* "\"g#s/./x\" -> \"http://a/b/c/g#s/./x\"" "http://a/b/c/g#s/./x" (resolver "g#s/./x" base))
  (test* "\"g#s/../x\" -> \"http://a/b/c/g#s/../x\"" "http://a/b/c/g#s/../x" (resolver "g#s/../x" base))
  (test* "\"http:g\" -> \"http:g (for strict persers)\"" "http:g" (resolver "http:g" base))
  ;(test* "\"http:g\" -> \"http:g (for backward compatibility)\"" "http://a/b/c/g" (resolver "http:g" base))
  (test-section "Other")
  (test* "empty path" "http://aaa.bbb.ccc?p=10&q=20" (resolver "?p=10&q=20" "http://aaa.bbb.ccc"))
  (test-end))

(test-relative-uri-resolution uri-relative->absolute)

uri-relative->absolute という名前はちょっと長いかも。
RubyのURI.joinやPythonのurljoinのように、引数の順序を入れ替えてuri-joinとかでもいいかもしれません。