From c1cf0693982d9c1f1b871966752140fee5d76d19 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 13 Jul 2022 04:39:14 +0200
Subject: work

---
 tests/test/cpp/preprocessor2.scm | 281 ++++++++++++++++++++-------------------
 1 file changed, 141 insertions(+), 140 deletions(-)

(limited to 'tests/test')

diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index 182390c6..39bbd39c 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -23,9 +23,12 @@
                         tokens-until-eol
                         squeeze-whitespace
                         cleanup-whitespace
+                        next-token-matches?
                         ))
   :use-module ((c unlex)
                :select (
+                        unlex
+                        unlex-aggressive
                         stringify-token
                         stringify-tokens
                         )
@@ -35,7 +38,13 @@
   :use-module (c lex2)
   )
 
-;; (test-expect-fail "x ## y")
+;; TODO Redefinition code isn't yet written
+(test-skip "Example 6")
+
+;; See (c preprocessor2) TODO#1
+(test-expect-fail (test-match-group
+                   "6.10.3.5 Scope of macro definitions"
+                   "Example 3"))
 
 (define apply-macro (@@ (c preprocessor2) apply-macro))
 (define build-parameter-map (@@ (c preprocessor2) build-parameter-map))
@@ -55,6 +64,7 @@
 
 
 ;; Remove the noexpand list from each token.
+
 ;; Allows equal? with fresh tokens
 (define (remove-noexpand tokens)
   ;; (typecheck tokens (list-of token?))
@@ -258,9 +268,6 @@
       (lex "\"10, 20\"")
       (expand# m (build-parameter-map m (list (lex "10, 20")))))))
 
-;; TODO expand-join
-;; token ## token2
-
 
 (let ((e (join-file-line (make-environment))))
   (test-equal "__FILE__ default value"
@@ -276,52 +283,47 @@
 (test-group "Token streams"
   (test-group "Non-expanding"
     (test-equal "Null stream"
-      '() (resolve-token-stream (make-environment) '()))
+      '() ((unval resolve-token-stream 1) (make-environment) '()))
     (test-equal "Constant resolve to themselves"
-      (lex "1") (resolve-token-stream (make-environment) (lex "1")))
+      (lex "1") ((unval resolve-token-stream 1) (make-environment) (lex "1")))
     (test-equal "Identifier-likes not in environment stay put"
-      (lex "x") (remove-noexpand (resolve-token-stream (make-environment) (lex "x"))))
+      (lex "x") (remove-noexpand ((unval resolve-token-stream 1) (make-environment) (lex "x"))))
     (test-equal "Identifier-likes with stuff after keep stuff after"
-      (lex "x 1") (remove-noexpand (resolve-token-stream (make-environment) (lex "x 1")))))
+      (lex "x 1") (remove-noexpand ((unval resolve-token-stream 1) (make-environment) (lex "x 1")))))
 
   (test-group "Object likes"
     (test-equal "Expansion of single token"
       (lex "10")
       (remove-noexpand
-       (resolve-token-stream (extend-environment (make-environment)
-                                                 (list (object-like-macro
-                                                        identifier: "x"
-                                                        body: (lex "10"))))
-                             (lex "x"))))
+       ((unval resolve-token-stream 1)
+        (extend-environment (make-environment)
+                            (list (object-like-macro
+                                   identifier: "x"
+                                   body: (lex "10"))))
+        (lex "x"))))
 
     (test-equal "Expansion keeps stuff after"
       (lex "10 1")
       (remove-noexpand
-       (resolve-token-stream (extend-environment (make-environment)
-                                                 (list (object-like-macro
-                                                        identifier: "x"
-                                                        body: (lex "10"))))
-                             (lex "x 1"))))
+       ((unval resolve-token-stream 1)
+        (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")
       (remove-noexpand
-       (resolve-token-stream (extend-environment (make-environment)
-                                                 (list (object-like-macro
-                                                        identifier: "x"
-                                                        body: (lex "10"))
-                                                       (object-like-macro
-                                                        identifier: "y"
-                                                        body: (lex "20"))))
-                             (lex "x y")))))
-
-  ;; TODO
-
-  ;; (test-group "Function likes")
-
-  ;; (test-group "Mix of object and function likes")
-
-  )
+       ((unval resolve-token-stream 1)
+        (extend-environment (make-environment)
+                            (list (object-like-macro
+                                   identifier: "x"
+                                   body: (lex "10"))
+                                  (object-like-macro
+                                   identifier: "y"
+                                   body: (lex "20"))))
+        (lex "x y"))))))
 
 
 (test-group "Macro expansion"
@@ -449,7 +451,7 @@
   (test-group "Resolve token stream with function likes"
     (test-equal "Macro expanding to its parameter"
       (lex "0")
-      (remove-noexpand (resolve-token-stream
+      (remove-noexpand ((unval resolve-token-stream 1)
                         (extend-environment
                          e (list (function-like-macro identifier: "f"
                                                       identifier-list: '("x")
@@ -458,7 +460,7 @@
 
     (test-equal "Macro expanding parameter multiple times"
       (lex "(2) * (2)")
-      (remove-noexpand (resolve-token-stream
+      (remove-noexpand ((unval resolve-token-stream 1)
                         (extend-environment
                          e (list (function-like-macro identifier: "f"
                                                       identifier-list: '("x")
@@ -468,7 +470,7 @@
 
     (test-equal "Object like contains another object like"
       (lex "z")
-      (remove-noexpand (resolve-token-stream
+      (remove-noexpand ((unval resolve-token-stream 1)
                         (extend-environment
                          e (list (object-like-macro identifier: "x"
                                                     body: (lex "y"))
@@ -478,7 +480,7 @@
 
     (test-equal "function like contains another macro"
       (lex "10")
-      (remove-noexpand (resolve-token-stream
+      (remove-noexpand ((unval resolve-token-stream 1)
                         (extend-environment
                          e (list (function-like-macro identifier: "f"
                                                       identifier-list: '("x")
@@ -491,7 +493,7 @@
 
     (test-equal "function like containing another macro using the same parameter name"
       (lex "10")
-      (remove-noexpand (resolve-token-stream
+      (remove-noexpand ((unval resolve-token-stream 1)
                         (extend-environment
                          e (list (function-like-macro identifier: "f"
                                                       identifier-list: '("x")
@@ -505,7 +507,7 @@
 
     (test-equal "function like contains another macro"
       (lex "10 * 2 + 20 * 2 + 30")
-      (remove-noexpand (resolve-token-stream
+      (remove-noexpand ((unval resolve-token-stream 1)
                         (extend-environment
                          e (list (function-like-macro identifier: "f"
                                                       identifier-list: '("x" "y")
@@ -520,9 +522,9 @@
           (list (@ (c preprocessor2) defined-macro)))))
   (test-group "defined() macro"
     (test-equal "defined(NOT_DEFINED)"
-      (lex "0") (remove-noexpand (resolve-token-stream e (lex "defined(X)"))))
+      (lex "0") (remove-noexpand ((unval resolve-token-stream 1) e (lex "defined(X)"))))
     (test-equal "defined(DEFINED)"
-      (lex "1") (remove-noexpand (resolve-token-stream
+      (lex "1") (remove-noexpand ((unval resolve-token-stream 1)
                                   (extend-environment
                                    e (list (object-like-macro identifier: "X"
                                                               body: (lex "10"))))
@@ -545,7 +547,7 @@
                              (lex "x x"))))
     (test-equal "Macro expanding to itself leaves the token"
       (mark-noexpand (lex "x") "x")
-      (resolve-token-stream env (lex "x"))))
+      ((unval resolve-token-stream 1) env (lex "x"))))
 
   ;; Test from C standard 6.10.3.4 p. 4
   ;; Both the expansion "2*f(9)" and "2*9*g" are valid.
@@ -555,21 +557,21 @@
                  (resolve-define (lex "g(a) f(a)")))))
     (test-equal "Mutual recursion with two function like macros"
       (lex "2*f(9)")
-      (remove-noexpand (resolve-token-stream env (lex "f(2)(9)")))))
+      (remove-noexpand ((unval resolve-token-stream 1) env (lex "f(2)(9)")))))
 
   (let ((env (-> (make-environment)
                  (resolve-define (lex "f 2 * g"))
                  (resolve-define (lex "g(x) x + f")))))
     (test-equal "Mutual recursion with object and function like macro"
       (lex "2 * 10 + f")
-      (remove-noexpand (resolve-token-stream env (lex "f(10)")))))
+      (remove-noexpand ((unval resolve-token-stream 1) env (lex "f(10)")))))
 
   (let ((env (-> (make-environment)
                  (resolve-define (lex "x 2*y"))
                  (resolve-define (lex "y 3*x")))))
     (test-equal "Mutual recursion with two object likes"
       (lex "2*3*x")
-      (remove-noexpand (resolve-token-stream env (lex "x"))))))
+      (remove-noexpand ((unval resolve-token-stream 1) env (lex "x"))))))
 
 
 
@@ -759,7 +761,8 @@ X
 X
 ")
   )
-;; #undef
+
+;; TODO
 ;; #error
 
 (test-group "Pragma"
@@ -769,16 +772,20 @@ X
 
     )
   (test-group "_Pragma"
-    'noop))
+    (test-equal "#Pragma STDC FP_CONTRACT ON"
+      (with-output-to-string
+        (lambda () (run "_Pragma(\"STDC FP_CONTRACT ON\")"
+                   (extend-environment (make-environment)
+                                       (list
+                                        (@ (c preprocessor2) _Pragma-macro)))))))))
 
+;; TODO
 ;; if
 ;; else
 ;; ifdef
 ;; ifndef
 ;; elif
 
-(define next-token-matches? (@@ (c preprocessor2) next-token-matches?))
-
 (test-group "Next token matches?"
   (test-assert "Zero tokens never match" (not (next-token-matches? (const #t) '())))
 
@@ -849,15 +856,52 @@ f
 
 (10)"))
 
-(define unlex (@ (c unlex) unlex))
 
 (test-group "6.10.3.5 Scope of macro definitions"
-  (test-equal "Example3"
-    (unlex (lex "f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1);
+
+  (test-equal "Example 3, except part below"
+    (unlex-aggressive (lex "f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1);
+f(2 * (2+(3,4)-0,1)) | f(2 * (~ 5)) & ^m(0,1);
+int i[] = { 1, 23, 4, 5, };
+char c[2][6] = { \"hello\", \"\" };"))
+    (unlex-aggressive (run "
+#define x      3
+#define f(a)   f(x * (a))
+#undef  x
+#define x      2
+#define g      f
+#define z      z[0]
+#define h      g(~
+#define m(a)   a(w)
+#define w      0,1
+#define t(a)   a
+#define p()    int
+#define q(x)   x
+#define r(x,y) x ## y
+#define str(x) # x
+
+f(y+1) + f(f(z)) % t(t(g)(0) + t)(1);
+g(x+(3,4)-w) | h 5) &
+      ^m(m);
+p() i[q()] = { q(1), r(2,3), r(4,), r(,5), r(,) };
+char c[2][6] = { str(hello), str() };"))
+    )
+
+  (test-group "Example 3"
+    (test-equal "Subtest 1, is result of function application further macro expanded?"
+      (unlex-aggressive (lex "f(2 * (0,1))"))
+      ((unval handle-preprocessing-tokens 1) (make-environment) (tokenize "
+#define m(a) a(0,1)
+#define f(a) f(2 * (a))
+m(f)")))
+
+
+    (test-equal "True test"
+      (unlex-aggressive (lex "f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1);
 f(2 * (2+(3,4)-0,1)) | f(2 * (~ 5)) & f(2 * (0,1))^m(0,1);
 int i[] = { 1, 23, 4, 5, };
 char c[2][6] = { \"hello\", \"\" };"))
-    (unlex (drop-whitespace-both (run "
+      (unlex-aggressive (run "
 #define x      3
 #define f(a)   f(x * (a))
 #undef  x
@@ -878,90 +922,47 @@ g(x+(3,4)-w) | h 5) & m
       (f)^m(m);
 p() i[q()] = { q(1), r(2,3), r(4,), r(,5), r(,) };
 char c[2][6] = { str(hello), str() };"))))
-  )
 
-;;     (tokenize "
-;; f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1);
-;; f(2 * (2+(3,4)-0,1)) | f(2 * (~ 5)) & f(2 * (0,1))^m(0,1);
-;; int i[] = { 1, 23, 4, 5, };
-;; char c[2][6] = { \"hello\", \"\" };")
-
-
-;; (define env
-;;  (handle-preprocessing-tokens (make-environment) (tokenize "
-;; #define x      3
-;; #define f(a)   f(x * (a))
-;; #undef  x
-;; #define x      2
-;; #define g      f
-;; #define z      z[0]
-;; #define h      g(~
-;; #define m(a)   a(w)
-;; #define w      0,1
-;; #define t(a)   a
-;; #define p()    int
-;; #define q(x)   x
-;; #define r(x,y) x ## y
-;; #define str(x) # x
-;; ")))
-
-
-;; (handle-preprocessing-tokens
-;;  env (tokenize
-;;       "f(y+1) + f(f(z)) % t(t(g)(0) + t)(1);
-;; g(x+(3,4)-w) | h 5) & m
-;;       (f)^m(m);
-;; p() i[q()] = { q(1), r(2,3), r(4,), r(,5), r(,) };
-;; char c[2][6] = { str(hello), str() };"))
-
-
-
-;; (let ((env tokens
-;;            (handle-preprocessing-tokens
-;;             (make-environment)
-;;             (tokenize "
-;; #define x      3
-;; #define f(a)   f(x * (a))
-;; #undef  x
-;; #define x      2
-;; #define g      f
-;; #define z      z[0]
-;; #define h      g(~
-;; #define m(a)   a(w)
-;; #define w      0,1
-;; #define t(a)   a
-;; #define p()    int
-;; #define q(x)   x
-;; #define r(x,y) x ## y
-;; #define str(x) # x
-
-;; f(y+1) + f(f(z)) % t(t(g)(0) + t)(1);
-;; g(x+(3,4)-w) | h 5) & m
-;;       (f)^m(m);
-;; p() i[q()] = { q(1), r(2,3), r(4,), r(,5), r(,) };
-;; char c[2][6] = { str(hello), str() };"))))
-;;   (remove-noexpand tokens))
-
-;; (test-equal "anything"
-;;  (run
-;;   "
-;; #define x      3
-;; #define f(a)   f(x * (a))
-;; #undef  x
-;; #define x      2
-;; #define g      f
-;; #define z      z[0]
-;; #define h      g(~
-;; #define m(a)   a(w)
-;; #define w      0,1
-;; #define t(a)   a
-;; #define p()    int
-;; #define q(x)   x
-;; #define r(x,y) x ## y
-;; #define str(x) # x
-
-;; f(y+1) + f(f(z)) % t(t(g)(0) + t)(1);
-;; g(x+(3,4)-w) | h 5) & m
-;;       (f)^m(m);
-;; p() i[q()] = { q(1), r(2,3), r(4,), r(,5), r(,) };
-;; char c[2][6] = { str(hello), str() };"))
+  ;; TODO Example 4 skipped due to #include
+
+  (test-equal "Example 5"
+    (unlex-aggressive (lex "int j[] = { 123, 45, 67, 89, 10, 11, 12, };"))
+    (unlex-aggressive (run "
+#define t(x,y,z) x ## y ## z
+int j[] = { t(1,2,3), t(,4,5), t(6,,7), t(8,9,), t(10,,), t(,11,), t(,,12), t(,,) };")))
+
+  (test-group "Example 6"
+    (test-assert "Valid redefinitions"
+     (run "
+#define OBJ_LIKE (1-1)
+#define OBJ_LIKE /* */ (1+1) /* */
+#define FUNC_LIKE(a) ( a )
+#define FUNC_LIKE( a )( /*    */ \\
+        a /*
+           */  )"))
+
+    (test-error "Invalid redefinitions"
+      'misc-error
+      (run "
+#define OBJ_LIKE (0)
+#define OBJ_LIKE (1 - 1)
+#define FUNC_LIKE(b) ( a )
+#define FUNC_LIKE(b) ( b )
+")))
+
+  (test-equal "Example 7"
+    (unlex-aggressive (lex "fprintf(stderr, \"Flag\");
+fprintf(stderr, \"X = %d\\n\", x);
+puts(\"The first, second, and third items.\");
+((x>y)?puts(\"x>y\"):
+    printf(\"x is %d but y is %d\", x, y));"))
+    (unlex-aggressive (run "
+#define debug(...) fprintf(stderr, __VA_ARGS__)
+#define showlist(...) puts(#__VA_ARGS__)
+#define report(test, ...) ((test)?puts(#test):\\
+     printf(__VA_ARGS__))
+debug(\"Flag\");
+debug(\"X = %d\\n\", x);
+showlist(The first, second, and third items.);
+report(x>y, \"x is %d but y is %d\", x, y);
+"))))
-- 
cgit v1.2.3