[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Fix infinite loop in expander
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/01: Fix infinite loop in expander |
Date: |
Fri, 13 Feb 2015 15:48:55 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 37ae02ffa0d788f59c096cec7a3ac9744d87cf16
Author: Andy Wingo <address@hidden>
Date: Fri Feb 13 16:40:46 2015 +0100
Fix infinite loop in expander
* module/ice-9/psyntax.scm (resolve-identifier): There is a case where a
syntax object can resolve to itself. Prevent an infinite loop in that
case by continuing to resolve by name.
* module/ice-9/psyntax-pp.scm: Regenerate.
* test-suite/tests/syncase.test ("infinite loop bug"): Add a test.
---
module/ice-9/psyntax-pp.scm | 9 ++++++++-
module/ice-9/psyntax.scm | 19 +++++++++++++++----
test-suite/tests/syncase.test | 17 ++++++++++++++++-
3 files changed, 39 insertions(+), 6 deletions(-)
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 7ad8a70..6029f05 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -463,7 +463,14 @@
(values (car b) (cdr b) mod)))))
(let ((n (id-var-name id w mod)))
(cond ((syntax-object? n)
- (resolve-identifier n w r mod resolve-syntax-parameters?))
+ (if (not (eq? n id))
+ (resolve-identifier n w r mod resolve-syntax-parameters?)
+ (resolve-identifier
+ (syntax-object-expression n)
+ (syntax-object-wrap n)
+ r
+ (syntax-object-module n)
+ resolve-syntax-parameters?)))
((symbol? n)
(resolve-global
n
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index f7c5c0e..c9c309a 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1,7 +1,7 @@
;;;; -*-scheme-*-
;;;;
;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011,
-;;;; 2012, 2013 Free Software Foundation, Inc.
+;;;; 2012, 2013, 2015 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
@@ -890,9 +890,20 @@
(let ((n (id-var-name id w mod)))
(cond
((syntax-object? n)
- ;; Recursing allows syntax-parameterize to override
- ;; macro-introduced syntax parameters.
- (resolve-identifier n w r mod resolve-syntax-parameters?))
+ (cond
+ ((not (eq? n id))
+ ;; This identifier aliased another; recurse to allow
+ ;; syntax-parameterize to override macro-introduced syntax
+ ;; parameters.
+ (resolve-identifier n w r mod resolve-syntax-parameters?))
+ (else
+ ;; Resolved to a free variable that was introduced by this
+ ;; macro; continue to resolve this global by name.
+ (resolve-identifier (syntax-object-expression n)
+ (syntax-object-wrap n)
+ r
+ (syntax-object-module n)
+ resolve-syntax-parameters?))))
((symbol? n)
(resolve-global n (if (syntax-object? id)
(syntax-object-module id)
diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test
index 15c811c..7651c46 100644
--- a/test-suite/tests/syncase.test
+++ b/test-suite/tests/syncase.test
@@ -1,6 +1,6 @@
;;;; syncase.test --- test suite for (ice-9 syncase) -*- scheme -*-
;;;;
-;;;; Copyright (C) 2001, 2006, 2009, 2010, 2011, 2013 Free Software
Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2009, 2010, 2011, 2013, 2015 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
@@ -307,3 +307,18 @@
(pass-if-syntax-error "primref in (guile)"
"not in operator position"
(macroexpand '(@@ @@ (guile) (@@ primitive cons)))))
+
+(pass-if "infinite loop bug"
+ (begin
+ (macroexpand
+ '(let-syntax
+ ((define-foo
+ (syntax-rules ()
+ ((define-foo a b)
+ (begin
+ (define a '())
+ ;; Oddly, the "*" in the define* seems to be
+ ;; important in triggering this bug.
+ (define* (b) (set! a a)))))))
+ (define-foo a c)))
+ #t))