mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fix infinite loop in expander

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2015-02-13 16:40:46 +01:00
parent 1bbf7f7580
commit 37ae02ffa0
3 changed files with 39 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

9
module/ice-9/psyntax-pp.scm
View file

@ -463,7 +463,14 @@
(values (car b) (cdr b) mod))))) (values (car b) (cdr b) mod)))))
(let ((n (id-var-name id w mod))) (let ((n (id-var-name id w mod)))
(cond ((syntax-object? n) (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) ((symbol? n)
(resolve-global (resolve-global
n n

19
module/ice-9/psyntax.scm
View file

@ -1,7 +1,7 @@
;;;; -*-scheme-*- ;;;; -*-scheme-*-
;;;; ;;;;
;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011, ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -890,9 +890,20 @@
(let ((n (id-var-name id w mod))) (let ((n (id-var-name id w mod)))
(cond (cond
((syntax-object? n) ((syntax-object? n)
;; Recursing allows syntax-parameterize to override (cond
;; macro-introduced syntax parameters. ((not (eq? n id))
(resolve-identifier n w r mod resolve-syntax-parameters?)) ;; 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) ((symbol? n)
(resolve-global n (if (syntax-object? id) (resolve-global n (if (syntax-object? id)
(syntax-object-module id) (syntax-object-module id)

17
test-suite/tests/syncase.test
View file

@ -1,6 +1,6 @@
;;;; syncase.test --- test suite for (ice-9 syncase) -*- scheme -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -307,3 +307,18 @@
(pass-if-syntax-error "primref in (guile)" (pass-if-syntax-error "primref in (guile)"
"not in operator position" "not in operator position"
(macroexpand '(@@ @@ (guile) (@@ primitive cons))))) (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))