Fix #line

3 files changed, 64 insertions, 21 deletions

diff --git a/module/c/cpp-types.scm b/module/c/cpp-types.scm
index 64bf6a7b..e21a8f0c 100644
--- a/module/c/cpp-types.scm
+++ b/module/c/cpp-types.scm
@@ -6,7 +6,11 @@
            comment-token?
            preprocessing-token?
            newline-token?
-           identifier-token?))
+           identifier-token?
+           punctuator-token?
+           number-token?
+           string-token?
+           ))
 
 (define (whitespace-token? x)
   (eq? 'whitespace (lexeme-type x)))
@@ -26,3 +30,21 @@
        (match (lexeme-body token)
          (`(identifier ,id) id)
          (_ #f))))
+
+(define (punctuator-token? token)
+  (and (preprocessing-token? token)
+       (match (lexeme-body token)
+         (`(punctuator ,x) x)
+         (_ #f))))
+
+(define (number-token? token)
+  (and (preprocessing-token? token)
+       (match (lexeme-body token)
+         (`(pp-number ,x) x)
+         (_ #f))))
+
+(define (string-token? token)
+  (and (preprocessing-token? token)
+       (match (lexeme-body token)
+         (`(string-literal ,x) x)
+         (_ #f))))
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index 2d2a9530..a6710314 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -464,27 +464,28 @@
   (typecheck environment cpp-environment?)
   (typecheck tokens* (list-of lexeme?))
 
-  ;; TODO rewrite without match
   (let loop ((%first-time #t) (tokens tokens*))
-    (match tokens
-      (`((preprocessing-token (pp-number ,line)) (whitespace ,_) ... rest ...)
-       (match rest
-         (`((preprocessing-token (string-literal ,file)) (whitespace ,_) ...)
-          (-> environment
-              (set current-line line)
-              (set current-file file)))
-         (`((whitespace ,_) ...)
-          (set environment current-line line))
-         (_ (unless %first-time
-              (scm-error 'cpp-error "handle-line-directive"
-                         "Invalid line directive: ~s"
-                         (list tokens*) #f))
-            (loop #f (resolve-token-stream environment tokens)))))
-      (_ (unless %first-time
-           (scm-error 'cpp-error "handle-line-directive"
-                      "Invalid line directive: ~s"
-                      (list tokens*) #f))
-         (loop #f (resolve-token-stream environment tokens))))))
+    (cond ((null? tokens))
+          ((number-token? (car tokens))
+           => (lambda (line)
+                (let ((line (string->number line)))
+                 (let ((remaining (drop-whitespace (cdr tokens))))
+                   (cond ((null? remaining) (set environment current-line line))
+                         ((string-token? (car remaining))
+                          => (lambda (file)
+                               (-> environment
+                                   (set current-line line)
+                                   (set current-file file))))
+                         (%first-time
+                          (loop #f (resolve-token-stream environment tokens)))
+                         (else (scm-error 'cpp-error "handle-line-directive"
+                                          "Invalid line directive: ~s"
+                                          (list tokens*) #f)
+                               ))))))
+          (%first-time (loop #f (resolve-token-stream environment tokens)))
+          (else (scm-error 'cpp-error "handle-line-directive"
+                           "Invalid line directive: ~s"
+                           (list tokens*) #f)))))
 
 ;; environment, tokens → environment
 (define (resolve-define environment tokens)
diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index e2ff0a17..9e11bb04 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -545,6 +545,26 @@ 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 <number>"
+      '(("*outside*" . 10))
+      (cpp-file-stack (handle-line-directive e (lex "10"))))
+    (test-equal "#line <line> <file>"
+      '(("file" . 10))
+      (cpp-file-stack (handle-line-directive e (lex "10 \"file\""))))
+
+    (test-equal "#line <macro>"
+      '(("*outside*" . 10))
+      (cpp-file-stack
+       (handle-line-directive
+        (resolve-define e (lex "x 10"))
+        (lex "x"))))))
+
+
 ;; resolve-h-file
 ;; resolve-q-file
 ;; handle-pragma