From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Maxim Cournoyer Newsgroups: gmane.lisp.guile.bugs Subject: bug#66046: [PATCH v4 2/3] tests: Add new compile-file tests. Date: Sat, 14 Sep 2024 10:34:28 +0900 Message-ID: <20240914013501.6445-2-maxim.cournoyer@gmail.com> References: <20240914013501.6445-1-maxim.cournoyer@gmail.com> Mime-Version: 1.0 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="25289"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Timothy Sample , Amirouche , Maxim Cournoyer , Daphne Preston-Kendal To: 66046@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Sat Sep 14 03:37:38 2024 Return-path: Envelope-to: guile-bugs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1spHjF-0006SI-LM for guile-bugs@m.gmane-mx.org; Sat, 14 Sep 2024 03:37:37 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1spHid-0003le-Su; Fri, 13 Sep 2024 21:36:59 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1spHiY-0003kr-2n for bug-guile@gnu.org; Fri, 13 Sep 2024 21:36:55 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1spHiW-0001Yc-Q4 for bug-guile@gnu.org; Fri, 13 Sep 2024 21:36:53 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=gN7qvG0XWU/wdNq2CJr5Ypz3YBHfnjc7G1D/b3rYBhw=; b=IN0NWGUbsu8jM2xFzM3Y24rUY7yGcfecT8cBxx5pn0LfilfyMqc2tVDuSDbPwRu7qszY6ePJRWRzpYwe69t18P8is8u/6kObyekJOlAWEFKdt3/r599d/7saAwFElMTs16F9QTsk6esAb6oD+S6yS+pXrKjX2SsQpj2uDlwKFL25RpQI/NZZxOPtwhS3yRuK6JuHoK6OsuWZkvUjDJ5RoEzNWEBrbkxBdbolnfQ4pasIZrEs+NhG4fVLl+r0XO9jIp36fysZSMTkOB9H45XKdLTzsfBrQcef8NoTI3LYUhHTPZpvqg49oVZjE8FI2u4XUBofIpUC3yF0PrhdOuoaog==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1spHig-0007oV-K6 for bug-guile@gnu.org; Fri, 13 Sep 2024 21:37:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Sat, 14 Sep 2024 01:37:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 66046 X-GNU-PR-Package: guile Original-Received: via spool by 66046-submit@debbugs.gnu.org id=B66046.172627779429984 (code B ref 66046); Sat, 14 Sep 2024 01:37:02 +0000 Original-Received: (at 66046) by debbugs.gnu.org; 14 Sep 2024 01:36:34 +0000 Original-Received: from localhost ([127.0.0.1]:44483 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1spHiE-0007nS-35 for submit@debbugs.gnu.org; Fri, 13 Sep 2024 21:36:34 -0400 Original-Received: from mail-pl1-f175.google.com ([209.85.214.175]:45322) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1spHiB-0007mx-45 for 66046@debbugs.gnu.org; Fri, 13 Sep 2024 21:36:31 -0400 Original-Received: by mail-pl1-f175.google.com with SMTP id d9443c01a7336-2068acc8b98so25415885ad.3 for <66046@debbugs.gnu.org>; Fri, 13 Sep 2024 18:36:21 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1726277714; x=1726882514; darn=debbugs.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=gN7qvG0XWU/wdNq2CJr5Ypz3YBHfnjc7G1D/b3rYBhw=; b=O5oM063B7sLfUcnzloZSbixj1keKzqBxxi7zK8wsMTVg9u3rTIC5Ka3KHAeXE0pc+o Jgzjij2Jf0jJ+h8VdxD2a8/PLchENAc1tXTNXQwZ0mCBBBK0jdLxdiOFnwxWjftCN50X 12o/OzOEBVwfl6CbnCrH1u+JO27sR3WA+PwCWkEWPhCM76NQ5Q5cHpU3EUgvjAhaRTNX q2pFHvItntjDBUgs6VITd0x3QMWrsu8Ru3X0+5997ZdOQjJ1vjkV19fAwYeqRIZcDDlg +rOTiIjbLvWlrr8VUZ5/gqcIJT/wdJPlXLMh5niEmXmdKnU0KnvWNqbLSNDembMGpksa 6ZLg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1726277714; x=1726882514; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=gN7qvG0XWU/wdNq2CJr5Ypz3YBHfnjc7G1D/b3rYBhw=; b=qCIaYNueeGy1NdxT2X0TnsMW1voFm9Sv08iqfI0/8n3ZBPB3QrVwBD0s5tvTHx80SQ Gvcg9uZYcWuMcmBtQZtJnRq5a0BoNymxty5ke01DET360g+aWI13brfkgq6CeELZ6rIt Fux+w5W2wT4QnDRUOdxgULeOPq1IAhURsCZUOjiv+5YrZRHRiolaBeOWNPbjXaLamp50 Et+MiuzLOOeGQGLKdTH/tRx1l431woohgGfBWjuN+dNBqh5utJFqxTVCbm1XmDxUsnc5 kdtp5613+QfrDGXHNv+HVS60w5MsAiMo9W/8VOayfrPx/Xq4hHw+6uK9gF098j1oo/pu qNkQ== X-Gm-Message-State: AOJu0Yz5ak35RFkvkKJ7C71Qf0f+wcvxyzBKtA4f32LJmX1MUDY7KocY ecvpGbUHJrDhnko43gq9sbWlSs8DvmccHWE6pHrFiyOoLK/tsuhI4qyAND9c X-Google-Smtp-Source: AGHT+IFrUFYVPcLT09O5oqMjNOu3/TfC4UYyOmKI3PObXzZ2Pr0JKaauUhlDksxfkPW43ZG5nXRSVA== X-Received: by 2002:a17:903:240b:b0:205:5f54:75a2 with SMTP id d9443c01a7336-2076e43ef3emr116955335ad.51.1726277714255; Fri, 13 Sep 2024 18:35:14 -0700 (PDT) Original-Received: from hurd.lan ([2405:6586:be0:0:c8ff:1707:9b9:af89]) by smtp.gmail.com with ESMTPSA id d9443c01a7336-207945da802sm2164505ad.50.2024.09.13.18.35.12 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 13 Sep 2024 18:35:13 -0700 (PDT) X-Mailer: git-send-email 2.46.0 In-Reply-To: <20240914013501.6445-1-maxim.cournoyer@gmail.com> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.bugs:10976 Archived-At: Add a test for bug #66046. To run just the compiler tests: ./meta/guile -L test-suite -L . test-suite/tests/compiler.test * test-suite/tests/compiler.test (with-temporary-directory): New syntax. (delete-file-recursively): New procedure. ("compile-file: relative include works") ("compile-file: relative include works with load path canonicalization"): New tests. --- (no changes since v1) test-suite/tests/compiler.test | 84 ++++++++++++++++++++++++++++++++-- 1 file changed, 81 insertions(+), 3 deletions(-) diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test index 0b47d0e32..5cb7a8ef6 100644 --- a/test-suite/tests/compiler.test +++ b/test-suite/tests/compiler.test @@ -1,6 +1,6 @@ ;;;; compiler.test --- tests for the compiler -*- scheme -*- -;;;; Copyright (C) 2008-2014, 2018, 2021-2022, 2024 Free Software Foundation, Inc. -;;;; +;;;; Copyright (C) 2008-2014, 2018, 2021-2024 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 @@ -18,15 +18,50 @@ (define-module (tests compiler) #:use-module (test-suite lib) #:use-module (test-suite guile-test) + #:use-module (ice-9 ftw) #:use-module (system base compile) #:use-module ((language tree-il) #:select (tree-il-src call-args)) #:use-module ((system vm loader) #:select (load-thunk-from-memory)) - #:use-module ((system vm program) #:select (program-sources source:addr))) + #:use-module ((system vm program) #:select (program-sources source:addr)) + #:use-module (srfi srfi-26)) (define read-and-compile (@@ (system base compile) read-and-compile)) +;;; Based on 'with-directory-excursion', from (guix build utils). +(define-syntax-rule (with-temporary-directory body ...) + "Run BODY with DIR as the process's current directory." + (let ((init (getcwd)) + (dir (mkdtemp "tempdir.XXXXXX"))) + (dynamic-wind + (lambda () + (chdir dir)) + (lambda () + body ...) + (lambda () + (chdir init) + (delete-file-recursively dir))))) + +;;; XXX: Adapted from (guix build utils). +(define* (delete-file-recursively dir) + "Delete DIR recursively, like `rm -rf', without following symlinks." + (file-system-fold (const #t) ;enter + (lambda (file stat result) ; leaf + (delete-file file)) + (const #t) ; down + (lambda (dir stat result) ; up + (rmdir dir)) + (const #t) ; skip + (lambda (file stat errno result) + (format (current-error-port) + "warning: failed to delete ~a: ~a~%" + file (strerror errno))) + #t + dir + + ;; Don't follow symlinks. + lstat)) (with-test-prefix "basic" @@ -441,3 +476,46 @@ (set! proc ((load-thunk-from-memory bytecode))) (procedure? proc))) (pass-if-equal "proc executes" 42 (proc)))) + +(with-test-prefix "compile-file" + ;; Setup test library sources in a temporary directory. + (let ((hello-sexp '(define-library (hello) + (import (scheme base) + (scheme write)) + (export hello) + (include "hello/hello-impl.scm"))) + (hello-impl-sexp '(begin + (include "../external/nothing.scm") + (include "body.scm"))) + (hello-body-sexp '(define (hello) + (display "hello!\n")))) + (with-temporary-directory + (mkdir "module") + (call-with-output-file "module/hello.scm" + (cut write hello-sexp <>)) + (mkdir "module/hello") + (call-with-output-file "module/hello/hello-impl.scm" + (cut write hello-impl-sexp <>)) + (call-with-output-file "module/hello/body.scm" + (cut write hello-body-sexp <>)) + (mkdir "module/external") + (call-with-output-file "module/external/nothing.scm" (const #t)) + (mkdir "build") + (chdir "build") + + (pass-if "relative include works" + (compile-file "../module/hello.scm" #:output-file "hello.go") + #t) + + ;; This used to fail, because compile-file's #:canonicalization + ;; defaults to 'relative, which causes 'scm_relativize_path' to + ;; strip the prefix not in the load path, to avoid baking an + ;; invalid source file reference in the byte compiled output file + ;; (see: https://bugs.gnu.org/66046). This was fixed by having a + ;; '%file-port-stripped-prefixes' fluid to preserve the stripped + ;; prefix, to be used by 'include' to reconstruct the original + ;; complete relative file name. + (pass-if "relative include works with load path canonicalization" + (add-to-load-path (string-append (getcwd) "/../module")) + (compile-file "../module/hello.scm" #:output-file "hello.go") + #t)))) -- 2.46.0