Hello!
I found a bug and want to propose my fix for it.
Basically, when using --r7rs compatibility mode,
the "else" case of cond-expand in (define-library ...)
would not work correctly - it would simply be treated as "false".
I added a test case that demonstrates this.
Then applied the attached patch and tested it by running:
$ ./check-guile r7rs.test
Testing /home/user1/my/devel/guile/meta/guile ... r7rs.test
with GUILE_LOAD_PATH=/home/user1/my/devel/guile/test-suite
Running r7rs.test
Totals for this test run:
passes: 1093
failures: 0
unexpected passes: 0
expected failures: 14
unresolved test cases: 0
untested test cases: 0
unsupported test cases: 0
errors: 0
Thanks.
>From c729a264d952c0acb101ef941c7c021475f81a89 Mon Sep 17 00:00:00 2001
From: Otto Jung <otto.j...@vauplace.com>
Date: Wed, 14 Jun 2023 18:36:55 -0700
Subject: [PATCH 1/2] Fix handling of the "else" case in the r7rs cond-expand
form
Ensure proper handling of the "else" clause in the cond-expand form of
r7rs' define-library.
According to the r7rs specification, ``the last clause of cond-expand can
be an "else clause" with the form (else expression ...)''[1]. Additionally,
``the cond-expand declaration follows the same syntax and semantics as the
cond-expand expression type''[2].
The default cond-expand of Guile and the cond-expand of (scheme base)
work correctly, but they were not used during the expansion of r7rs
define-library macro. Instead, it has special handling for it.
This commit fixes the handling of the else case whereas
previously an "else" found in cond-expand was treated like a feature
name.
* module/ice-9/r7rs-libraries.scm (define-library): handle the "else"
case properly.
[1] page 15 of the report
[1] page 28 of the report
---
module/ice-9/r7rs-libraries.scm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index 63a300a26..428b22035 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -64,8 +64,9 @@
;; FIXME: R7RS (features) isn't quite the same as
;; %cond-expand-features; see scheme/base.scm.
(memq (syntax->datum #'id) %cond-expand-features))))
- (syntax-case clauses ()
+ (syntax-case clauses (else)
(() #'()) ; R7RS says this is not specified :-/
+ (((else decl ...)) #'(decl ...))
(((test decl ...) . clauses)
(if (has-req? #'test)
#'(decl ...)
--
2.40.1
>From fa052f4b7cb2d3b28f8c8061326eeedea87af756 Mon Sep 17 00:00:00 2001
From: Otto Jung <otto.j...@vauplace.com>
Date: Thu, 15 Jun 2023 19:00:08 -0700
Subject: [PATCH 2/2] Add simple tests for r7rs define-library
* test-suite/tests/r7rs.test: add define-library test cases
---
test-suite/tests/r7rs.test | 17 +++++++++++++++++
test-suite/tests/test-libs/cond-expand-lib.sld | 7 +++++++
test-suite/tests/test-libs/lib1.sld | 5 +++++
3 files changed, 29 insertions(+)
create mode 100644 test-suite/tests/test-libs/cond-expand-lib.sld
create mode 100644 test-suite/tests/test-libs/lib1.sld
diff --git a/test-suite/tests/r7rs.test b/test-suite/tests/r7rs.test
index 1cc8cd31e..5e404b6a7 100644
--- a/test-suite/tests/r7rs.test
+++ b/test-suite/tests/r7rs.test
@@ -45,6 +45,7 @@
(define-module (test-suite r7rs)
#:pure
#:use-module ((guile) #:select (install-r7rs!
+ (eval . guile:eval) current-module
define-syntax-rule quote read-disable
import))
#:use-module (test-suite lib))
@@ -741,6 +742,22 @@
(set-kar! k 3)
(kar k)))
+;; define-library
+
+(test 42
+ (guile:eval
+ `(begin
+ (import (tests test-libs lib1))
+ lib1-var)
+ (current-module)))
+
+(test 42
+ (guile:eval
+ `(begin
+ (import (tests test-libs cond-expand-lib))
+ cond-expand-var)
+ (current-module)))
+
(test-end)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/test-suite/tests/test-libs/cond-expand-lib.sld b/test-suite/tests/test-libs/cond-expand-lib.sld
new file mode 100644
index 000000000..2d8351384
--- /dev/null
+++ b/test-suite/tests/test-libs/cond-expand-lib.sld
@@ -0,0 +1,7 @@
+
+(define-library (tests test-libs cond-expand-lib)
+ (import (only (scheme base) begin define cond-expand))
+ (export cond-expand-var)
+ (cond-expand
+ (unsuported-feature (begin (define cond-expand-var 1)))
+ (else (begin (define cond-expand-var 42)))))
diff --git a/test-suite/tests/test-libs/lib1.sld b/test-suite/tests/test-libs/lib1.sld
new file mode 100644
index 000000000..ae83f5a68
--- /dev/null
+++ b/test-suite/tests/test-libs/lib1.sld
@@ -0,0 +1,5 @@
+
+(define-library (tests test-libs lib1)
+ (import (scheme base))
+ (export lib1-var)
+ (begin (define lib1-var 42)))
--
2.40.1
