From ad0440b16d7e2694ae01df08710f24936b57ec99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 11 Jul 2022 20:31:58 +0200 Subject: work --- tests/test/cpp/preprocessor2.scm | 265 +++++++++++++++++++++------------------ 1 file changed, 145 insertions(+), 120 deletions(-) (limited to 'tests/test/cpp/preprocessor2.scm') diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm index b5e9e001..4f0918ff 100644 --- a/tests/test/cpp/preprocessor2.scm +++ b/tests/test/cpp/preprocessor2.scm @@ -7,30 +7,72 @@ :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) - :use-module (c cpp-environment object-like-macro) - :use-module ((c cpp-util) :select (drop-whitespace-both)) - :use-module (c lex2)) + :use-module ((c cpp-environment) + :select (extend-environment + make-environment + get-identifier + enter-file + in-environment? + macro-identifier-list + macro-body + cpp-file-stack)) + :use-module ((c cpp-environment function-like-macro) :select (function-like-macro)) + :use-module ((c cpp-environment object-like-macro) :select (object-like-macro)) + :use-module ((c cpp-util) + :select (drop-whitespace-both + tokens-until-eol + squeeze-whitespace + cleanup-whitespace + )) + :use-module ((c unlex) + :select ( + stringify-token + stringify-tokens + ) + ) + :use-module (c lex2) + ) +(test-expect-fail "x ## y") + +(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)) +(define handle-line-directive (@@ (c preprocessor2) handle-line-directive)) +(define handle-preprocessing-tokens (@@ (c preprocessor2) handle-preprocessing-tokens)) +(define join-file-line (@@ (c preprocessor2) join-file-line)) +(define mark-noexpand (@@ (c preprocessor2) mark-noexpand)) +(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 resolve-token-stream (@@ (c preprocessor2) resolve-token-stream)) +(define tokenize (@@ (c preprocessor2) tokenize)) + + +;; Remove the noexpand list from each token. +;; Allows equal? with fresh tokens +(define (remove-noexpand tokens) + ;; (typecheck tokens (list-of token?)) + (map (lambda (token) (set token lexeme-noexpand '())) + tokens)) + +(define* (run str optional: (env (make-environment))) + (let ((env tokens (handle-preprocessing-tokens env (tokenize str)))) + (remove-noexpand tokens))) -;; 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 - (list before (car (lex "\n")) after))) + (lambda () (tokens-until-eol (lex "before\nafter"))) (lambda (bef aft) - (test-equal (list before) bef) - (test-equal (list (car (lex "\n")) after) aft)))) + (test-equal (lex "before") bef) + (test-equal (lex "\nafter") aft)))) -(define squeeze-whitespace (@@ (c preprocessor2) squeeze-whitespace)) (test-equal "Squeeze whitespace" (lex "bef aft") (squeeze-whitespace @@ -38,21 +80,14 @@ (lex " aft")))) - -(define stringify-token (@@ (c preprocessor2) stringify-token)) -(define stringify-tokens (@@ (c preprocessor2) stringify-tokens)) - (test-group "Stringify" (test-equal "(" (stringify-token (car (lex "(")))) ;; TODO more cases (test-equal (car (lex "\"(a, b)\"")) - (stringify-tokens (lex "(a, b)"))) - ) - + (stringify-tokens (lex "(a, b)")))) -(define parse-identifier-list (@@ (c preprocessor2) parse-identifier-list)) (test-group "Parse identifier list" (test-group "Single argument" @@ -88,10 +123,6 @@ -(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)) (test-equal "Clean up whitespace" (lex "( 2 , 4 )") @@ -228,7 +259,6 @@ ;; TODO expand-join ;; token ## token2 -(define join-file-line (@@ (c preprocessor2) join-file-line)) (let ((e (join-file-line (make-environment)))) (test-equal "__FILE__ default value" @@ -240,12 +270,6 @@ 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" @@ -297,10 +321,6 @@ ) -(define expand-macro (@@ (c preprocessor2) expand-macro)) -(define resolve-define (@@ (c preprocessor2) resolve-define)) -(define apply-macro (@@ (c preprocessor2) apply-macro)) -(define maybe-extend-identifier (@@ (c preprocessor2) maybe-extend-identifier)) (test-group "Macro expansion" (test-group "Expand macro part 1" @@ -337,9 +357,9 @@ (make-environment) "x" '()'()))) (test-equal "Non-identifiers remaining tokens are returned verbatim" - (append (lex "x") (list after)) + (append (lex "x") (lex "after")) (remove-noexpand ((unval maybe-extend-identifier 1) - (make-environment) "x" '() (list after)))) + (make-environment) "x" '() (lex "after")))) (test-equal "Object like identifier expands" (lex "1 + 2") @@ -354,7 +374,7 @@ '()))) (test-equal "Object like macro still returns remaining verbatim" - (append (lex "1 + 2") (list after)) + (append (lex "1 + 2") (lex "after")) (remove-noexpand ((unval maybe-extend-identifier 1) (extend-environment (make-environment) (list @@ -363,7 +383,7 @@ body: (lex "1 + 2")))) "x" '() - (list after)))) + (lex "after")))) ) @@ -463,11 +483,6 @@ 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") @@ -497,7 +512,7 @@ f(10) (let ((e (extend-environment (make-environment) - (list (@@ (c preprocessor2) defined-macro))))) + (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)")))) @@ -520,8 +535,6 @@ f(10) ;; (resolve-define (make-environment) ;; (lex "f(x)x+1")) -(define mark-noexpand (@@ (c preprocessor2) mark-noexpand)) - (test-group "Recursive macros" (let ((env (resolve-define (make-environment) (lex "x x")))) @@ -555,20 +568,17 @@ f(10) -(define cpp-file-stack (@@ (c cpp-environment) cpp-file-stack)) -(define handle-line-directive (@@ (c preprocessor2) handle-line-directive)) - (test-group "Line directive" (let ((e (make-environment))) (test-equal "#line " - '(("*outside*" . 10)) + '(("*outside*" . 9)) (cpp-file-stack (handle-line-directive e (lex "10")))) (test-equal "#line " - '(("file" . 10)) + '(("file" . 9)) (cpp-file-stack (handle-line-directive e (lex "10 \"file\"")))) (test-equal "#line " - '(("*outside*" . 10)) + '(("*outside*" . 9)) (cpp-file-stack (handle-line-directive (resolve-define e (lex "x 10")) @@ -587,19 +597,13 @@ f(10) ;; elif -(define handle-preprocessing-tokens (@@ (c preprocessor2) handle-preprocessing-tokens)) -(define tokenize (@@ (c preprocessor2) tokenize)) +(call-with-values (lambda () + (handle-preprocessing-tokens (make-environment) + (lex "1"))) + (lambda (env tokens) + (test-equal "Simplest case" (lex "1") tokens))) -(test-equal "Simplest case" (lex "1") - (handle-preprocessing-tokens (make-environment) - (lex "1"))) - -(define (run str) - (remove-noexpand - (handle-preprocessing-tokens - (make-environment) - (tokenize str)))) (test-equal "Define" @@ -608,36 +612,51 @@ f(10) #define x 1 x")) -(test-equal "only __LINE__" - (lex "1") - (run "__LINE__")) +(test-group "__LINE__ and __FILE__" + (test-group "__LINE__" + (test-equal "only __LINE__" + (lex "1") + (run "__LINE__")) -(test-equal "__LINE__ after linebreak" - (lex "2") - (run "\n__LINE__")) + (test-equal "__LINE__ after linebreak" + (lex "2") + (run "\n__LINE__")) -(test-equal "__LINE__ through macro" - (lex "5") - (drop-whitespace-both (run " // 1 + (test-equal "__LINE__ through macro" + (lex "5") + (drop-whitespace-both (run " // 1 #define x __LINE__ // 2 // 3 // 4 x // 5")) - ) + ) -(test-equal "__LINE__ standalone" - (lex "5") - (drop-whitespace-both - (run " // 1 + (test-equal "__LINE__ standalone" + (lex "5") + (drop-whitespace-both + (run " // 1 // 2 // 3 // 4 -__LINE__"))) +__LINE__")))) + (test-equal "__FILE__" + (lex "\"sample-file.c\"") + (run "__FILE__" (enter-file (make-environment) "sample-file.c"))) + + (test-group "#line" + (test-equal "Updating line" + (lex "10") + (run "#line 10\n__LINE__")) + + (test-equal "Updating line and file" + (lex "10 \"file.c\"") + (run "#line 10 \"file.c\"\n__LINE__ __FILE__")) + ) + ) -(define expand## (@@ (c preprocessor2) expand##)) (test-group "expand##" (test-error 'cpp-error (expand## (lex "a ##"))) @@ -646,84 +665,90 @@ __LINE__"))) (test-equal (lex "ab") (expand## (lex "a ## b"))) ) +(test-group "Token concatenation" -(test-equal "Token concatenation in function like macro" - (lex "ab") - (run " + (test-equal "Token concatenation in function like macro" + (lex "ab") + (run " #define f() a ## b f()")) -(test-equal "token concatentanion in object like macro" - (lex "ab") - (run " + (test-equal "token concatentanion in object like macro" + (lex "ab") + (run " #define x a ## b x")) -(test-equal "Token concatenation with parameter" - (lex "ab") - (run " + (test-equal "Token concatenation with parameter" + (lex "ab") + (run " #define f(x) x ## b f(a)")) - - -;; 6.10.3.3 p. 4 -(test-equal "x ## y" - (lex "\"x ## y\"") - (run " + ;; 6.10.3.3 p. 4 + (test-equal "x ## y" + (lex "\"x ## y\"") + (run " #define hash_hash # ## # #define mkstr(a) # a #define in_between(a) mkstr(a) #define join(c, d) in_between(c hash_hash d) -join(x, y)")) +join(x, y)"))) -(test-equal "__VA_ARGS__ split its arguments" - (lex "1") - (run " +(test-group "__VA_ARGS__" + (test-equal "__VA_ARGS__ split its arguments" + (lex "1") + (run " #define fst(x, y) x #define f(...) fst(__VA_ARGS__) f(1,2) ")) -(test-equal - "Stringify __VA_ARGS__" - (lex "\"1,2\"") - (run " + (test-equal + "Stringify __VA_ARGS__" + (lex "\"1,2\"") + (run " #define g(...) #__VA_ARGS__ g(1,2) ")) -(test-equal "__VA_ARGS__ keep whitespace" - (lex "x, y") - (run " + (test-equal "__VA_ARGS__ keep whitespace" + (lex "x, y") + (run " #define args(...) __VA_ARGS__ args(x, y) ")) -(test-equal "Concat with __VA_ARGS__" - (lex "fx,y") - (run " + (test-equal "Concat with __VA_ARGS__" + (lex "fx,y") + (run " #define wf(...) f ## __VA_ARGS__ wf(x,y) ")) -(test-equal - "Concat with __VA_ARGS__ (keeping whitespace)" - (lex "fx, y") - (run " + (test-equal + "Concat with __VA_ARGS__ (keeping whitespace)" + (lex "fx, y") + (run " #define wf(...) f ## __VA_ARGS__ wf(x, y) -")) +"))) -;; __LINE__ -;; #line ;; #undef ;; #error -;; #pragma + +(test-group "Pragma" + (test-group "#pragma" + (test-equal "#Pragma STDC FP_CONTRACT ON" + (with-output-to-string (lambda () (run "#pragma STDC FP_CONTRACT ON")))) + + ) + (test-group "_Pragma" + 'noop)) ;; if ;; else -- cgit v1.2.3