室園真一郎
shinm****@gmail*****
2010年 5月 7日 (金) 21:09:14 JST
お疲れ様です。 この件に絡んでなのですが、Windows で gauche-package を利用しての DLL 作成可能になるような形に修正してみました。 どれも場当たり的な対処ですが、パッチの内容は最後になります。 また、内容は 0.9 からの差分になります。 宜しくお願いします。 * lib/gauche/package/compile.scm util.scm の方で cmd でコンパイルコマンドを受け取るようにした影響でシン グルクォーテーション括りが何も解釈されずそのままファイル名になって見つ からなくなってしまうので括らないようにしました。 * lib/gauche/package/util.scm - sh→cmd にしたのは、sh で gcc を実行すると落ちてしうので変更しました。 - 後 cmdline には gauche-config --sysincdir で渡された結果も含んでいる のですが Windows パス区切りになってて sh だと認識できません。gcc 自 体は別に cmd でも動作するのでこちらに変えてます。 - ただ、何故か cmd への引数渡しだと cmdline が評価されないまま渡された のでバッククォートして cmdline だけ評価させるようにしてます。 - 後、Windows に /dev/null はないので相当する nul に変えてます。 * src/gauche-package.in Windows では home-directory が #f を返す為一時的にです。 * src/genconfig.in gauche-config の定義を gauche-config.exe を利用する形に書き換えてしま いました。変な話ですけども。 ---- Shinichiro Murozono <shinm****@gmail*****> ↓patch ここから 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 Thu May 6 01:54:23 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,57 ---- (when (or (dry-run) (verbose-run)) (print cmdline)) (unless (dry-run) ! (let1 p (run-process (cond-expand [gauche.os.windows `(cmd /c ,cmdline)] ! [else "/bin/sh" "-c" cmdline]) ! :input (if stdin-string :pipe "nul") :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
