work

1 files changed, 203 insertions, 76 deletions

diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index 3d62e224..75e29834 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -4,29 +4,27 @@
   :use-module (srfi srfi-64 test-error)
   :use-module (srfi srfi-71)
   :use-module (srfi srfi-88)
-  :use-module ((hnh util) :select (unval))
+  :use-module ((hnh util) :select (-> unval))
   :use-module (c preprocessor2)
   :use-module (c cpp-environment)
   :use-module (c cpp-environment function-like-macro)
   :use-module (c cpp-environment object-like-macro)
   :use-module (c lex2))
 
-;; TODO Not yet implemented
-;; (test-expect-fail (test-match-group "Stringify"))
-;; (test-expect-fail
-;;  (test-match-all (test-match-group "Expand stringifiers")
-;;                  (test-match-name "Correct stringification of one param")))
 
+;; arbitrary tokens useful in tests for checking that values are returned correctly
+(define before (car (lex "before")))
+(define after (car (lex "after")))
 
 (define tokens-until-eol (@@ (c preprocessor2) tokens-until-eol))
 (test-group "Tokens until End Of Line"
   (call-with-values
       (lambda ()
         (tokens-until-eol
-         '(before (whitespace "\n") after)))
+         (list before '(whitespace "\n") after)))
     (lambda (bef aft)
-      (test-equal '(before) bef)
-      (test-equal '((whitespace "\n") after) aft))))
+      (test-equal (list before) bef)
+      (test-equal (list '(whitespace "\n") after) aft))))
 
 
 
@@ -178,7 +176,7 @@
 
   (test-group "Rest arguments"
     (test-equal "Single simple"
-      `(("__VA_ARGS__" . ,(list (lex "x"))))
+      `(("__VA_ARGS__" . ,(lex "x")))
       (let ((m (function-like-macro
                 identifier: "str"
                 identifier-list: '()
@@ -187,18 +185,15 @@
         (build-parameter-map
          m (list (lex "x")))))
 
-    #;
     (test-equal "Two simple"
-      '()
+      `(("__VA_ARGS__" . ,(lex "x,y")))
       (let ((m (function-like-macro
                 identifier: "str"
                 identifier-list: '()
                 variadic?: #t
                 body: '())))
         (build-parameter-map
-         m (list (lex "x")))))
-    ))
-
+         m (list (lex "x,y")))))))
 
 
 (test-group "Expand stringifiers"
@@ -250,18 +245,20 @@
 
   (test-group "Object likes"
     (test-equal "Expansion of single token"
-        (lex "10") (resolve-token-stream (extend-environment (make-environment)
-                                                             (list (object-like-macro
-                                                                    identifier: "x"
-                                                                    body: (lex "10"))))
-                                         (lex "x")))
+      (lex "10")
+      (resolve-token-stream (extend-environment (make-environment)
+                                                (list (object-like-macro
+                                                       identifier: "x"
+                                                       body: (lex "10"))))
+                            (lex "x")))
 
     (test-equal "Expansion keeps stuff after"
-      (lex "10 1") (resolve-token-stream (extend-environment (make-environment)
-                                                           (list (object-like-macro
-                                                                  identifier: "x"
-                                                                  body: (lex "10"))))
-                                         (lex "x 1")))
+      (lex "10 1")
+      (resolve-token-stream (extend-environment (make-environment)
+                                                (list (object-like-macro
+                                                       identifier: "x"
+                                                       body: (lex "10"))))
+                            (lex "x 1")))
 
     (test-equal "Multiple object like macros in one stream"
       (lex "10 20")
@@ -272,8 +269,7 @@
                                                       (object-like-macro
                                                        identifier: "y"
                                                        body: (lex "20"))))
-                            (lex "x y")))
-    )
+                            (lex "x y"))))
 
   ;; TODO
 
@@ -314,42 +310,40 @@
       ))
 
 
-(test-group "Maybe extend identifier"
-  (test-equal "Non-identifier returns remaining"
-    '() ((unval maybe-extend-identifier 1)
-         (make-environment)
-         "x"
-         '()))
-
-  (test-equal "Non-identifiers remaining tokens are returned verbatim"
-    '(remaining) ((unval maybe-extend-identifier 1)
-                  (make-environment)
-                  "x"
-                  '(remaining)))
-
-  (test-equal "Object like identifier expands"
-    (lex "1 + 2")
-    ((unval maybe-extend-identifier 1)
-     (extend-environment (make-environment)
-                         (list
-                          (object-like-macro
-                           identifier: "x"
-                           body: (lex "1 + 2"))))
-     "x"
-     '()))
-
-  (test-equal "Object like macro still returns remaining verbatim"
-    (append (lex "1 + 2") '(remaining))
-    ((unval maybe-extend-identifier 1)
-     (extend-environment (make-environment)
-                         (list
-                          (object-like-macro
-                           identifier: "x"
-                           body: (lex "1 + 2"))))
-     "x"
-     '(remaining)))
+  (test-group "Maybe extend identifier"
+    (test-equal "Non-identifier returns remaining"
+      (lex "x")
+      ((unval maybe-extend-identifier 1)
+       (make-environment) "x" '()))
+
+    (test-equal "Non-identifiers remaining tokens are returned verbatim"
+      (append (lex "x") (list after))
+      ((unval maybe-extend-identifier 1)
+       (make-environment) "x" (list after)))
+
+    (test-equal "Object like identifier expands"
+      (lex "1 + 2")
+      ((unval maybe-extend-identifier 1)
+       (extend-environment (make-environment)
+                           (list
+                            (object-like-macro
+                             identifier: "x"
+                             body: (lex "1 + 2"))))
+       "x"
+       '()))
 
-  )
+    (test-equal "Object like macro still returns remaining verbatim"
+      (append (lex "1 + 2") (list after))
+      ((unval maybe-extend-identifier 1)
+       (extend-environment (make-environment)
+                           (list
+                            (object-like-macro
+                             identifier: "x"
+                             body: (lex "1 + 2"))))
+       "x"
+       (list after)))
+
+    )
 
   (test-group "Apply macro"
     (test-equal "zero arg macro on nothing"
@@ -368,23 +362,156 @@
        (function-like-macro identifier: "f"
                             identifier-list: '("x")
                             body: (lex "x"))
-       (lex "10"))))
+       ((unval parse-parameter-list) (lex "(10)"))))
+
+    (test-equal "Two arg macro"
+      (lex "10 + 20")
+      (apply-macro
+       (make-environment)
+       (function-like-macro identifier: "f"
+                            identifier-list: '("x" "y")
+                            body: (lex "x + y"))
+       ((unval parse-parameter-list) (lex "(10, 20)")))))
 
   (test-group "Expand macro part 2"
     (test-group "Function like macros"
-      (let ((e (make-environment))
-            (m (function-like-macro
-                identifier: "f"
-                identifier-list: '()
-                body: (lex "1"))))
-        (call-with-values (lambda () (expand-macro e m (lex "()")))
-          (lambda (_ tokens*) (test-equal (lex "1") tokens*)))
-        ;; TODO this should raise an arity error
-        (call-with-values (lambda () (expand-macro e m (lex "(10)")))
-          (lambda (_ tokens*) (test-equal '() tokens*)))))))
+      (let ((e (make-environment)))
+        (let ((m (function-like-macro
+                  identifier: "f"
+                  identifier-list: '()
+                  body: (lex "1"))))
+          (call-with-values (lambda () (expand-macro e m (lex "()")))
+            (lambda (_ tokens*) (test-equal (lex "1") tokens*)))
+          (test-error "Arity error for to many args"
+            'cpp-arity-error (expand-macro e m (lex "(10)"))))
+        (let ((m (function-like-macro
+                  identifier: "f"
+                  identifier-list: '("x")
+                  variadic?: #t
+                  body: (lex "__VA_ARGS__ x"))))
+          (call-with-values (lambda () (expand-macro e m (lex "(1)")))
+            (lambda (_ tokens*) (test-equal (lex " 1") tokens*)))
+          (test-error "Arity error on too few args (with variadic)"
+            'cpp-arity-error (expand-macro e m (lex "()")))
+          (call-with-values (lambda () (expand-macro e m (lex "(1,2,3)")))
+            (lambda (_ tokens*) (test-equal (lex "2,3 1") tokens*)))
+          )
+        ))))
+
+(let ((e (make-environment)))
+  (test-group "Resolve token stream with function likes"
+    (test-equal "Macro expanding to its parameter"
+      (lex "0")
+      (resolve-token-stream
+       (extend-environment
+        e (list (function-like-macro identifier: "f"
+                                     identifier-list: '("x")
+                                     body: (lex "x"))))
+       (lex "f(0)")))
+
+    (test-equal "Macro expanding parameter multiple times"
+      (lex "(2) * (2)")
+      (resolve-token-stream
+       (extend-environment
+        e (list (function-like-macro identifier: "f"
+                                     identifier-list: '("x")
+                                     body: (lex "(x) * (x)"))))
+       (lex "f(2)"))
+      )
+
+    (test-equal "Object like contains another object like"
+      (lex "z")
+      (resolve-token-stream
+       (extend-environment
+        e (list (object-like-macro identifier: "x"
+                                   body: (lex "y"))
+                (object-like-macro identifier: "y"
+                                   body: (lex "z"))))
+       (lex "x")))
+
+    (test-equal "function like contains another macro"
+      (lex "10")
+      (resolve-token-stream
+       (extend-environment
+        e (list (function-like-macro identifier: "f"
+                                     identifier-list: '("x")
+                                     body: (lex "g(x)"))
+                (function-like-macro identifier: "g"
+                                     identifier-list: '("y")
+                                     body: (lex "y"))))
+       (lex "f(10)")))
+
+    "
+#define f(x) g(x)
+#define g(y) y
+f(10)
+"
+
+    (test-equal "function like containing another macro using the same parameter name"
+      (lex "10")
+      (resolve-token-stream
+       (extend-environment
+        e (list (function-like-macro identifier: "f"
+                                     identifier-list: '("x")
+                                     body: (lex "g(x)"))
+                (function-like-macro identifier: "g"
+                                     identifier-list: '("x")
+                                     body: (lex "x"))))
+       (lex "f(10)")))
+
+
+
+    (test-equal "function like contains another macro"
+      (lex "10 * 2 + 20 * 2 + 30")
+      (resolve-token-stream
+       (extend-environment
+        e (list (function-like-macro identifier: "f"
+                                     identifier-list: '("x" "y")
+                                     body: (lex "g(x) + g(y)"))
+                (function-like-macro identifier: "g"
+                                     identifier-list: '("x")
+                                     body: (lex "x * 2"))))
+       (lex "f(10, 20) + 30")))))
+
+(let ((e (extend-environment
+          (make-environment)
+          (list (@@ (c preprocessor2) defined-macro)))))
+  (test-group "defined() macro"
+    (test-equal "defined(NOT_DEFINED)"
+      (lex "0") (resolve-token-stream e (lex "defined(X)")))
+    (test-equal "defined(DEFINED)"
+      (lex "1") (resolve-token-stream
+                 (extend-environment
+                  e (list (object-like-macro identifier: "X"
+                                             body: (lex "10"))))
+                 (lex "defined(X)")))))
+
+
+(let ((env (resolve-define (make-environment)
+                           (lex "f(x) x+1"))))
+  (test-assert "New binding added" (in-environment? env "f"))
+  (let ((m (get-identifier env "f")))
+    (test-equal "Macro parameters" '("x") (macro-identifier-list m))
+    (test-equal "Macro body" (lex "x+1") (macro-body m))))
+
+;; This should issue a warning, since the standard requires a space after the ending parenthe here (6.10.3)
+;; (resolve-define (make-environment)
+;;                 (lex "f(x)x+1"))
 
-(define apply-macro (@@ (c preprocessor2) apply-macro))
+;; (let ((env (resolve-define (make-environment)
+;;                            (lex "x x"))))
+;;   (test-equal "Macro expanding to itself leaves the token"
+;;     (lex "x")
+;;     (resolve-token-stream env (lex "x"))))
 
+(let ((env (-> (make-environment)
+               (resolve-define (lex "f(a) a*g"))
+               (resolve-define (lex "g(a) f(a)")))))
+  (test-equal '()
+   (resolve-token-stream env (lex "f(2)(9)"))))
 
-;; (resolve-define (make-environment)
-;;                 (lex "f(x) x+1"))
+
+
+;; resolve-h-file
+;; resolve-q-file
+;; handle-pragma