tests: Move (ice-9 syncase) into cond-expand.
[mes.git] / tests / psyntax.test
index 4b8d21f64c55b1c57742be976e759a8033866ef4..c3c3127e8d01aa12cb58062cb5b9db88369410ac 100755 (executable)
@@ -1,6 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
+echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
 #paredit:||
 exit $?
 !#
@@ -25,28 +25,20 @@ exit $?
 ;;; 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 base-0))
-(mes-use-module (mes base))
-(mes-use-module (mes quasiquote))
-(mes-use-module (mes let))
-(mes-use-module (srfi srfi-0))
-(mes-use-module (mes scm))
-(mes-use-module (mes psyntax-0))
-(mes-use-module (mes psyntax-pp))
-(mes-use-module (mes psyntax-1))
-(mes-use-module (mes test))
-
-(pass-if "first dummy" #t)
-(pass-if-not "second dummy" #f)
-
 (cond-expand
- (guile
-  ;;(use-modules (ice-9 syncase))
+ (guile-2
   (define sc-expand identity)
   (define syntax-object->datum syntax->datum)
-  (define datum->syntax-object datum->syntax)
-  )
- (mes))
+  (define datum->syntax-object datum->syntax))
+ (guile
+  (use-modules (ice-9 syncase))
+  (define sc-expand identity))
+ (mes
+  (mes-use-module (mes psyntax))
+  (mes-use-module (mes test))))
+
+(pass-if "first dummy" #t)
+(pass-if-not "second dummy" #f)
 
 (when (not guile?)
  (pass-if "andmap"
@@ -177,4 +169,40 @@ exit $?
                  body ...)))))
       (string-let foo (list foo foo)))))
 
+  ;; (pass-if-equal "custom ellipsis within normal ellipsis"
+  ;;     '((((a x) (a y) (a …))
+  ;;        ((b x) (b y) (b …))
+  ;;        ((c x) (c y) (c …)))
+  ;;       (((a x) (b x) (c x))
+  ;;        ((a y) (b y) (c y))
+  ;;        ((a …) (b …) (c …))))
+  ;;   (let ()
+  ;;     (define-syntax foo
+  ;;       (syntax-rules ()
+  ;;         ((_ y ...)
+  ;;          (syntax-rules … ()
+  ;;            ((_ x …)
+  ;;             '((((x y) ...) …)
+  ;;               (((x y) …) ...)))))))
+  ;;     (define-syntax bar (foo x y …))
+  ;;     (bar a b c)))
+
+(let ()
+ (define-syntax define-quotation-macros
+   (lambda (x)
+     (syntax-case x ()
+       ((_ (macro-name head-symbol) ...)
+        #'(begin (define-syntax macro-name
+                   (lambda (x)
+                     (with-ellipsis :::
+                                    (syntax-case x ()
+                                      ((_ x :::)
+                                       #'(quote (head-symbol x :::)))))))
+                 ...)))))
+ (define-quotation-macros (quote-a a) (quote-b b) (quote-c c))
+
+ (pass-if-equal "with-ellipsis"
+     '(a 1 2 3)
+     (quote-a 1 2 3)))
+
 (result 'report)