aboutsummaryrefslogtreecommitdiff
path: root/tests/test/cpp/parse2.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/test/cpp/parse2.scm')
-rw-r--r--tests/test/cpp/parse2.scm245
1 files changed, 245 insertions, 0 deletions
diff --git a/tests/test/cpp/parse2.scm b/tests/test/cpp/parse2.scm
new file mode 100644
index 00000000..41404480
--- /dev/null
+++ b/tests/test/cpp/parse2.scm
@@ -0,0 +1,245 @@
+(define-module (test cpp parse2)
+ :use-module (srfi srfi-64)
+ :use-module (srfi srfi-88)
+ :use-module ((c ast) :select (build-ast))
+ :use-module ((c preprocessor2)
+ :select (preprocess-string
+ make-default-environment)))
+
+
+(define (run str)
+ (call-with-values (lambda () (preprocess-string str (make-default-environment)))
+ (lambda (_ tokens)
+ (build-ast tokens))))
+
+
+
+(test-group "primitives"
+ (test-equal "Simple integer"
+ '((constexpr (constant 1)))
+ (run "1"))
+
+ (test-equal "Complex integer"
+ '((constexpr (constant 16)))
+ (run "0x10l"))
+
+ (test-equal "Simple character"
+ '((constexpr (constant #x41)))
+ (run "'A'"))
+
+ (test-equal "String literal"
+ '((constexpr (string-constant #vu8(#x48 #x65 #x6c #x6c #x6f 0))))
+ (run "\"Hello\"")))
+
+
+
+(test-equal "_Generic"
+ '((constexpr
+ (generic X
+ ((specifier-qualifier-list (type long) (type double))
+ . cbrtl)
+ (default . cbrt)
+ ((specifier-qualifier-list (type float)) . cbrtf))))
+ (run "_Generic(X, long double: cbrtl, default: cbrt, float: cbrtf)"))
+
+(test-group "postfix expression"
+ (test-equal "array index"
+ '((constexpr (idx arr i)))
+ (run "arr[i]"))
+
+ (test-equal "Funcall"
+ '((constexpr (f)))
+ (run "f()"))
+
+ (test-equal "Funcall with args"
+ '((constexpr (f a b c)))
+ (run "f(a,b,c)"))
+
+ (test-equal "Chained function calls"
+ '((constexpr ((f a) b)))
+ (run "f(a)(b)"))
+
+ (test-equal "dot-access"
+ '((constexpr (dot-access a b)))
+ (run "a.b"))
+
+ (test-equal "chained dotaccess"
+ '((constexpr (dot-access (dot-access a b) c)))
+ (run "a.b.c"))
+
+ (test-equal "ptr-access"
+ '((constexpr (ptr-access a b)))
+ (run "a->b")))
+
+;; unary expressions
+
+
+;; cast expresions
+
+(test-equal "Chained casts"
+ '((constexpr
+ (as-type (specifier-qualifier-list (type short))
+ (as-type (specifier-qualifier-list (type int))
+ x))))
+ (run "(short) (int) x"))
+
+
+(test-equal "Ternary"
+ '((constexpr (ternary (constant 1)
+ (constant 2)
+ (constant 3))))
+ (run "1 ? 2 : 3"))
+
+
+(test-equal "Comma operator"
+ '((constexpr (begin (= x (constant 10))
+ (= y (constant 20)))))
+ (run "x = 10, y = 20"))
+
+
+
+(test-group "Declarations"
+ (test-equal "Simple"
+ '((translation-unit
+ (define (named x ((type int)))
+ <undefined-value>)))
+ (run "int x;"))
+
+ (test-equal "Simple with value"
+ '((translation-unit
+ (define (named x ((type int)))
+ (constant 1))))
+ (run "int x = 1;"))
+
+
+ (test-equal "Multiple at same time"
+ '((translation-unit
+ (begin
+ (define (named x ((type long) (type int)))
+ (constant 1))
+ (define (named y (pointer-to ((type long) (type int))))
+ <undefined-value>))))
+ (run "long int x = 1, *y;"))
+
+ ;; TODO static_assert-declaration
+
+ (test-group "structs"
+ (test-equal "declaration"
+ '((translation-unit
+ (struct-like-declaration ((type (struct (named s)))))))
+ (run "struct s;"))
+
+ (test-equal "definition"
+ '((translation-unit
+ (struct-like-declaration
+ ((type (struct (named s)
+ (struct-declaration-list
+ (struct-declarator-list
+ (named x (specifier-qualifier-list (type int)))))))))))
+ (run "struct s { int x; };"))
+
+ (test-equal "Definition with multiple fields"
+ '((translation-unit
+ (struct-like-declaration
+ ((type (struct (named p)
+ (struct-declaration-list
+ (struct-declarator-list
+ (named x (specifier-qualifier-list (type int))))
+ (struct-declarator-list
+ (named y (specifier-qualifier-list (type int)))))))))))
+ (run "struct p { int x; int y; };"))
+
+ (test-equal "Anonymous definition"
+ '((translation-unit
+ (struct-like-declaration
+ ((type (struct
+ (struct-declaration-list
+ (struct-declarator-list
+ (named x (specifier-qualifier-list (type int)))))))))))
+ (run "struct { int x; };"))
+
+
+ (test-equal "struct with inner named struct"
+ '((translation-unit
+ (struct-like-declaration
+ ((type (struct (named p)
+ (struct-declaration-list
+ (struct-declarator-list
+ (named a (specifier-qualifier-list (type int))))
+ (specifier-qualifier-list
+ (type (struct (named inner)
+ (struct-declaration-list
+ (struct-declarator-list
+ (named x (specifier-qualifier-list (type int)))))))))))))))
+ (run "struct p { int a; struct inner { int x; }; };"))
+
+ (test-equal "struct with inner anonymous struct"
+ '((translation-unit
+ (struct-like-declaration
+ ((type (struct (named p)
+ (struct-declaration-list
+ (struct-declarator-list
+ (named a (specifier-qualifier-list (type int))))
+ (specifier-qualifier-list
+ (type (struct
+ (struct-declaration-list
+ (struct-declarator-list
+ (named x (specifier-qualifier-list (type int)))))))))))))))
+ (run "struct p { int a; struct { int x; }; };"))
+
+ (run "struct p { struct s; };")
+
+ )
+
+ (test-group "Unions"
+ (test-equal
+ '((translation-unit
+ (struct-like-declaration
+ ((type (union (named X)))))))
+ (run "union X;"))
+
+ ;; (run "union p { struct s; };")
+
+ (test-equal
+ '((translation-unit
+ (struct-like-declaration
+ ((type (union (named int_or_char)
+ (struct-declaration-list
+ (struct-declarator-list
+ (named i (specifier-qualifier-list (type int))))
+ (struct-declarator-list
+ (named s (specifier-qualifier-list (type char)))))))))))
+ (run "union int_or_char { int i; char s; };")))
+
+ (test-group "Typedef"
+ (test-equal "Simple"
+ '((translation-unit
+ (define (named uint
+ ((storage typedef)
+ (type unsigned)
+ (type int)))
+ <undefined-value>)))
+ (run "typedef unsigned int uint;"))
+
+ ;; Interesting since the star "binds" to the right
+ (test-equal "with ptr"
+ '((translation-unit
+ (define (named int_ptr
+ (pointer-to
+ ((storage typedef)
+ (type int))))
+ <undefined-value>)))
+ (run "typedef int *int_ptr;"))
+
+ (test-equal "Function pointer"
+ '((translation-unit
+ (define ((named func_ptr
+ (pointer-to
+ (procedure
+ (returning (pointer-to ((storage typedef)
+ (type void))))
+ (taking ((pointer-to ((type void)))))))))
+ <undefined-value>)))
+ (run "typedef void*(*func_ptr)(void*);")))
+
+ )
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-17 04:11:42 +0200