artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

nyacc cpp-debugging, tests

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2018-01-02 20:41:59 +01:00
parent b354da6f02
commit 5757ef3069
3 changed files with 87 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
module/mes/guile.mes
View file

@ -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)

33
module/mes/guile.scm
View file

@ -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

47
tests/guile.test
View file

@ -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"
(let ()
(push-input (open-input-string "bla"))
(let ((ch (read-char)))
(unread-char ch))
(let ((x (read-string)))
(let ((pop (pop-input)))
x))))
"bla"
(let ()
(push-input (open-input-string "bla"))
(let ((ch (read-char)))
(unread-char ch))
(let ((x (read-string)))
(let ((pop (pop-input)))
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)