[Gauche-devel-jp] Windows での gauche-config の出力

Back to archive index

室園真一郎 shinm****@gmail*****
2010年 5月 8日 (土) 21:55:02 JST


お疲れ様です。

>> * src/genconfig.in
>> gauche-config の定義を gauche-config.exe を利用する形に書き換えてしま
>> いました。変な話ですけども。
>
> 実は以前はそういう実装だったのですが、呼ばれるgauche-configが
> 現在実行中のgoshと一緒にコンパイルされたものであるという保証が無いのですよね。
> ここはちゃんと '@' つきのパス名を解釈するCルーチンを呼べるように
> しとこうと思います。

>> util.scm の方で cmd でコンパイルコマンドを受け取るようにした影響でシン
>> グルクォーテーション括りが何も解釈されずそのままファイル名になって見つ
>> からなくなってしまうので括らないようにしました。
>
> Windowsのコマンドライン解釈は冷遇されているのでいつも困ります。
> 何もクオートしないとofileやcfileに空白を含むパス名が来た時
> 困りそうです。 (今でもINCDIRの引数で同様の可能性があるのですが。)
> とりあえずこのパッチでしのいで、おいおい真面目に引数をハンドリングして
> 直接CreateProcessを呼べるようにして行きましょうか。
ありがとうございます。
ちゃんとしようとしたら確かにその方針が良いと思ったのですが、
とりあえず動く事を優先して安易な方向へ逃げてます。

あとすみません、既に気付いてらっしゃるかもしれませんが、
util.scm 内に cond-expand で分け切れてない部分があったので
util.scm を再修正した分込みのパッチを再送しておきます。

宜しくお願いします。

----
Shinichiro Murozono <shinm****@gmail*****>

↓パッチここから
diff -cr Gauche-0.9_orig/lib/gauche/package/compile.scm
Gauche-0.9_patched/lib/gauche/package/compile.scm
*** Gauche-0.9_orig/lib/gauche/package/compile.scm	Sun Apr 26 13:15:15 2009
--- Gauche-0.9_patched/lib/gauche/package/compile.scm	Thu May  6 01:53:01 2010
***************
*** 91,97 ****
                        (or cppflags "") (or cflags "")))))))

  (define (do-compile cc cfile ofile cppflags cflags)
!   (run #`",cc -c ,cppflags ,(INCDIR) ,cflags ,CFLAGS -o ',ofile' ',cfile'"))

  (define (gauche-package-link sofile ofiles :key (ldflags #f)
                                                  (libs #f)
--- 91,101 ----
                        (or cppflags "") (or cflags "")))))))

  (define (do-compile cc cfile ofile cppflags cflags)
!   (cond-expand
!    [gauche.os.windows
!     (run #`",cc -c ,cppflags ,(INCDIR) ,cflags ,CFLAGS -o ,ofile ,cfile")]
!    [else
!     (run #`",cc -c ,cppflags ,(INCDIR) ,cflags ,CFLAGS -o ',ofile'
',cfile'")]))

  (define (gauche-package-link sofile ofiles :key (ldflags #f)
                                                  (libs #f)
***************
*** 108,114 ****
                   [in-place-dir gauche-builddir])
      (unless (and (file-exists? sofile)
                   (every (cut file-mtime>? sofile <>) ofiles))
!       (let1 all-ofiles (string-join (map (lambda (f) #`"',f'") ofiles) " ")
          (run #`",(or ld CC) ,(or ldflags \"\") ,(LIBDIR) ,LDFLAGS
,sofile ,all-ofiles ,LIBS ,(or libs \"\")")))))

  (define (gauche-package-compile-and-link module-name files . args)
--- 112,119 ----
                   [in-place-dir gauche-builddir])
      (unless (and (file-exists? sofile)
                   (every (cut file-mtime>? sofile <>) ofiles))
!       (let1 all-ofiles (string-join (cond-expand [gauche.os.windows ofiles]
!                                                  [else (map (lambda
(f) #`"',f'") ofiles)]) " ")
          (run #`",(or ld CC) ,(or ldflags \"\") ,(LIBDIR) ,LDFLAGS
,sofile ,all-ofiles ,LIBS ,(or libs \"\")")))))

  (define (gauche-package-compile-and-link module-name files . args)
diff -cr Gauche-0.9_orig/lib/gauche/package/util.scm
Gauche-0.9_patched/lib/gauche/package/util.scm
*** Gauche-0.9_orig/lib/gauche/package/util.scm	Mon Oct 26 07:28:20 2009
--- Gauche-0.9_patched/lib/gauche/package/util.scm	Sat May  8 19:52:19 2010
***************
*** 49,56 ****
    (when (or (dry-run) (verbose-run))
      (print cmdline))
    (unless (dry-run)
!     (let1 p (run-process "/bin/sh" "-c" cmdline
!                          :input (if stdin-string :pipe "/dev/null")
                           :wait #f)
        (when stdin-string
          (let1 pi (process-input p)
--- 49,61 ----
    (when (or (dry-run) (verbose-run))
      (print cmdline))
    (unless (dry-run)
!     (let1 p (run-process (cond-expand
!                           [gauche.os.windows
!                            `(cmd /c ,cmdline)
!                            :input (if stdin-string :pipe "nul")]
!                           [else
!                            "/bin/sh" "-c" cmdline
!                            :input (if stdin-string :pipe "/dev/null")])
                           :wait #f)
        (when stdin-string
          (let1 pi (process-input p)
diff -cr Gauche-0.9_orig/src/gauche-package.in
Gauche-0.9_patched/src/gauche-package.in
*** Gauche-0.9_orig/src/gauche-package.in	Sat May  2 19:10:33 2009
--- Gauche-0.9_patched/src/gauche-package.in	Thu May  6 01:47:09 2010
***************
*** 1,7 ****
  ;;;
  ;;; gauche-package - Gauche package builder/manager
  ;;;
! ;;;   Copyright (c) 2004-2009 Shiro Kawai, All rights reserved.
  ;;;
  ;;;   Redistribution and use in source and binary forms, with or without
  ;;;   modification, are permitted provided that the following conditions
--- 1,7 ----
  ;;;
  ;;; gauche-package - Gauche package builder/manager
  ;;;
! ;;;   Copyright (c) 2004-2010  Shiro Kawai  <shiro****@acm*****>
  ;;;
  ;;;   Redistribution and use in source and binary forms, with or without
  ;;;   modification, are permitted provided that the following conditions
***************
*** 76,82 ****
  (define *config* '())

  (define (read-config)
!   (let ((config-file (build-path (home-directory) ".gauche-package")))
      (when (file-is-readable? config-file)
        (set! *config* (with-input-from-file config-file read)))
      (dolist (p *config*)
--- 76,85 ----
  (define *config* '())

  (define (read-config)
!   (let ((config-file (build-path (cond-expand
!                                   [gauche.os.windows ""]
!                                   [else (home-directory)])
!                                  ".gauche-package")))
      (when (file-is-readable? config-file)
        (set! *config* (with-input-from-file config-file read)))
      (dolist (p *config*)
diff -cr Gauche-0.9_orig/src/genconfig.in Gauche-0.9_patched/src/genconfig.in
*** Gauche-0.9_orig/src/genconfig.in	Mon Apr  6 18:37:05 2009
--- Gauche-0.9_patched/src/genconfig.in	Thu May  6 02:48:02 2010
***************
*** 367,374 ****
  (select-module gauche.config)

  (define (gauche-config param)
!   (cond ((assoc param *configurations*) => cadr)
!         (else (error "unknown configuration parameter name" param))))

  (define *configurations*
    (quote
--- 367,388 ----
  (select-module gauche.config)

  (define (gauche-config param)
!   (cond-expand
!    ;; on windows, can't expand valid prefix directory.
!    [gauche.os.windows
!     (define (apply-prefix str)
!       (cond [(string-scan str "@")
!              (let* ((process (run-process '(gauche-config --prefix)
:output :pipe))
!                     (prefix (read-line (process-output process)))
!                     (process-wait process)
!                     (plis (string-split str #\@)))
!                #\`",(car plis),|prefix|,(cadr plis)")]
!             [else str]))
!     (cond ((assoc param *configurations*) => (lambda (result)
(apply-prefix (cadr result))))
!           (else (error "unknown configuration parameter name" param)))]
!    [else
!     (cond ((assoc param *configurations*) => cadr)
!           (else (error "unknown configuration parameter name" param)))]))

  (define *configurations*
    (quote




Gauche-devel-jp メーリングリストの案内
Back to archive index