From 561c7a3ea6c5153cde6be6d1792cda5af1202881 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 29 Jun 2022 14:30:35 +0200
Subject: Fix C order of operations.

---
 tests/test/c-parse.scm | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++
 tests/test/cpp.scm     | 23 +++++++++++------
 2 files changed, 84 insertions(+), 8 deletions(-)
 create mode 100644 tests/test/c-parse.scm

(limited to 'tests')

diff --git a/tests/test/c-parse.scm b/tests/test/c-parse.scm
new file mode 100644
index 00000000..c16958de
--- /dev/null
+++ b/tests/test/c-parse.scm
@@ -0,0 +1,69 @@
+;;; Commentary
+;; Test implementation details of C parser
+;; TODO Should be ran before (test cpp)
+;;; Code
+
+(define-module (test cpp)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-88)
+  :use-module ((c lex) :select (lex))
+  :use-module (c parse))
+
+(define flatten-infix (@@ (c parse) flatten-infix))
+(define resolve-order-of-operations (@@ (c parse) resolve-order-of-operations))
+
+(test-group "Flatten infix"
+ (test-equal "Simple binary operator"
+   '(fixed-infix (integer (base-10 "1"))
+                 +
+                 (integer (base-10 "2")))
+   (flatten-infix (lex "1 + 2")))
+
+ (test-equal "Simple binary operator, with compound structure in on branch"
+   '(fixed-infix (integer (base-10 "1"))
+                 +
+                 (funcall (variable "f")
+                          (group (integer (base-10 "2")))))
+   (flatten-infix (lex "1 + f(2)"))))
+
+(test-group "Order of operations"
+  (test-equal "Basic binary operator"
+    '((resolved-operator +)
+      (integer (base-10 "1"))
+      (integer (base-10 "2")))
+    (resolve-order-of-operations (flatten-infix (lex "1 + 2"))))
+
+  (test-equal "Multiple operators, with non-left-associative application"
+    '((resolved-operator +)
+      (integer (base-10 "1"))
+      ((resolved-operator *)
+       (integer (base-10 "2"))
+       (integer (base-10 "3"))))
+    (resolve-order-of-operations (flatten-infix (lex "1 + 2 * 3"))))
+
+  (test-equal "Multiple of the same operation gets clumed together"
+    '((resolved-operator +)
+      (integer (base-10 "1"))
+      (integer (base-10 "2"))
+      (integer (base-10 "3")))
+    (resolve-order-of-operations (flatten-infix (lex "1 + 2 + 3"))))
+
+  (test-equal "Simple Ternary"
+    '(ternary
+      (integer (base-10 "1"))
+      (integer (base-10 "2"))
+      (integer (base-10 "3")))
+    (resolve-order-of-operations (flatten-infix (lex "1 ? 2 : 3"))))
+
+  (test-equal "ternary with further infix operators"
+    '(ternary ((resolved-operator +)
+               (integer (base-10 "1"))
+               (integer (base-10 "2")))
+              ((resolved-operator %)
+               (integer (base-10 "3"))
+               (integer (base-10 "4")))
+              ((resolved-operator *)
+               (integer (base-10 "5"))
+               (integer (base-10 "6"))))
+    (resolve-order-of-operations (flatten-infix (lex "1 + 2? 3 % 4 : 5 * 6")))))
+
diff --git a/tests/test/cpp.scm b/tests/test/cpp.scm
index f3b9ff72..8a53ecce 100644
--- a/tests/test/cpp.scm
+++ b/tests/test/cpp.scm
@@ -13,6 +13,17 @@
 ;; So changing the lexer test cases isn't a problem
 ;; but don't change the parser test cases
 
+;; Strings aren't yet implemented
+(test-skip "Strings")
+;; __asm__ always has strings as arguments
+(test-skip "__asm__")
+;; not implemented
+(test-skip "Token concatenation")
+;; not implemented
+(test-skip "Floating point numbers")
+;; order of operation is wrong, leading to an incorrect result
+(test-skip "Cast with operation")
+
 (define run (compose parse-lexeme-tree lex))
 
 (define-syntax let-group
@@ -108,11 +119,6 @@
 
 
 
-(test-skip "Strings")
-(test-skip "__asm__")
-(test-skip "Token concatenation")
-(test-skip "Floating point numbers")
-
 ;; Hand picked forms from output of `cpp -dM /usr/include/termios.h` on
 ;; FreeBSD 13.1-RELEASE releng/13.1-n250148-fc952ac2212 GENERIC amd64
 ;; 2022-06-28
@@ -175,8 +181,8 @@
   (test-equal '(ternary
                 (and (>= x #x61)
                      (<= x #x7A))
-                (- x (+ #x61 1))
-                (bitand (- x (+ #x61 1)) 127))
+                (+ (- x #x61) 1)
+                (bitand (+ (- x #x61) 1) 127))
     (run form)))
 
 (let ((form "((x) & ~(IOCPARM_MASK << 16))"))
@@ -350,7 +356,8 @@
                                                     (group (variable "num")))))))
       (lex form))
     (test-equal '(as-type (unsigned long)
-                          (bitor (<< (bitand len IOCPARM_MASK) 16)
+                          (bitor inout
+                                 (<< (bitand len IOCPARM_MASK) 16)
                                  (<< group 8)
                                  num))
       (run form))))
-- 
cgit v1.2.3