wip! tests: Port to Mes.

tests/unit/lexer.scm

@@ -17,6 +17,8 @@
 ;;; along with Gash.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-lexer)
+  #:use-module (gash compat)
+  #:use-module (gash compat textual-ports)
   #:use-module (gash lexer)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-64)
@@ -347,7 +349,7 @@
   '((WORD (0 . 6) (<sh-cmd-sub> (<sh-exec> "foo"))))
   (parameterize ((read-bracketed-command
                   (lambda (port)
-                    (string-for-each (lambda _ (read-char port)) "foo")
+                    (string-for-each (lambda _ (get-char port)) "foo")
                     '((<sh-exec> "foo")))))
     (tokenize "$(foo)")))
 
@@ -359,7 +361,7 @@
   '((WORD (0 . 5) (<sh-cmd-sub> (<sh-exec> "foo"))))
   (parameterize ((read-backquoted-command
                   (lambda* (port #:key quoted?)
-                    (string-for-each (lambda _ (read-char port)) "foo")
+                    (string-for-each (lambda _ (get-char port)) "foo")
                     '((<sh-exec> "foo")))))
     (tokenize "`foo`")))
 
@@ -368,7 +370,7 @@
     (parameterize ((read-backquoted-command
                     (lambda* (port #:key quoted?)
                       (set! flag quoted?)
-                      (string-for-each (lambda _ (read-char port)) "foo")
+                      (string-for-each (lambda _ (get-char port)) "foo")
                       '((<sh-exec> "foo")))))
       (tokenize "`foo`"))
     (not flag)))
@@ -378,7 +380,7 @@
     (parameterize ((read-backquoted-command
                     (lambda* (port #:key quoted?)
                       (set! flag quoted?)
-                      (string-for-each (lambda _ (read-char port)) "foo")
+                      (string-for-each (lambda _ (get-char port)) "foo")
                       '((<sh-exec> "foo")))))
       (tokenize "\"`foo`\""))
     flag))

tests/unit/parser.scm

@@ -17,6 +17,7 @@
 ;;; along with Gash.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-parser)
+  #:use-module (gash compat)
   #:use-module (gash parser)
   #:use-module (srfi srfi-64)
   #:use-module (tests unit automake))

tests/unit/shell.scm

@@ -33,6 +33,13 @@
 ;;;
 ;;; 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)
   (let loop ((name (tmpnam)))
     (catch 'system-error

tests/unit/word.scm

@@ -22,6 +22,7 @@
 ;;; along with Gash.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-word)
+  #:use-module (gash compat)
   #:use-module (gash environment)
   #:use-module (gash word)
   #:use-module (ice-9 i18n)
@@ -36,6 +37,14 @@
 ;;;
 ;;; 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 ...)
   "Within @var{body}, replace the definition of @var{proc} from
 @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 ...))
       (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")