From 65ecaf18aa34d3e76abbfd757797fa4dda9bb195 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 12 Jul 2022 03:16:34 +0200
Subject: Resolve # ## #

---
 module/c/lex2.scm                |  7 +++++++
 module/c/preprocessor2.scm       | 14 +++++++++++---
 tests/test/cpp/preprocessor2.scm | 21 ++++++++++++++++++---
 3 files changed, 36 insertions(+), 6 deletions(-)

diff --git a/module/c/lex2.scm b/module/c/lex2.scm
index 50cf56e3..652aa6c1 100644
--- a/module/c/lex2.scm
+++ b/module/c/lex2.scm
@@ -330,6 +330,7 @@
          comment
          preprocessing-token)))
 
+
 
 (define-type (lexeme)
   (type type: (memv '(whitespace comment preprocessing-token placemaker)))
@@ -356,6 +357,12 @@
     ;; "unflatten"
     ('comment (lexeme body: "" type: 'comment))))
 
+
+
+;; At a number of places I chose token depending on the order of the rule. The
+;; standard however says that the longest possible choice should be used.
+;; 6.4 p. 4
+
 ;; returns a list of lexemes
 (define (lex string)
   (if (string-null? string)
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index 3cb5913f..4678ded7 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -26,7 +26,8 @@
 
 (define parameter-map? (of-type? (alist-of string? (list-of lexeme?))))
 
-(define (concat-token? token)            (equal? "##"  (punctuator-token? token)))
+(define (concat-token? token)            (and (equal? "##"  (punctuator-token? token))
+                                              (not (member "##" (lexeme-noexpand token)))))
 (define (stringify-token? token)         (equal? "#"   (punctuator-token? token)))
 (define (left-parenthesis-token? token)  (equal? "("   (punctuator-token? token)))
 (define (right-parenthesis-token? token) (equal? ")"   (punctuator-token? token)))
@@ -90,8 +91,15 @@
                     (loop (cdr l) r))
                    ((placemaker-token? (car r))
                     (loop (cdr l) (cons (car l) (cdr r))))
-                   (else (loop (cdr l) (cons (concatenate-tokens (car l) (car r))
-                                             (cdr r)))))))
+                   (else
+                    ;; 6.10.3.3 p. 3
+                    ;; I believe that ## is the only special case where the
+                    ;; result of concatenation is differente from the token directly.
+                    (let ((token (concatenate-tokens (car l) (car r))))
+                      (let ((token (if (concat-token? token)
+                                       (modify token lexeme-noexpand xcons "##")
+                                       token)))
+                        (loop (cdr l) (cons token (cdr r)))))))))
           (else
            (let ((pre post (break concat-token? right)))
              (loop (append left (reverse pre)) post))))))
diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index 2d95269a..182390c6 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -35,7 +35,7 @@
   :use-module (c lex2)
   )
 
-(test-expect-fail "x ## y")
+;; (test-expect-fail "x ## y")
 
 (define apply-macro (@@ (c preprocessor2) apply-macro))
 (define build-parameter-map (@@ (c preprocessor2) build-parameter-map))
@@ -694,14 +694,14 @@ f(a)"))
 
  ;; 6.10.3.3 p. 4
  (test-equal "x ## y"
-   (lex "\"x ## y\"")
+   (lex "char p[] = \"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)")))
+char p[] = join(x, y)")))
 
 (test-group "__VA_ARGS__"
  (test-equal "__VA_ARGS__ split its arguments"
@@ -834,6 +834,21 @@ f(g)(5)"))
 ;;  #<<lexeme> type: preprocessing-token body: (pp-number "5") noexpand: ()>
 ;;  #<<lexeme> type: preprocessing-token body: (punctuator ")") noexpand: ()>)
 
+(test-equal "non-adjacent parameter list"
+  (lex "2*10")
+  (run "
+#define f(x) 2*x
+f       (10)"))
+
+(test-equal "parameter-list on own line"
+  (lex "2*10")
+  (run "
+#define f(x) 2*x
+f
+
+
+(10)"))
+
 (define unlex (@ (c unlex) unlex))
 
 (test-group "6.10.3.5 Scope of macro definitions"
-- 
cgit v1.2.3