fix tree-il test to work if source info happens to be present

* module/language/tree-il/compile-glil.scm (flatten-lambda): Fix source
  emission.

* test-suite/tests/tree-il.test (strip-source): Strip source info on
  tree-il before compiling, so we don't get extraneous source info in the
  glil. Make check passes!

diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index 1bd6587..94ace7e 100644 (file)
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -129,7 +129,7 @@
           ;; write bindings and source debugging info
           (emit-bindings #f ids vars allocation emit-code)
           (if (lambda-src x)
-              (emit-code (make-glil-source (lambda-src x))))
+              (emit-code #f (make-glil-source (lambda-src x))))
 
           ;; copy args to the heap if necessary
           (let lp ((in vars) (n 0))

diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index eb33ae7..18b67d6 100644 (file)
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -24,10 +24,19 @@
   #:use-module (language tree-il)
   #:use-module (language glil))
 
+;; Of course, the GLIL that is emitted depends on the source info of the
+;; input. Here we're not concerned about that, so we strip source
+;; information from the incoming tree-il.
+
+(define (strip-source x)
+  (post-order! (lambda (x) (set! (tree-il-src x) #f))
+               x))
+
 (define-syntax assert-scheme->glil
   (syntax-rules ()
     ((_ in out)
-     (let ((tree-il (compile 'in #:from 'scheme #:to 'tree-il)))
+     (let ((tree-il (strip-source
+                     (compile 'in #:from 'scheme #:to 'tree-il))))
        (pass-if 'in
                 (equal? (unparse-glil (compile tree-il #:from 'tree-il #:to 'glil))
                         'out))))))
@@ -36,7 +45,7 @@
   (syntax-rules ()
     ((_ in out)
      (pass-if 'in
-              (let ((tree-il (parse-tree-il 'in)))
+              (let ((tree-il (strip-source (parse-tree-il 'in))))
                 (equal? (unparse-glil (compile tree-il #:from 'tree-il #:to 'glil))
                         'out))))))
 
@@ -46,13 +55,12 @@
      (let ((exp 'in))
        (pass-if 'in
          (let ((glil (unparse-glil
-                      (compile (parse-tree-il exp)
+                      (compile (strip-source (parse-tree-il exp))
                                #:from 'tree-il #:to 'glil))))
            (pmatch glil
              (pat (guard test ...) #t)
              (else #f))))))))
 
-
 (with-test-prefix "void"
   (assert-tree-il->glil
    (void)