wip! tests: Port to Mes.
This commit is contained in:
parent
f514554aee
commit
674ded5766
|
@ -17,6 +17,8 @@
|
||||||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (test-lexer)
|
(define-module (test-lexer)
|
||||||
|
#:use-module (gash compat)
|
||||||
|
#:use-module (gash compat textual-ports)
|
||||||
#:use-module (gash lexer)
|
#:use-module (gash lexer)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
|
@ -347,7 +349,7 @@
|
||||||
'((WORD (0 . 6) (<sh-cmd-sub> (<sh-exec> "foo"))))
|
'((WORD (0 . 6) (<sh-cmd-sub> (<sh-exec> "foo"))))
|
||||||
(parameterize ((read-bracketed-command
|
(parameterize ((read-bracketed-command
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(string-for-each (lambda _ (read-char port)) "foo")
|
(string-for-each (lambda _ (get-char port)) "foo")
|
||||||
'((<sh-exec> "foo")))))
|
'((<sh-exec> "foo")))))
|
||||||
(tokenize "$(foo)")))
|
(tokenize "$(foo)")))
|
||||||
|
|
||||||
|
@ -359,7 +361,7 @@
|
||||||
'((WORD (0 . 5) (<sh-cmd-sub> (<sh-exec> "foo"))))
|
'((WORD (0 . 5) (<sh-cmd-sub> (<sh-exec> "foo"))))
|
||||||
(parameterize ((read-backquoted-command
|
(parameterize ((read-backquoted-command
|
||||||
(lambda* (port #:key quoted?)
|
(lambda* (port #:key quoted?)
|
||||||
(string-for-each (lambda _ (read-char port)) "foo")
|
(string-for-each (lambda _ (get-char port)) "foo")
|
||||||
'((<sh-exec> "foo")))))
|
'((<sh-exec> "foo")))))
|
||||||
(tokenize "`foo`")))
|
(tokenize "`foo`")))
|
||||||
|
|
||||||
|
@ -368,7 +370,7 @@
|
||||||
(parameterize ((read-backquoted-command
|
(parameterize ((read-backquoted-command
|
||||||
(lambda* (port #:key quoted?)
|
(lambda* (port #:key quoted?)
|
||||||
(set! flag quoted?)
|
(set! flag quoted?)
|
||||||
(string-for-each (lambda _ (read-char port)) "foo")
|
(string-for-each (lambda _ (get-char port)) "foo")
|
||||||
'((<sh-exec> "foo")))))
|
'((<sh-exec> "foo")))))
|
||||||
(tokenize "`foo`"))
|
(tokenize "`foo`"))
|
||||||
(not flag)))
|
(not flag)))
|
||||||
|
@ -378,7 +380,7 @@
|
||||||
(parameterize ((read-backquoted-command
|
(parameterize ((read-backquoted-command
|
||||||
(lambda* (port #:key quoted?)
|
(lambda* (port #:key quoted?)
|
||||||
(set! flag quoted?)
|
(set! flag quoted?)
|
||||||
(string-for-each (lambda _ (read-char port)) "foo")
|
(string-for-each (lambda _ (get-char port)) "foo")
|
||||||
'((<sh-exec> "foo")))))
|
'((<sh-exec> "foo")))))
|
||||||
(tokenize "\"`foo`\""))
|
(tokenize "\"`foo`\""))
|
||||||
flag))
|
flag))
|
||||||
|
|
|
@ -17,6 +17,7 @@
|
||||||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (test-parser)
|
(define-module (test-parser)
|
||||||
|
#:use-module (gash compat)
|
||||||
#:use-module (gash parser)
|
#:use-module (gash parser)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (tests unit automake))
|
#:use-module (tests unit automake))
|
||||||
|
|
|
@ -33,6 +33,13 @@
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
|
(cond-expand
|
||||||
|
(mes
|
||||||
|
;; These tests are too hard to port.
|
||||||
|
(display "Shell tests are not supported on Mes\n")
|
||||||
|
(exit 0))
|
||||||
|
(else))
|
||||||
|
|
||||||
(define (make-temporary-directory)
|
(define (make-temporary-directory)
|
||||||
(let loop ((name (tmpnam)))
|
(let loop ((name (tmpnam)))
|
||||||
(catch 'system-error
|
(catch 'system-error
|
||||||
|
|
|
@ -22,6 +22,7 @@
|
||||||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (test-word)
|
(define-module (test-word)
|
||||||
|
#:use-module (gash compat)
|
||||||
#:use-module (gash environment)
|
#:use-module (gash environment)
|
||||||
#:use-module (gash word)
|
#:use-module (gash word)
|
||||||
#:use-module (ice-9 i18n)
|
#:use-module (ice-9 i18n)
|
||||||
|
@ -36,6 +37,14 @@
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
|
(cond-expand
|
||||||
|
(mes
|
||||||
|
(define string-locale<? string<)
|
||||||
|
(define-macro (define-syntax-rule . rest)
|
||||||
|
;; Just ignore the definitions on Mes.
|
||||||
|
#f))
|
||||||
|
(else))
|
||||||
|
|
||||||
(define-syntax-rule (mock (module proc replacement) body ...)
|
(define-syntax-rule (mock (module proc replacement) body ...)
|
||||||
"Within @var{body}, replace the definition of @var{proc} from
|
"Within @var{body}, replace the definition of @var{proc} from
|
||||||
@var{module} with the definition given by @var{replacement}."
|
@var{module} with the definition given by @var{replacement}."
|
||||||
|
@ -106,6 +115,35 @@ variable @var{PWD} will be restored when leaving the extent of
|
||||||
body ...))
|
body ...))
|
||||||
(lambda () (setvar! "PWD" saved-pwd)))))
|
(lambda () (setvar! "PWD" saved-pwd)))))
|
||||||
|
|
||||||
|
(cond-expand
|
||||||
|
(mes
|
||||||
|
;; Mes has trouble with the mocking syntax above, so here's a
|
||||||
|
;; (terrifying) shim.
|
||||||
|
(define %files (list #t))
|
||||||
|
(define %scandir (make-pure-scandir %files "/"))
|
||||||
|
(module-set! (resolve-interface '(ice-9 ftw)) 'scandir %scandir)
|
||||||
|
|
||||||
|
(define (set-pair! dst src)
|
||||||
|
(set-car! dst (car src))
|
||||||
|
(set-cdr! dst (cdr src)))
|
||||||
|
|
||||||
|
(define-macro (with-mocked-files files . body)
|
||||||
|
(let ((saved-pwd (gensym))
|
||||||
|
(saved-files (gensym)))
|
||||||
|
`(let ((,saved-pwd #f)
|
||||||
|
(,saved-files (list #t)))
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda ()
|
||||||
|
(set! ,saved-pwd (getvar "PWD"))
|
||||||
|
(set-pair! ,saved-files %files)
|
||||||
|
(set-pair! %files ,files))
|
||||||
|
(lambda ()
|
||||||
|
,@body)
|
||||||
|
(lambda ()
|
||||||
|
(set-pair! %files ,saved-files)
|
||||||
|
(setvar! "PWD" ,saved-pwd)))))))
|
||||||
|
(else))
|
||||||
|
|
||||||
(test-begin "word")
|
(test-begin "word")
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue