From 65a47e17747a397b3ebea1c6fead303277ebed5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sat, 23 Jul 2022 17:53:06 +0200 Subject: General cleanup in preprocessor. --- tests/test/cpp/preprocessor2.scm | 370 ++++++++++++++++----------------------- 1 file changed, 155 insertions(+), 215 deletions(-) (limited to 'tests/test/cpp/preprocessor2.scm') diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm index 4e808b8b..f79ece15 100644 --- a/tests/test/cpp/preprocessor2.scm +++ b/tests/test/cpp/preprocessor2.scm @@ -5,7 +5,7 @@ :use-module (srfi srfi-64 test-error) :use-module (srfi srfi-71) :use-module (srfi srfi-88) - :use-module ((hnh util) :select (-> ->> unval swap)) + :use-module ((hnh util) :select (-> ->>)) :use-module ((hnh util lens) :select (set)) :use-module ((hnh util io) :select (call-with-tmpfile)) :use-module (hnh util values) @@ -29,13 +29,11 @@ next-token-matches? )) :use-module ((c unlex) - :select ( - unlex + :select (unlex unlex-aggressive stringify-token stringify-tokens - ) - ) + )) :use-module ((c cpp-types) :select (punctuator-token? identifier-token? whitespace-token?)) :use-module (c lex2) @@ -51,7 +49,6 @@ (define apply-macro (@@ (c preprocessor2) apply-macro)) -(define build-parameter-map (@@ (c preprocessor2) build-parameter-map)) (define expand# (@@ (c preprocessor2) expand#)) (define expand## (@@ (c preprocessor2) expand##)) (define expand-macro (@@ (c preprocessor2) expand-macro)) @@ -62,13 +59,11 @@ (define maybe-extend-identifier (@@ (c preprocessor2) maybe-extend-identifier)) (define parse-identifier-list (@@ (c preprocessor2) parse-identifier-list)) (define parse-parameter-list (@@ (c preprocessor2) parse-parameter-list)) -(define resolve-define (@@ (c preprocessor2) resolve-define)) +(define handle-define-directive (@@ (c preprocessor2) handle-define-directive)) (define resolve-token-stream (@@ (c preprocessor2) resolve-token-stream)) -;; (define tokenize (@@ (c preprocessor2) tokenize)) (define resolve-h-file (@@ (c preprocessor2) resolve-h-file)) (define resolve-q-file (@@ (c preprocessor2) resolve-q-file)) (define resolve-header (@@ (c preprocessor2) resolve-header)) -;; (define include-header (@@ (c preprocessor2) include-header)) ;; Remove the noexpand list from each token. @@ -233,86 +228,6 @@ (test-equal '() remaining) (test-equal 2 nls)))) -(test-group "Build parameter map" - (test-equal "Simplest case, zero arguments" - '() - (let ((m (function-like-macro - identifier: "str" - identifier-list: '() - body: (lex "#x")))) - (build-parameter-map - m '()))) - - (test-equal "Single (simple) argument" - `(("x" . ,(lex "x"))) - (let ((m (function-like-macro - identifier: "str" - identifier-list: '("x") - body: '()))) - (build-parameter-map - m - (list (lex "x"))))) - - (test-equal "Single advanced argument" - `(("x" . ,(lex "(x)"))) - (let ((m (function-like-macro - identifier: "str" - identifier-list: '("x") - body: '()))) - (build-parameter-map - m (list (lex "(x)"))))) - - (test-group "Rest arguments" - (test-equal "Single simple" - `(("__VA_ARGS__" . ,(lex "x"))) - (let ((m (function-like-macro - identifier: "str" - identifier-list: '() - variadic?: #t - body: '()))) - (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,y"))))))) - - -(test-group "Expand stringifiers" - (let ((m (function-like-macro - identifier: "str" - identifier-list: '("x") - body: (lex "#x")))) - (test-equal "Correct stringification of one param" - (lex "\"10\"") - (expand# - m (build-parameter-map - m (list (lex "10")))))) - - (let ((m (function-like-macro - identifier: "str" - identifier-list: '() - body: (lex "#x")))) - (test-error "Stringification fails for non-parameters" - 'macro-expand-error - (expand# - m (build-parameter-map - m (list (lex "x")))))) - - (let ((m (function-like-macro - identifier: "f" - identifier-list: '() - variadic?: #t - body: (lex "# __VA_ARGS__")))) - (test-equal "Stringify __VA_ARGS__" - (lex "\"10, 20\"") - (expand# m (build-parameter-map m (list (lex "10, 20"))))))) (let ((e (join-file-line (make-environment)))) @@ -329,47 +244,50 @@ (test-group "Token streams" (test-group "Non-expanding" (test-equal "Null stream" - '() ((unval resolve-token-stream 1) (make-environment) '())) + '() (value-ref (resolve-token-stream (make-environment) '()) 1)) (test-equal "Constant resolve to themselves" - (lex "1") ((unval resolve-token-stream 1) (make-environment) (lex "1"))) + (lex "1") (value-ref (resolve-token-stream (make-environment) (lex "1")) 1)) (test-equal "Identifier-likes not in environment stay put" - (lex "x") (remove-noexpand ((unval resolve-token-stream 1) (make-environment) (lex "x")))) + (lex "x") (remove-noexpand (value-ref (resolve-token-stream (make-environment) (lex "x")) 1))) (test-equal "Identifier-likes with stuff after keep stuff after" - (lex "x 1") (remove-noexpand ((unval resolve-token-stream 1) (make-environment) (lex "x 1"))))) + (lex "x 1") (remove-noexpand (value-ref (resolve-token-stream (make-environment) (lex "x 1")) 1)))) (test-group "Object likes" (test-equal "Expansion of single token" (lex "10") - (remove-noexpand - ((unval resolve-token-stream 1) - (extend-environment (make-environment) - (list (object-like-macro - identifier: "x" - body: (lex "10")))) - (lex "x")))) + (-> (make-environment) + (extend-environment + (list (object-like-macro + identifier: "x" + body: (lex "10")))) + (resolve-token-stream (lex "x")) + (value-ref 1) + remove-noexpand)) (test-equal "Expansion keeps stuff after" (lex "10 1") - (remove-noexpand - ((unval resolve-token-stream 1) - (extend-environment (make-environment) - (list (object-like-macro - identifier: "x" - body: (lex "10")))) - (lex "x 1")))) + (-> (make-environment) + (extend-environment + (list (object-like-macro + identifier: "x" + body: (lex "10")))) + (resolve-token-stream (lex "x 1")) + (value-ref 1) + remove-noexpand)) (test-equal "Multiple object like macros in one stream" (lex "10 20") - (remove-noexpand - ((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")))))) + (-> (make-environment) + (extend-environment + (list (object-like-macro + identifier: "x" + body: (lex "10")) + (object-like-macro + identifier: "y" + body: (lex "20")))) + (resolve-token-stream (lex "x y")) + (value-ref 1) + remove-noexpand)))) (test-group "Macro expansion" @@ -403,39 +321,39 @@ (test-group "Maybe extend identifier" (test-equal "Non-identifier returns remaining" (lex "x") - (remove-noexpand ((unval maybe-extend-identifier 1) - (make-environment) "x" '()'()))) + (-> (make-environment) + (maybe-extend-identifier "x" '() '()) + (value-ref 1) + remove-noexpand)) (test-equal "Non-identifiers remaining tokens are returned verbatim" (append (lex "x") (lex "after")) - (remove-noexpand ((unval maybe-extend-identifier 1) - (make-environment) "x" '() (lex "after")))) + (-> (make-environment) + (maybe-extend-identifier "x" '() (lex "after")) + (value-ref 1) + remove-noexpand)) (test-equal "Object like identifier expands" (lex "1 + 2") - (remove-noexpand ((unval maybe-extend-identifier 1) - (extend-environment (make-environment) - (list - (object-like-macro - identifier: "x" - body: (lex "1 + 2")))) - "x" - '() - '()))) + (-> (make-environment) + (extend-environment + (list (object-like-macro + identifier: "x" + body: (lex "1 + 2")))) + (maybe-extend-identifier "x" '() '()) + (value-ref 1) + remove-noexpand)) (test-equal "Object like macro still returns remaining verbatim" (append (lex "1 + 2") (lex "after")) - (remove-noexpand ((unval maybe-extend-identifier 1) - (extend-environment (make-environment) - (list - (object-like-macro - identifier: "x" - body: (lex "1 + 2")))) - "x" - '() - (lex "after")))) - - ) + (-> (make-environment) + (extend-environment + (list (object-like-macro + identifier: "x" + body: (lex "1 + 2")))) + (maybe-extend-identifier "x" '() (lex "after")) + (value-ref 1) + remove-noexpand))) (test-group "Apply macro" (test-equal "zero arg macro on nothing" @@ -449,21 +367,25 @@ (test-equal "Single arg macro" (lex "10") - (remove-noexpand (apply-macro - (make-environment) + (->> (lex "(10)") + parse-parameter-list + (value-refx 0) + (apply-macro (make-environment) (function-like-macro identifier: "f" identifier-list: '("x") - body: (lex "x")) - ((unval parse-parameter-list) (lex "(10)"))))) + body: (lex "x"))) + remove-noexpand)) (test-equal "Two arg macro" (lex "10 + 20") - (remove-noexpand (apply-macro - (make-environment) + (->> (lex "(10, 20)") + parse-parameter-list + (value-refx 0) + (apply-macro (make-environment) (function-like-macro identifier: "f" identifier-list: '("x" "y") - body: (lex "x + y")) - ((unval parse-parameter-list) (lex "(10, 20)")))))) + body: (lex "x + y"))) + remove-noexpand))) (test-group "Expand macro part 2" (test-group "Function like macros" @@ -497,74 +419,85 @@ (test-group "Resolve token stream with function likes" (test-equal "Macro expanding to its parameter" (lex "0") - (remove-noexpand ((unval resolve-token-stream 1) - (extend-environment - e (list (function-like-macro identifier: "f" - identifier-list: '("x") - body: (lex "x")))) - (lex "f(0)")))) + (-> e + (extend-environment + (list (function-like-macro identifier: "f" + identifier-list: '("x") + body: (lex "x")))) + (resolve-token-stream (lex "f(0)")) + (value-ref 1) + remove-noexpand)) (test-equal "Macro expanding parameter multiple times" (lex "(2) * (2)") - (remove-noexpand ((unval resolve-token-stream 1) - (extend-environment - e (list (function-like-macro identifier: "f" - identifier-list: '("x") - body: (lex "(x) * (x)")))) - (lex "f(2)"))) - ) + (-> e + (extend-environment + (list (function-like-macro identifier: "f" + identifier-list: '("x") + body: (lex "(x) * (x)")))) + (resolve-token-stream (lex "f(2)")) + (value-ref 1) + remove-noexpand)) (test-equal "Object like contains another object like" (lex "z") - (remove-noexpand ((unval resolve-token-stream 1) - (extend-environment - e (list (object-like-macro identifier: "x" - body: (lex "y")) - (object-like-macro identifier: "y" - body: (lex "z")))) - (lex "x")))) + (-> e + (extend-environment + (list (object-like-macro identifier: "x" + body: (lex "y")) + (object-like-macro identifier: "y" + body: (lex "z")))) + (resolve-token-stream (lex "x")) + (value-ref 1) + remove-noexpand)) (test-equal "function like contains another macro" (lex "10") - (remove-noexpand ((unval resolve-token-stream 1) - (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)")))) + (-> e + (extend-environment + (list (function-like-macro identifier: "f" + identifier-list: '("x") + body: (lex "g(x)")) + (function-like-macro identifier: "g" + identifier-list: '("y") + body: (lex "y")))) + (resolve-token-stream (lex "f(10)")) + (value-ref 1) + remove-noexpand)) (test-equal "function like containing another macro using the same parameter name" (lex "10") - (remove-noexpand ((unval resolve-token-stream 1) - (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)")))) + (-> e + (extend-environment + (list (function-like-macro identifier: "f" + identifier-list: '("x") + body: (lex "g(x)")) + (function-like-macro identifier: "g" + identifier-list: '("x") + body: (lex "x")))) + (resolve-token-stream (lex "f(10)")) + (value-ref 1) + remove-noexpand)) (test-equal "function like contains another macro" (lex "10 * 2 + 20 * 2 + 30") - (remove-noexpand ((unval resolve-token-stream 1) - (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 ((env (resolve-define (make-environment) + (-> e + (extend-environment + (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")))) + (resolve-token-stream (lex "f(10, 20) + 30")) + (value-ref 1) + remove-noexpand)))) + + +(let ((env (handle-define-directive (make-environment) (lex "f(x) x+1")))) (test-assert "New binding added" (in-environment? env "f")) (let ((m (get-identifier env "f"))) @@ -572,39 +505,46 @@ (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) +;; (handle-define-directive (make-environment) ;; (lex "f(x)x+1")) (test-group "Recursive macros" - (let ((env (resolve-define (make-environment) + (let ((env (handle-define-directive (make-environment) (lex "x x")))) (test-equal "Macro expanding to itself leaves the token" - (mark-noexpand (lex "x") "x") - ((unval resolve-token-stream 1) env (lex "x")))) + (mark-noexpand "x" (lex "x")) + (-> (resolve-token-stream env (lex "x")) + (value-ref 1)))) ;; Test from C standard 6.10.3.4 p. 4 ;; Both the expansion "2*f(9)" and "2*9*g" are valid. ;; The case chosen here is mostly a consequence of how the code works (let ((env (-> (make-environment) - (resolve-define (lex "f(a) a*g")) - (resolve-define (lex "g(a) f(a)"))))) + (handle-define-directive (lex "f(a) a*g")) + (handle-define-directive (lex "g(a) f(a)"))))) (test-equal "Mutual recursion with two function like macros" (lex "2*f(9)") - (remove-noexpand ((unval resolve-token-stream 1) env (lex "f(2)(9)"))))) + (-> (resolve-token-stream env (lex "f(2)(9)")) + (value-ref 1) + remove-noexpand))) (let ((env (-> (make-environment) - (resolve-define (lex "f 2 * g")) - (resolve-define (lex "g(x) x + f"))))) + (handle-define-directive (lex "f 2 * g")) + (handle-define-directive (lex "g(x) x + f"))))) (test-equal "Mutual recursion with object and function like macro" (lex "2 * 10 + f") - (remove-noexpand ((unval resolve-token-stream 1) env (lex "f(10)"))))) + (-> (resolve-token-stream env (lex "f(10)")) + (value-ref 1) + remove-noexpand))) (let ((env (-> (make-environment) - (resolve-define (lex "x 2*y")) - (resolve-define (lex "y 3*x"))))) + (handle-define-directive (lex "x 2*y")) + (handle-define-directive (lex "y 3*x"))))) (test-equal "Mutual recursion with two object likes" (lex "2*3*x") - (remove-noexpand ((unval resolve-token-stream 1) env (lex "x")))))) + (-> (resolve-token-stream env (lex "x")) + (value-ref 1) + remove-noexpand)))) @@ -622,7 +562,7 @@ '(("*outside*" . 9)) (cpp-file-stack (handle-line-directive - (resolve-define e (lex "x 10")) + (handle-define-directive e (lex "x 10")) (lex "x")))))) @@ -991,10 +931,10 @@ 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 " + (value-ref (handle-preprocessing-tokens (make-environment) (tokenize " #define m(a) a(0,1) #define f(a) f(2 * (a)) -m(f)"))) +m(f)")) 1)) (test-equal "True test" -- cgit v1.2.3