test: Add pmatch tests.

* tests/pmatch.test: New file.
* GNUmakefile (TESTS): Add it.

diff --git a/GNUmakefile b/GNUmakefile
index 3a2317dbc573200951df9d27601bdd4796844f4c..f14c522d393f740b6c83944accecdb020ef456d2 100644 (file)
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -71,6 +71,7 @@ TESTS:=\
  tests/fluids.test\
  tests/catch.test\
  tests/psyntax.test\
  tests/fluids.test\
  tests/catch.test\
  tests/psyntax.test\

+ tests/pmatch.test\

  tests/let-syntax.test\
  tests/record.test\
  tests/match.test\
  tests/let-syntax.test\
  tests/record.test\
  tests/match.test\

diff --git a/tests/pmatch.test b/tests/pmatch.test
new file mode 100755 (executable)
index 0000000..f59b66d
--- /dev/null
+++ b/tests/pmatch.test
@@ -0,0 +1,66 @@
+#! /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 © 2017 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/>.
+
+(cond-expand
+ (guile
+  (use-modules (system base pmatch)))
+ (mes
+  (mes-use-module (mes test))
+  (mes-use-module (mes pmatch))))
+
+(pass-if "first dummy" #t)
+(pass-if-not "second dummy" #f)
+
+(pass-if-equal "pmatch" 0
+               (let ((o 0))
+                 (pmatch o
+                   (_ o))))
+
+(pass-if-equal "pmatch" "main"
+               (let ((ast '(fctn-defn
+                            (decl-spec-list (type-spec (fixed-type "int")))
+                            (ftn-declr
+                             (ident "main")
+                             (param-list
+                              (param-decl
+                               (decl-spec-list (type-spec (fixed-type "int")))
+                               (param-declr (ident "argc")))
+                              (param-decl
+                               (decl-spec-list (type-spec (fixed-type "char")))
+                               (param-declr
+                                (ptr-declr (pointer) (array-of (ident "argv")))))))
+                            (compd-stmt
+                             (block-item-list
+                              (if (gt (p-expr (ident "argc")) (p-expr (fixed "1")))
+                                  (return (p-expr (ident "argc"))))
+                              (return (p-expr (fixed "42"))))))))
+                 (pmatch ast
+                   ((fctn-defn _ (ftn-declr (ident ,name) _) _) name)
+                   (_ 'bla))))
+
+(result 'report)