nyacc cpp-debugging, tests

module/mes/guile.mes

@@ -113,6 +113,16 @@
     (set-current-output-port save)
     r))
 
+(define core:open-input-file open-input-file)
+(define (open-input-file file)
+  (let ((port (core:open-input-file file)))
+    (when (getenv "MES_DEBUG")
+      (core:display-error (string-append "open-input-file: `" file "'\n"))
+      (core:display-error "port=")
+      (core:display-error port)
+      (core:display-error "\n"))
+    port))
+
 (define open-input-string
   (let ((save-set-current-input-port #f)
         (string-port #f))
@@ -128,8 +138,13 @@
                   (tell 0)
                   (end (string-length string)))
               (lambda (port)
+                (when (getenv "MES_DEBUG")
+                    (core:display-error (string-append "open-input-string: `" string "' save-set-current-input-port port="))
+                    (core:display-error port)
+                    (core:display-error "\n"))
                 (if (not (equal? port string-port)) (save-set-current-input-port port)
                     (begin
+                      (set! tell 0)
                       (set! peek-char
                             (lambda () (if (= tell end) (integer->char -1)
                                            (string-ref string (- tell 1)))))
@@ -142,6 +157,10 @@
                             (lambda (c) (set! tell (1- tell)) c))
                       (set! set-current-input-port
                             (lambda (port)
+                              (when (getenv "MES_DEBUG")
+                                (core:display-error (string-append "open-input-string: `" string "' set-current-input-port port="))
+                                (core:display-error port)
+                                (core:display-error "\n"))
                               (save-set-current-input-port port)
                               (set! peek-char save-peek-char)
                               (set! read-char save-read-char)

module/mes/guile.scm

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -23,12 +23,39 @@
 ;;; Code:
 
 (define-module (mes guile)
-  #:export (core:display core:display-error))
+  #:export (core:display core:display-error)
+  ;;#:re-export (open-input-file open-input-string with-input-from-string)
+  )
 
 (cond-expand
  (guile
   (define core:display display)
-  (define (core:display-error o) (display o (current-error-port))))
+  (define (core:display-error o) (display o (current-error-port)))
+
+;;   (define core:open-input-file open-input-file)
+;;   (define (open-input-file file)
+;;     (let ((port (core:open-input-file file)))
+;;       (when (getenv "MES_DEBUG")
+;;         (core:display-error (string-append "open-input-file: `" file " port="))
+;;         (core:display-error port)
+;;         (core:display-error "\n"))
+;;       port))
+
+;;   (define core:open-input-string open-input-string)
+;;   (define (open-input-string string)
+;;     (let ((port (core:open-input-string string)))
+;;       (when (getenv "MES_DEBUG")
+;;         (core:display-error (string-append "open-input-string: `" string " port="))
+;;         (core:display-error port)
+;;         (core:display-error "\n"))
+;;       port))
+
+;;   (define core:with-input-from-string with-input-from-string)
+;;   (define (with-input-from-string string thunk)
+;;     (if (getenv "MES_DEBUG")
+;;         (core:display-error (string-append "with-input-from-string: `" string "'\n")))
+;;     (core:with-input-from-string string thunk))
+  )
  (mes))
 
 (cond-expand

tests/guile.test

@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -73,14 +73,43 @@ exit $?
 	  (set-current-input-port (car ipstk))
 	  (fluid-set! *input-stack* (cdr ipstk))))))
 
+;; Return #f if empty
+(define (pop-input)
+  (let ((ipstk (fluid-ref *input-stack*)))
+    (if (null? ipstk) #f
+	(begin
+	  (set-current-input-port (car ipstk))
+	  (fluid-set! *input-stack* (cdr ipstk))))))
+
 (pass-if-equal "push-input"
-               "bla"
+    "bla"
-               (let ()
+  (let ()
-                 (push-input (open-input-string "bla"))
+    (push-input (open-input-string "bla"))
-                 (let ((ch (read-char)))
+    (let ((ch (read-char)))
-                   (unread-char ch))
+      (unread-char ch))
-                 (let ((x (read-string)))
+    (let ((x (read-string)))
-                   (let ((pop (pop-input)))
+      (let ((pop (pop-input)))
-                     x))))
+        x))))
+
+(pass-if-equal "input-stack/1"
+    "hello world!"
+  (with-output-to-string
+    (lambda ()
+      (with-input-from-string "hello X!"
+        (lambda ()
+          (let iter ((ch (read-char)))
+            (unless (eq? ch #\X) (write-char ch) (iter (read-char))))
+          (push-input (open-input-string "world"))
+          (let iter ((ch (read-char)))
+            (unless (eof-object? ch) (write-char ch) (iter (read-char))))
+          (pop-input)
+          (let iter ((ch (read-char)))
+            (unless (eof-object? ch) (write-char ch) (iter (read-char))))
+          )))))
+
+(pass-if "input-stack/2"
+  (let ((sp (open-input-string "abc")))
+    (push-input sp)
+    (and (pop-input) (not (pop-input)))))
 
 (result 'report)