From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: David Pirotte Newsgroups: gmane.lisp.guile.devel Subject: Re: Guile build failure Date: Tue, 22 Jan 2013 14:43:23 -0200 Message-ID: <20130122144323.6fb716cb@capac> References: <20120709140217.3a5e271b@rascar> <87bojo6nc6.fsf@gnu.org> <20120710125040.37e9b946@rascar> <871ukipr8i.fsf@gnu.org> <20120719105939.44708c6a@rascar> <87629j68nv.fsf@gnu.org> <20120719134534.2d07fc8b@rascar> <87zk6t5pr8.fsf@gnu.org> <20120728125540.275b0334@rascar> <874nocw4lr.fsf@gnu.org> <87622q999d.fsf@pobox.com> <87obgidd86.fsf@gnu.org> <87obgi7oj4.fsf@pobox.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/_IARA+1Kxv9GQi18/ZxuG3S" X-Trace: ger.gmane.org 1358873056 17714 80.91.229.3 (22 Jan 2013 16:44:16 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 22 Jan 2013 16:44:16 +0000 (UTC) Cc: guile-devel@gnu.org To: Andy Wingo Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Jan 22 17:44:33 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1TxgxZ-0002jh-Ux for guile-devel@m.gmane.org; Tue, 22 Jan 2013 17:44:30 +0100 Original-Received: from localhost ([::1]:49087 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TxgxI-000665-EW for guile-devel@m.gmane.org; Tue, 22 Jan 2013 11:44:12 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:34657) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Txgx9-000657-SB for guile-devel@gnu.org; Tue, 22 Jan 2013 11:44:11 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Txgx5-0006ha-Ia for guile-devel@gnu.org; Tue, 22 Jan 2013 11:44:03 -0500 Original-Received: from maximusconfessor.all2all.org ([62.58.108.13]:45702) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Txgx5-0006a5-5h for guile-devel@gnu.org; Tue, 22 Jan 2013 11:43:59 -0500 Original-Received: from localhost (unknown [192.168.0.2]) by maximusconfessor.all2all.org (Postfix) with ESMTP id 799F6A04C101; Tue, 22 Jan 2013 17:43:36 +0100 (CET) Original-Received: from maximusconfessor.all2all.org ([192.168.0.1]) by localhost (maximusconfessor.all2all.org [192.168.0.2]) (amavisd-new, port 10024) with ESMTP id XWHbzyv57caX; Tue, 22 Jan 2013 17:13:34 +0100 (CET) Original-Received: from capac (unknown [186.205.50.124]) by maximusconfessor.all2all.org (Postfix) with ESMTPSA id 32109A04C0FF; Tue, 22 Jan 2013 17:43:26 +0100 (CET) In-Reply-To: <87obgi7oj4.fsf@pobox.com> X-Mailer: Claws Mail 3.8.1 (GTK+ 2.24.10; x86_64-pc-linux-gnu) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 62.58.108.13 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:15546 Archived-At: --MP_/_IARA+1Kxv9GQi18/ZxuG3S Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Hi Andy, > > =E2=80=98load.test=E2=80=99 uses =E2=80=98compile-file=E2=80=99, and it= seems that =E2=80=98compile-file=E2=80=99 does > > an =E2=80=98open-input-file=E2=80=99 with no corresponding =E2=80=98clo= se-port=E2=80=99. That may be > > the problem. >=20 > Can you try the following patch? ./check-guile load.test on your NFS > machine should do it. I did try and it still raise a bug. I had to manually apply the patch[*] an= d could have missed a place though: to make sure, here is the compile.scm i used [a= ttached]. note that since the close-port have been added, [1] the remaining trace sho= ws one .nfs* file - there were two in the trace I sent to Ludovic - and [2] checking manually= the directory just after the trace, it is empty [see below] Cheers, David [*] i did a git pull before and compile.scm changed ... i could only find o= ne place to add, (close-port in) [in (define (compile-file ...))], it seems yo= u already added the other (close-port port). ;; ;; trace ... ;; david@idefix:/usr/local/src/guile/git-clone 61 $ ./check-guile load.test Testing /usr/local/src/guile/git-clone/meta/guile ... load.test with GUILE_LOAD_PATH=3D/usr/local/src/guile/git-clone/test-suite Running load.test ;;; (remaining "/mnt/galia/linux/64/local/src/guile/git-clone/load-test.dir= /dir3" ("." "..")) ;;; (remaining "/mnt/galia/linux/64/local/src/guile/git-clone/load-test.dir= /dir2" ("." "..")) ;;; (remaining "/mnt/galia/linux/64/local/src/guile/git-clone/load-test.dir= /dir1/subdir1" ("." "..")) ;;; (remaining "/mnt/galia/linux/64/local/src/guile/git-clone/load-test.dir= /dir1" ("." "..")) ;;; (remaining "/mnt/galia/linux/64/local/src/guile/git-clone/load-test.dir= " ("." ".." ".nfs00000000138c196300000041")) Backtrace: In ice-9/boot-9.scm: 157: 12 [catch #t # ...] In unknown file: ?: 11 [apply-smob/1 #] In ice-9/boot-9.scm: 63: 10 [call-with-prompt prompt0 ...] In ice-9/eval.scm: 432: 9 [eval # #] 432: 8 [eval # #] In ice-9/boot-9.scm: 696: 7 [for-each # ("load.t= est")] In ice-9/eval.scm: 481: 6 [lp (#) (("load.test"))] In ice-9/boot-9.scm: 2131: 5 [save-module-excursion #] 3776: 4 [#] 1456: 3 [%start-stack load-stack #] 1461: 2 [#] In unknown file: ?: 1 [primitive-load "/usr/local/src/guile/git-clone/test-suite/tests/lo= ad.test"] ?: 0 [rmdir "/mnt/galia/linux/64/local/src/guile/git-clone/load-test.dir= "] ERROR: In procedure rmdir: ERROR: In procedure rmdir: Directory not empty david@idefix:/usr/local/src/guile/git-clone 62 $ ls -lsa load-test.dir/ total 8 4 drwxrwxr-x 2 david alto 4096 Jan 22 14:35 ./ 4 drwxr-xr-x 21 david alto 4096 Jan 22 14:35 ../ david@idefix:/usr/local/src/guile/git-clone 63 $=20 --MP_/_IARA+1Kxv9GQi18/ZxuG3S Content-Type: text/x-scheme Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=compile.scm ;;; High-level compiler interface ;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public ;;; License as published by the Free Software Foundation; either ;;; version 3 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Lesser General Public License for more details. ;;; ;;; You should have received a copy of the GNU Lesser General Public ;;; License along with this library; if not, write to the Free Software ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;; Code: (define-module (system base compile) #:use-module (system base syntax) #:use-module (system base language) #:use-module (system base message) #:use-module (system vm vm) ;; FIXME: there's a reason for this, can't remember why tho #:use-module (ice-9 regex) #:use-module (ice-9 optargs) #:use-module (ice-9 receive) #:export (compiled-file-name compile-file compile-and-load read-and-compile compile decompile)) ;;; ;;; Compiler ;;; (define (call-once thunk) (let ((entered #f)) (dynamic-wind (lambda () (if entered (error "thunk may only be entered once: ~a" thunk)) (set! entered #t)) thunk (lambda () #t)))) ;; (put 'call-with-output-file/atomic 'scheme-indent-function 1) (define* (call-with-output-file/atomic filename proc #:optional reference) (let* ((template (string-append filename ".XXXXXX")) (tmp (mkstemp! template))) (call-once (lambda () (with-throw-handler #t (lambda () (proc tmp) (chmod tmp (logand #o0666 (lognot (umask)))) (close-port tmp) (rename-file template filename)) (lambda args (delete-file template))))))) (define (ensure-language x) (if (language? x) x (lookup-language x))) ;; Throws an exception if `dir' is not writable. The mkdir occurs ;; before the check, so that we avoid races (possibly due to parallel ;; compilation). ;; (define (ensure-directory dir) (catch 'system-error (lambda () (mkdir dir)) (lambda (k subr fmt args rest) (let ((errno (and (pair? rest) (car rest)))) (cond ((eqv? errno EEXIST) ;; Assume it's a writable directory, to avoid TOCTOU errors, ;; as well as UID/EUID mismatches that occur with access(2). #t) ((eqv? errno ENOENT) (ensure-directory (dirname dir)) (ensure-directory dir)) (else (throw k subr fmt args rest))))))) ;;; This function is among the trickiest I've ever written. I tried many ;;; variants. In the end, simple is best, of course. ;;; ;;; After turning this around a number of times, it seems that the ;;; desired behavior is that .go files should exist in a path, for ;;; searching. That is orthogonal to this function. For writing .go ;;; files, either you know where they should go, in which case you tell ;;; compile-file explicitly, as in the srcdir != builddir case; or you ;;; don't know, in which case this function is called, and we just put ;;; them in your own ccache dir in ~/.cache/guile/ccache. ;;; ;;; See also boot-9.scm:load. (define (compiled-file-name file) ;; FIXME: would probably be better just to append SHA1(canon-path) ;; to the %compile-fallback-path, to avoid deep directory stats. (define (canonical->suffix canon) (cond ((string-prefix? "/" canon) canon) ((and (> (string-length canon) 2) (eqv? (string-ref canon 1) #\:)) ;; Paths like C:... transform to /C... (string-append "/" (substring canon 0 1) (substring canon 2))) (else canon))) (define (compiled-extension) (cond ((or (null? %load-compiled-extensions) (string-null? (car %load-compiled-extensions))) (warn "invalid %load-compiled-extensions" %load-compiled-extensions) ".go") (else (car %load-compiled-extensions)))) (and %compile-fallback-path (let ((f (string-append %compile-fallback-path (canonical->suffix (canonicalize-path file)) (compiled-extension)))) (and (false-if-exception (ensure-directory (dirname f))) f)))) (define* (compile-file file #:key (output-file #f) (from (current-language)) (to 'objcode) (env (default-environment from)) (opts '()) (canonicalization 'relative)) (with-fluids ((%file-port-name-canonicalization canonicalization)) (let* ((comp (or output-file (compiled-file-name file) (error "failed to create path for auto-compiled file" file))) (in (open-input-file file)) (enc (file-encoding in))) ;; Choose the input encoding deterministically. (set-port-encoding! in (or enc "UTF-8")) (ensure-directory (dirname comp)) (call-with-output-file/atomic comp (lambda (port) ((language-printer (ensure-language to)) (read-and-compile in #:env env #:from from #:to to #:opts opts) port)) file) (close-port in) comp))) (define* (compile-and-load file #:key (from (current-language)) (to 'value) (env (current-module)) (opts '()) (canonicalization 'relative)) (with-fluids ((%file-port-name-canonicalization canonicalization)) (read-and-compile (open-input-file file) #:from from #:to to #:opts opts #:env env))) ;;; ;;; Compiler interface ;;; (define (compile-passes from to opts) (map cdr (or (lookup-compilation-order from to) (error "no way to compile" from "to" to)))) (define (compile-fold passes exp env opts) (let lp ((passes passes) (x exp) (e env) (cenv env) (first? #t)) (if (null? passes) (values x e cenv) (receive (x e new-cenv) ((car passes) x e opts) (lp (cdr passes) x e (if first? new-cenv cenv) #f))))) (define (find-language-joint from to) (let lp ((in (reverse (or (lookup-compilation-order from to) (error "no way to compile" from "to" to)))) (lang to)) (cond ((null? in) to) ((language-joiner lang) lang) (else (lp (cdr in) (caar in)))))) (define (default-language-joiner lang) (lambda (exps env) (if (and (pair? exps) (null? (cdr exps))) (car exps) (error "Multiple expressions read and compiled, but language has no joiner" lang)))) (define (read-and-parse lang port cenv) (let ((exp ((language-reader lang) port cenv))) (cond ((eof-object? exp) exp) ((language-parser lang) => (lambda (parse) (parse exp))) (else exp)))) (define* (read-and-compile port #:key (from (current-language)) (to 'objcode) (env (default-environment from)) (opts '())) (let ((from (ensure-language from)) (to (ensure-language to))) (let ((joint (find-language-joint from to))) (parameterize ((current-language from)) (let lp ((exps '()) (env #f) (cenv env)) (let ((x (read-and-parse (current-language) port cenv))) (cond ((eof-object? x) (close-port port) (compile ((or (language-joiner joint) (default-language-joiner joint)) (reverse exps) env) #:from joint #:to to ;; env can be false if no expressions were read. #:env (or env (default-environment joint)) #:opts opts)) (else ;; compile-fold instead of compile so we get the env too (receive (jexp jenv jcenv) (compile-fold (compile-passes (current-language) joint opts) x cenv opts) (lp (cons jexp exps) jenv jcenv)))))))))) (define* (compile x #:key (from (current-language)) (to 'value) (env (default-environment from)) (opts '())) (let ((warnings (memq #:warnings opts))) (if (pair? warnings) (let ((warnings (cadr warnings))) ;; Sanity-check the requested warnings. (for-each (lambda (w) (or (lookup-warning-type w) (warning 'unsupported-warning #f w))) warnings)))) (receive (exp env cenv) (compile-fold (compile-passes from to opts) x env opts) exp)) ;;; ;;; Decompiler interface ;;; (define (decompile-passes from to opts) (map cdr (or (lookup-decompilation-order from to) (error "no way to decompile" from "to" to)))) (define (decompile-fold passes exp env opts) (if (null? passes) (values exp env) (receive (exp env) ((car passes) exp env opts) (decompile-fold (cdr passes) exp env opts)))) (define* (decompile x #:key (env #f) (from 'value) (to 'assembly) (opts '())) (decompile-fold (decompile-passes from to opts) x env opts)) --MP_/_IARA+1Kxv9GQi18/ZxuG3S--