test: Add syntax tests.
authorJan Nieuwenhuizen <janneke@gnu.org>
Mon, 1 Jan 2018 14:53:13 +0000 (15:53 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 1 Jan 2018 14:53:13 +0000 (15:53 +0100)
* tests/syntax.test: New file.
* tests/syntax.test-guile: New file.

fixup: 1b0696f9 (Jan Nieuwenhuizen 2018-01-01 15:53:13 +0100 40) ,        (lambda ()

15 files changed:
check.sh
make.scm
module/mes/base-0.mes
module/mes/catch.mes
module/mes/guile.mes
module/mes/let.mes
module/mes/module.mes [new file with mode: 0644]
module/mes/read-0.mes
module/mes/repl.mes
src/lib.c
src/mes.c
tests/base.test-guile
tests/optargs.test
tests/syntax.test [new file with mode: 0755]
tests/syntax.test-guile [new symlink]

index 7494c38ea5b6c650a5b18198a19d33e16645f387..6312cf08af27a814c7599ff62ae119c4d17054c7 100755 (executable)
--- a/check.sh
+++ b/check.sh
@@ -1,5 +1,23 @@
 #! /bin/sh
 
+# Mes --- Maxwell Equations of Software
+# Copyright © 2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
 export GUILE=${GUILE-guile}
 export MES=${MES-./mes}
 
@@ -20,11 +38,12 @@ tests/srfi-14.test
 tests/optargs.test
 tests/fluids.test
 tests/catch.test
-tests/psyntax.test
+tests/record.test
+tests/syntax.test
 tests/pmatch.test
 tests/let-syntax.test
 tests/guile.test
-tests/record.test
+tests/psyntax.test
 "
 
 slow="
index af2b0843266e3c029d471ee1c829daef7524d7f6..3302c07ab11439269d4d90c849e4b7c62e6a1036 100755 (executable)
--- a/make.scm
+++ b/make.scm
@@ -3,6 +3,24 @@
 exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$@"}
 !#
 
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
 (use-modules (srfi srfi-26)
              (guix shell-utils))
 
@@ -464,13 +482,14 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
     "tests/optargs.test"
     "tests/fluids.test"
     "tests/catch.test"
-    "tests/psyntax.test"
+    "tests/record.test"
+    "tests/syntax.test"
     "tests/pmatch.test"
     "tests/let-syntax.test"
     "tests/guile.test"
-    "tests/record.test"
-    ;;sloooowwww
-    ;;"tests/match.test"
+    "tests/psyntax.test"
+    "tests/match.test"
+    ;;sloooowwww/broken?
     ;;"tests/peg.test"
     ))
 
@@ -494,6 +513,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
 ;; ...mes.guile passes :-)
 (for-each add-mes.guile-test mes-tests)
 
+(add-target (group "check-tests" #:dependencies (filter (target-prefix? "check-tests/") %targets)))
+
 ;; FIXME: run tests/base.test
 (setenv "MES" "src/mes.guile")
 
@@ -543,6 +564,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
    "module/mes/let.mes"
    "module/mes/match.mes"
    "module/mes/match.scm"
+   "module/mes/module.mes"
    "module/mes/optargs.mes"
    "module/mes/optargs.scm"
    "module/mes/peg.mes"
index 0334cc2871e8f963065b3251732c8c1bec45787f..7db153e508e1c8f7a773f93817234afc68600f64 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
 (define else #t)
 
 (define (cadr x) (car (cdr x)))
-(define-macro (simple-let bindings . rest)
-  (cons (cons 'lambda (cons (map1 car bindings) rest))
-        (map1 cadr bindings)))
 
 (define-macro (let bindings . rest)
-  (cons 'simple-let (cons bindings rest)))
+  (cons (cons 'lambda (cons (map1 car bindings) rest))
+        (map1 cadr bindings)))
 
 (define *input-ports* '())
 (define-macro (push! stack o)
   (if (null? (cdr lst)) (car lst)
       (string-append (car lst) infix (string-join (cdr lst) infix))))
 
-(define (module->file o)
-  (string-append (string-join (map1 symbol->string o) "/") ".mes"))
-
-(define *modules* '(mes/base-0.mes))
-(define (mes-load-module-env module a)
-  (push! *input-ports* (current-input-port))
-  (set-current-input-port (open-input-file (string-append %moduledir (module->file module))))
-  (let ((x (core:eval (append2 (cons 'begin (read-input-file-env a))
-                               '((current-module)))
-                      a)))
-    (set-current-input-port (pop! *input-ports*))
-    x))
-(define (not x)
-  (if x #f #t))
-(define-macro (mes-use-module module)
-  (list
-   'begin
-   (list 'if (list 'not (list 'memq (list string->symbol (module->file module)) '*modules*))
-         (list
-          'begin
-          (list 'set! '*modules* (list cons (list string->symbol (module->file module)) '*modules*))
-          (list 'load (list string-append '%moduledir (module->file module)))))))
+(include-from-path "mes/module.mes")
 
 (mes-use-module (mes base))
 (mes-use-module (srfi srfi-0))
 (mes-use-module (mes quasiquote))
 (mes-use-module (mes let))
+
 (mes-use-module (mes scm))
+
 (mes-use-module (srfi srfi-13))
-(mes-use-module (mes display))
 (mes-use-module (mes catch))
+
 (mes-use-module (mes posix))
+
index baf174a1245bea45f958a33073f815b1384237ba..31062898ceebfd6b77f57167204644ecce04f855 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
 
 (define %eh (make-fluid
              (lambda (key . args)
-               (format (current-error-port) "unhandled exception: ~a ~a\n" key args)
+               (if (defined? 'simple-format)
+                   (simple-format (current-error-port) "unhandled exception:~a:~a\n" key args)
+                   (begin
+                     (display "unhandled exception:" (current-error-port))
+                     (display key (current-error-port))
+                     (display ":" (current-error-port))
+                     (display args (current-error-port))
+                     (newline (current-error-port))))
                (exit 1))))
 
 (define (catch key thunk handler)
index 29fa9580966a3e1450e1b2cf0e3b902e41323c5a..a131bbaed688c4857a87c08f944c68289d17c6c9 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
           (if (access? file R_OK) `(load ,file)
               (loop (cdr path)))))))
 
+(mes-use-module (mes catch))
+(mes-use-module (mes posix))
 (mes-use-module (srfi srfi-16))
+(mes-use-module (mes display))
 
 (define (read-string)
   (define (read-string c)
@@ -58,7 +61,6 @@
 
 (define (port-filename p) "<stdin>")
 (define (port-line p) 0)
-(define (simple-format port format . rest) (map (lambda (x) (display x port)) rest))
 
 (define (with-input-from-string string thunk)
   (define save-peek-char peek-char)
index 3f89ed53d5537fd34b4b89e6779bb49f3997c347..a9b29fc16207412754a5db633dceb91e29848674 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
 (mes-use-module (mes base))
 (mes-use-module (mes quasiquote))
 
+(define-macro (simple-let bindings . rest)
+  (cons (cons 'lambda (cons (map1 car bindings) rest))
+        (map1 cadr bindings)))
+
 (define-macro (xsimple-let bindings rest)
   `(,`(lambda ,(map car bindings) ,@rest)
     ,@(map cadr bindings)))
      (set! ,name (lambda ,(map car bindings) ,@rest))
      (,name ,@(map cadr bindings))))
 
-;; IF
 (define-macro (let bindings-or-name . rest)
-  `(if ,(symbol? bindings-or-name) ;; IF
-       (xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
-       (xsimple-let ,bindings-or-name ,rest)))
+  (if (symbol? bindings-or-name)
+      `(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
+      `(xsimple-let ,bindings-or-name ,rest)))
 
 (define (expand-let* bindings body)
   (if (null? bindings)
diff --git a/module/mes/module.mes b/module/mes/module.mes
new file mode 100644 (file)
index 0000000..54cd7cd
--- /dev/null
@@ -0,0 +1,45 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(define (module->file o)
+  (string-append (string-join (map1 symbol->string o) "/") ".mes"))
+
+(define *modules* '(mes/base-0.mes))
+(define (mes-load-module-env module a)
+  (push! *input-ports* (current-input-port))
+  (set-current-input-port (open-input-file (string-append %moduledir (module->file module))))
+  (let ((x (core:eval (append2 (cons 'begin (read-input-file-env a))
+                               '((current-module)))
+                      a)))
+    (set-current-input-port (pop! *input-ports*))
+    x))
+
+(define-macro (mes-use-module module)
+  (list
+   'begin
+   (list 'if (list 'not (list 'memq (list string->symbol (module->file module)) '*modules*))
+         (list
+          'begin
+          (list 'set! '*modules* (list cons (list string->symbol (module->file module)) '*modules*))
+          (list 'load (list string-append '%moduledir (module->file module)))))))
index e7f99b7de3e6c39e6b072449f0e0e7b7fd23a639..019e7c582243e02d835bf069f82d24d6edd84051 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
 
   (define (newline . rest) (core:display (list->string (list (integer->char 10)))))
   (define (display x . rest) (if (null? rest) (core:display x)
-                                 (core:display x (car rest))))
+                                 (core:display-port x (car rest))))
   
   (define (list->symbol lst) (core:lookup-symbol lst))
 
index 3bb77785e1950f67dc367b9dfaad1293b75601af..06bbb30769bf80fda58cb864a45c200609ca08a6 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -111,7 +111,7 @@ along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 (define (repl)
   (let ((count 0)
         (print-sexp? #t))
-    
+
     (define (expand a)
       (lambda ()
         (let ((sexp (read)))
@@ -120,16 +120,16 @@ along with Mes.  If not, see <http://www.gnu.org/licenses/>.
                 (display sexp)
                 (display "]")
                 (newline))
-          (display (eval (list core:macro-expand sexp) a))
-          (newline))))
+          (core:macro-expand sexp))))
 
-    (define (help . x) (display help-commands))
+    (define (help . x) (display help-commands) *unspecified*)
     (define (show . x)
       (define topic-alist `((#\newline . ,show-commands)
                             (#\c . ,copying)
                             (#\w . ,warranty)))
       (let ((topic (read-char)))
-        (display (assoc-ref topic-alist topic))))
+        (display (assoc-ref topic-alist topic))
+        *unspecified*))
     (define (use a)
       (lambda ()
         (let ((module (read)))
@@ -155,22 +155,26 @@ along with Mes.  If not, see <http://www.gnu.org/licenses/>.
                 (display sexp)
                 (display "]")
                 (newline))
-              (cond ((and (pair? sexp) (eq? (car sexp) (string->symbol "unquote")))
-                     (let ((r (meta (cadr sexp) a)))
-                       (if (pair? r) (loop (append r a))
-                           (loop a))))
-                    ((and (pair? sexp) (eq? (car sexp) 'mes-use-module))
-                     (loop (mes-load-module-env (cadr sexp) a)))
-                    (else
-                     (let ((e (eval sexp a)))
-                       (if (eq? e *unspecified*) (loop a)
+              (if (and (pair? sexp) (eq? (car sexp) 'mes-use-module))
+                  (loop (mes-load-module-env (cadr sexp) a))
+                  (let ((e (if (and (pair? sexp) (eq? (car sexp) (string->symbol "unquote")))
+                               (meta (cadr sexp) a)
+                               (eval sexp a))))
+                    (if (eq? e *unspecified*) (loop a)
                            (let ((id (string->symbol (string-append "$" (number->string count)))))
                              (set! count (+ count 1))
                              (display id)
                              (display " = ")
                              (display e)
                              (newline)
-                             (loop (acons id e a))))))))))
+                             (loop (acons id e a)))))))))
         (lambda (key . args)
-          (format (current-error-port) "exception: ~a ~a\n" key args)
+          (if (defined? 'with-output-to-string)
+              (simple-format (current-error-port) "exception:~a:~a\n" key args)
+              (begin
+                (display "exception:" (current-error-port))
+                (display key (current-error-port))
+                (display ":" (current-error-port))
+                (display args (current-error-port))
+                (newline (current-error-port))))
           (loop a))))))
index 0ecbcc610c69b4052a2cc889b38d3cca21b87c86..a8f13dd9f12c046b8ee9285c4f9d2cbc45c736e5 100644 (file)
--- a/src/lib.c
+++ b/src/lib.c
@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of Mes.
  *
@@ -130,6 +130,13 @@ display_error_ (SCM x)
   return display_helper (x, 0, "", STDERR);
 }
 
+SCM
+display_port_ (SCM x, SCM p)
+{
+  assert (TYPE (p) == TNUMBER);
+  return fdisplay_ (x, VALUE (p));
+}
+
 SCM
 fdisplay_ (SCM x, int fd) ///((internal))
 {
index f89490e7af1cab2dcf23bfb45bec8bd80227c40a..70f5a6743390fba1d4b58dc66eda31dc03d56cf9 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of Mes.
  *
@@ -951,8 +951,8 @@ eval_apply ()
             }
           case cell_vm_macro_expand:
             {
-              push_cc (CADR (r1), r1, r0, cell_vm_return);
-              goto macro_expand;
+              push_cc (CADR (r1), r1, r0, cell_vm_macro_expand);
+              goto eval;
             }
           default: {
             push_cc (r1, r1, r0, cell_vm_eval_macro);
index 4b5bb6a7d27a1b1a0aad6a29615087b31680fecb..c4982d51f3e72a1d2f179170f531d97f5b8919f7 100755 (executable)
@@ -1,4 +1,23 @@
 #! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
 test=$(dirname $0)/$(basename $0 -guile)
 GUILE=${GUILE-guile}
 cat guile/mes-0.scm module/mes/test.mes $test | exec $GUILE -s /dev/stdin
index 974c67e60cd291170ff8b48145004067f9cfc707..f87e64e4863789da0fcbb1f15530e3ccc726554f 100755 (executable)
@@ -9,7 +9,7 @@ exit $?
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -122,7 +122,6 @@ exit $?
 ;;                    (make <info> #:functions functions #:globals globals #:locals locals #:text text)))))
 
 (define (clone o . rest)
-  (format (current-error-port) "clone rest=~a\n" rest)
   (cond ((info? o)
          (let ((functions (.functions o))
                (globals (.globals o))
diff --git a/tests/syntax.test b/tests/syntax.test
new file mode 100755 (executable)
index 0000000..df5962b
--- /dev/null
@@ -0,0 +1,64 @@
+#! /bin/sh
+# -*-scheme-*-
+MES=${MES-$(dirname $0)/../scripts/mes}
+echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@"
+#paredit:||
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (mes syntax))
+(mes-use-module (mes test))
+
+(pass-if "first dummy" #t)
+(pass-if-not "second dummy" #f)
+
+(pass-if "define-syntax when"
+  (sequal?
+   (let ()
+     (define-syntax sr:when
+       (syntax-rules ()
+         ((sc:when condition exp ...)
+          (if condition
+              (begin exp ...)))))
+     (let ()
+       (sr:when #t "if not now, then?")))
+   "if not now, then?"))
+
+(pass-if "define-syntax-rule"
+  (sequal?
+   (let ()
+     (define-syntax-rule (sre:when c e ...)
+       (if c (begin e ...)))
+     (let ()
+       (sre:when #t "if not now, then?")))
+   "if not now, then?"))
+
+(pass-if-equal "syntax-rules plus"
+    (+ 1 2 3)
+  (let ()
+    (define-syntax plus
+      (syntax-rules ()
+        ((plus x ...) (+ x ...))))
+    (plus 1 2 3)))
+
+(result 'report)
diff --git a/tests/syntax.test-guile b/tests/syntax.test-guile
new file mode 120000 (symlink)
index 0000000..5631f4a
--- /dev/null
@@ -0,0 +1 @@
+base.test-guile
\ No newline at end of file