diff options
Diffstat (limited to '')
-rw-r--r-- | tests/test/cpp/preprocessor2.scm | 335 |
1 files changed, 184 insertions, 151 deletions
diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm index 75e29834..e2ff0a17 100644 --- a/tests/test/cpp/preprocessor2.scm +++ b/tests/test/cpp/preprocessor2.scm @@ -5,6 +5,7 @@ :use-module (srfi srfi-71) :use-module (srfi srfi-88) :use-module ((hnh util) :select (-> unval)) + :use-module ((hnh util lens) :select (set)) :use-module (c preprocessor2) :use-module (c cpp-environment) :use-module (c cpp-environment function-like-macro) @@ -21,21 +22,19 @@ (call-with-values (lambda () (tokens-until-eol - (list before '(whitespace "\n") after))) + (list before (car (lex "\n")) after))) (lambda (bef aft) (test-equal (list before) bef) - (test-equal (list '(whitespace "\n") after) aft)))) + (test-equal (list (car (lex "\n")) after) aft)))) (define squeeze-whitespace (@@ (c preprocessor2) squeeze-whitespace)) (test-equal "Squeeze whitespace" - '(bef (whitespace " ") aft) + (lex "bef aft") (squeeze-whitespace - '(bef - (whitespace a) - (whitespace b) - aft))) + (append (lex "bef ") + (lex " aft")))) @@ -44,7 +43,7 @@ (test-group "Stringify" (test-equal "(" - (stringify-token '(punctuator "("))) + (stringify-token (car (lex "(")))) ;; TODO more cases (test-equal (car (lex "\"(a, b)\"")) @@ -56,9 +55,9 @@ (test-group "Parse identifier list" (test-group "Single argument" - (let ((rest args (parse-identifier-list (lex "x")))) - (test-assert (not rest)) - (test-equal '("x") args))) + (let ((rest args (parse-identifier-list (lex "x")))) + (test-assert (not rest)) + (test-equal '("x") args))) (test-group "Multiple parameters" (let ((rest args (parse-identifier-list (lex "x, y")))) @@ -88,7 +87,7 @@ -(define expand-stringifiers (@@ (c preprocessor2) expand-stringifiers)) +(define expand# (@@ (c preprocessor2) expand#)) (define build-parameter-map (@@ (c preprocessor2) build-parameter-map)) (define parse-parameter-list (@@ (c preprocessor2) parse-parameter-list)) (define cleanup-whitespace (@@ (c preprocessor2) cleanup-whitespace)) @@ -152,8 +151,7 @@ identifier-list: '() body: (lex "#x")))) (build-parameter-map - m '() #; (list (lex "x")) - ))) + m '()))) (test-equal "Single (simple) argument" `(("x" . ,(lex "x"))) @@ -203,7 +201,7 @@ body: (lex "#x")))) (test-equal "Correct stringification of one param" (lex "\"10\"") - (expand-stringifiers + (expand# m (build-parameter-map m (list (lex "10")))))) @@ -213,7 +211,7 @@ body: (lex "#x")))) (test-error "Stringification fails for non-parameters" 'macro-expand-error - (expand-stringifiers + (expand# m (build-parameter-map m (list (lex "x"))))))) @@ -223,15 +221,22 @@ (define join-file-line (@@ (c preprocessor2) join-file-line)) (let ((e (join-file-line (make-environment)))) - (test-equal (object-like-macro identifier: "__FILE__" - body: '((preprocessing-token (string-literal "*outside*")))) + (test-equal "__FILE__ default value" + (object-like-macro identifier: "__FILE__" + body: (lex "\"*outside*\"")) (get-identifier e "__FILE__")) - (test-equal (object-like-macro identifier: "__LINE__" - body: '((preprocessing-token (pp-number "1")))) + (test-equal "__LINE__ default value" + (object-like-macro identifier: "__LINE__" + body: (lex "1")) (get-identifier e "__LINE__"))) (define resolve-token-stream (@@ (c preprocessor2) resolve-token-stream)) +(define (remove-noexpand tokens) + ;; (typecheck tokens (list-of token?)) + (map (lambda (token) (set token lexeme-noexpand '())) + tokens)) + (test-group "Token streams" (test-group "Non-expanding" (test-equal "Null stream" @@ -239,37 +244,40 @@ (test-equal "Constant resolve to themselves" (lex "1") (resolve-token-stream (make-environment) (lex "1"))) (test-equal "Identifier-likes not in environment stay put" - (lex "x") (resolve-token-stream (make-environment) (lex "x"))) + (lex "x") (remove-noexpand (resolve-token-stream (make-environment) (lex "x")))) (test-equal "Identifier-likes with stuff after keep stuff after" - (lex "x 1") (resolve-token-stream (make-environment) (lex "x 1")))) + (lex "x 1") (remove-noexpand (resolve-token-stream (make-environment) (lex "x 1"))))) (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"))) + (remove-noexpand + (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"))) + (remove-noexpand + (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") - (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")))) + (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 @@ -294,16 +302,18 @@ (lambda () (expand-macro (make-environment) (object-like-macro identifier: "x" body: (lex "1 + 2")) + '() '())) - (lambda (_ tokens) (test-equal "Simplest case" (lex "1 + 2") tokens))) + (lambda (_ tokens) (test-equal "Simplest case" (lex "1 + 2") (remove-noexpand tokens)))) (call-with-values (lambda () (expand-macro (make-environment) (object-like-macro identifier: "x" body: (lex "1+2")) + '() (cdr (lex "x something else")))) (lambda (_ tokens) (test-equal "Expansion with stuff after" - (lex "1+2 something else") tokens))) + (lex "1+2 something else") (remove-noexpand tokens)))) ;; (call-with-values (expand-macro (make-environment))) @@ -313,65 +323,67 @@ (test-group "Maybe extend identifier" (test-equal "Non-identifier returns remaining" (lex "x") - ((unval maybe-extend-identifier 1) - (make-environment) "x" '())) + (remove-noexpand ((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))) + (remove-noexpand ((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" - '())) + (remove-noexpand ((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))) + (remove-noexpand ((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" (lex "1") - (apply-macro - (make-environment) - (function-like-macro identifier: "f" - identifier-list: '() - body: (lex "1")) - '())) + (remove-noexpand (apply-macro + (make-environment) + (function-like-macro identifier: "f" + identifier-list: '() + body: (lex "1")) + '()))) (test-equal "Single arg macro" (lex "10") - (apply-macro - (make-environment) - (function-like-macro identifier: "f" - identifier-list: '("x") - body: (lex "x")) - ((unval parse-parameter-list) (lex "(10)")))) + (remove-noexpand (apply-macro + (make-environment) + (function-like-macro identifier: "f" + identifier-list: '("x") + body: (lex "x")) + ((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)"))))) + (remove-noexpand (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" @@ -380,21 +392,21 @@ identifier: "f" identifier-list: '() body: (lex "1")))) - (call-with-values (lambda () (expand-macro e m (lex "()"))) - (lambda (_ tokens*) (test-equal (lex "1") tokens*))) + (call-with-values (lambda () (expand-macro e m '() (lex "()"))) + (lambda (_ tokens*) (test-equal (lex "1") (remove-noexpand tokens*)))) (test-error "Arity error for to many args" - 'cpp-arity-error (expand-macro e m (lex "(10)")))) + '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*))) + (call-with-values (lambda () (expand-macro e m '() (lex "(1)"))) + (lambda (_ tokens*) (test-equal (lex " 1") (remove-noexpand 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*))) + '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") (remove-noexpand tokens*)))) ) )))) @@ -402,44 +414,44 @@ (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)"))) + (remove-noexpand (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)")) + (remove-noexpand (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"))) + (remove-noexpand (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)"))) + (remove-noexpand (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) @@ -449,42 +461,42 @@ 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)"))) + (remove-noexpand (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"))))) + (remove-noexpand (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)"))) + (lex "0") (remove-noexpand (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)"))))) + (lex "1") (remove-noexpand (resolve-token-stream + (extend-environment + e (list (object-like-macro identifier: "X" + body: (lex "10")))) + (lex "defined(X)")))))) (let ((env (resolve-define (make-environment) @@ -498,17 +510,38 @@ f(10) ;; (resolve-define (make-environment) ;; (lex "f(x)x+1")) -;; (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)")))) +(define mark-noexpand (@@ (c preprocessor2) mark-noexpand)) + +(test-group "Recursive macros" + (let ((env (resolve-define (make-environment) + (lex "x x")))) + (test-equal "Macro expanding to itself leaves the token" + (mark-noexpand (lex "x") "x") + (resolve-token-stream 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. + ;; 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)"))))) + (test-equal "Mutual recursion with two function like macros" + (lex "2*f(9)") + (remove-noexpand (resolve-token-stream 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)"))))) + + (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")))))) |