(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*);")))

  )