commit 09de1d17f8f599531493ac4e43f680b88154f128
parent 5947945ef1b00beb0744635095b6e1a6259a6a2a
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Fri, 1 May 2026 18:48:04 -0700
merge: lex/pp bug fixes (4 bugs)
Diffstat:
9 files changed, 71 insertions(+), 25 deletions(-)
diff --git a/cc/cc.scm b/cc/cc.scm
@@ -1651,7 +1651,12 @@
(else
(let* ((r (%lex-read-punct src pos1 line1 col1 file))
(tok (car r)) (rest (cdr r)))
- (set! kind 'PUNCT) (set! val (tok-value tok))
+ ;; Line-leading `%:` digraph also acts as HASH for directives.
+ (cond
+ ((and bol? (eq? (tok-value tok) 'hash))
+ (set! kind 'HASH))
+ (else
+ (set! kind 'PUNCT) (set! val (tok-value tok))))
(set! npos (car rest))
(set! nline (car (cdr rest)))
(set! ncol (car (cdr (cdr rest))))))))))
@@ -1769,19 +1774,22 @@
(bv= name %pp-bv-STDC-VERSION) (bv= name %pp-bv-STDC-HOSTED)))
(define (%pp-expand-builtin name loc state)
+ ;; Emit the token at the ORIGINAL loc; %pp-relocate downstream will
+ ;; apply pps-cur-file / pps-line-delta. Doing the rewrite here too
+ ;; (then letting relocate re-apply it) double-shifts __LINE__'s loc.
+ ;; The VALUE of __LINE__ / __FILE__ already reflects the post-#line
+ ;; mapping because we compute `file`/`line` from cur-file/line-delta.
(let* ((file (or (pps-cur-file state) (loc-file loc)))
- (line (+ (loc-line loc) (pps-line-delta state)))
- (col (loc-col loc))
- (here (%loc file line col)))
+ (line (+ (loc-line loc) (pps-line-delta state))))
(cond
- ((bv= name %pp-bv-FILE) (list (%tok 'STR file here '())))
- ((bv= name %pp-bv-LINE) (list (%tok 'INT line here '())))
- ((bv= name %pp-bv-STDC) (list (%tok 'INT 1 here '())))
- ((bv= name %pp-bv-LISPCC) (list (%tok 'INT 1 here '())))
- ((bv= name %pp-bv-DATE) (list (%tok 'STR %pp-bv-DATE-VALUE here '())))
- ((bv= name %pp-bv-TIME) (list (%tok 'STR %pp-bv-TIME-VALUE here '())))
- ((bv= name %pp-bv-STDC-VERSION) (list (%tok 'INT 199901 here '())))
- ((bv= name %pp-bv-STDC-HOSTED) (list (%tok 'INT 1 here '())))
+ ((bv= name %pp-bv-FILE) (list (%tok 'STR file loc '())))
+ ((bv= name %pp-bv-LINE) (list (%tok 'INT line loc '())))
+ ((bv= name %pp-bv-STDC) (list (%tok 'INT 1 loc '())))
+ ((bv= name %pp-bv-LISPCC) (list (%tok 'INT 1 loc '())))
+ ((bv= name %pp-bv-DATE) (list (%tok 'STR %pp-bv-DATE-VALUE loc '())))
+ ((bv= name %pp-bv-TIME) (list (%tok 'STR %pp-bv-TIME-VALUE loc '())))
+ ((bv= name %pp-bv-STDC-VERSION) (list (%tok 'INT 199901 loc '())))
+ ((bv= name %pp-bv-STDC-HOSTED) (list (%tok 'INT 1 loc '())))
(else (die loc "internal: not a builtin" name)))))
;; --- buf-list: simple reversed-list buffer of toks ---
@@ -2072,32 +2080,42 @@
(else (cons (car al) (%pp-alist-drop key (cdr al))))))
;; --- #if / #ifdef / #ifndef / #elif / #else / #endif ---
+;; cond-stack frame: (active? taken? else?). active? gates the body
+;; until the next #elif/#else/#endif; taken? records whether ANY arm
+;; (the original #if branch or any #elif) has matched, so later arms
+;; stay inactive; else? records that we have already passed an #else
+;; in this frame, so a subsequent #elif/#else is rejected.
+(define (%pp-frame a? t? e?) (list a? t? e?))
+(define (%pp-frame-active? f) (car f))
+(define (%pp-frame-taken? f) (car (cdr f)))
+(define (%pp-frame-else? f) (car (cdr (cdr f))))
+
(define (%pp-do-if line state)
(cond
((not (%pp-active? state))
- (pps-cond-stack-set! state (cons (cons #f #f) (pps-cond-stack state))))
+ (pps-cond-stack-set! state (cons (%pp-frame #f #f #f) (pps-cond-stack state))))
(else
(let* ((v (pp-eval-cexpr line (pps-macros state)))
(a? (not (= v 0))))
- (pps-cond-stack-set! state (cons (cons a? a?) (pps-cond-stack state)))))))
+ (pps-cond-stack-set! state (cons (%pp-frame a? a? #f) (pps-cond-stack state)))))))
(define (%pp-do-ifdef line state)
(cond
((not (%pp-active? state))
- (pps-cond-stack-set! state (cons (cons #f #f) (pps-cond-stack state))))
+ (pps-cond-stack-set! state (cons (%pp-frame #f #f #f) (pps-cond-stack state))))
(else
(let ((d? (%pp-defined? (%pp-name-of-single line) state)))
(pps-cond-stack-set! state
- (cons (cons d? d?) (pps-cond-stack state)))))))
+ (cons (%pp-frame d? d? #f) (pps-cond-stack state)))))))
(define (%pp-do-ifndef line state)
(cond
((not (%pp-active? state))
- (pps-cond-stack-set! state (cons (cons #f #f) (pps-cond-stack state))))
+ (pps-cond-stack-set! state (cons (%pp-frame #f #f #f) (pps-cond-stack state))))
(else
(let ((a? (not (%pp-defined? (%pp-name-of-single line) state))))
(pps-cond-stack-set! state
- (cons (cons a? a?) (pps-cond-stack state)))))))
+ (cons (%pp-frame a? a? #f) (pps-cond-stack state)))))))
(define (%pp-name-of-single line)
(cond
@@ -2117,16 +2135,18 @@
((null? cs) (die #f "#elif outside #if"))
(else
(let* ((top (car cs)) (rest (cdr cs))
- (taken? (cdr top))
+ (taken? (%pp-frame-taken? top))
+ (else? (%pp-frame-else? top))
(par? (%pp-parent-active? state)))
(cond
+ (else? (die #f "#elif after #else"))
((or (not par?) taken?)
- (pps-cond-stack-set! state (cons (cons #f taken?) rest)))
+ (pps-cond-stack-set! state (cons (%pp-frame #f taken? #f) rest)))
(else
(let* ((v (pp-eval-cexpr line (pps-macros state)))
(a? (not (= v 0))))
(pps-cond-stack-set! state
- (cons (cons a? (or a? taken?)) rest))))))))))
+ (cons (%pp-frame a? (or a? taken?) #f) rest))))))))))
(define (%pp-do-else line state)
(let ((cs (pps-cond-stack state)))
@@ -2134,15 +2154,17 @@
((null? cs) (die #f "#else outside #if"))
(else
(let* ((top (car cs)) (rest (cdr cs))
- (taken? (cdr top))
+ (taken? (%pp-frame-taken? top))
+ (else? (%pp-frame-else? top))
(par? (%pp-parent-active? state)))
(cond
+ (else? (die #f "#else after #else"))
((not par?)
- (pps-cond-stack-set! state (cons (cons #f taken?) rest)))
+ (pps-cond-stack-set! state (cons (%pp-frame #f taken? #t) rest)))
(taken?
- (pps-cond-stack-set! state (cons (cons #f #t) rest)))
+ (pps-cond-stack-set! state (cons (%pp-frame #f #t #t) rest)))
(else
- (pps-cond-stack-set! state (cons (cons #t #t) rest)))))))))
+ (pps-cond-stack-set! state (cons (%pp-frame #t #t #t) rest)))))))))
(define (%pp-do-endif line state)
(let ((cs (pps-cond-stack state)))
diff --git a/tests/cc-pp/50-stringize-char-special.c b/tests/cc-pp/50-stringize-char-special.c
@@ -0,0 +1,2 @@
+#define S(x) #x
+S('\n')
diff --git a/tests/cc-pp/50-stringize-char-special.expected-toks b/tests/cc-pp/50-stringize-char-special.expected-toks
@@ -0,0 +1,2 @@
+(STR "'\\n'" "50-stringize-char-special.c" 1 14)
+(EOF #f "50-stringize-char-special.c" 3 1)
diff --git a/tests/cc-pp/52-digraph-hash-directive.c b/tests/cc-pp/52-digraph-hash-directive.c
@@ -0,0 +1,2 @@
+%:define FOO 7
+FOO
diff --git a/tests/cc-pp/52-digraph-hash-directive.expected-toks b/tests/cc-pp/52-digraph-hash-directive.expected-toks
@@ -0,0 +1,2 @@
+(INT 7 "52-digraph-hash-directive.c" 1 14)
+(EOF #f "52-digraph-hash-directive.c" 3 1)
diff --git a/tests/cc-pp/53-line-directive-effect.c b/tests/cc-pp/53-line-directive-effect.c
@@ -0,0 +1,4 @@
+__LINE__
+#line 100 "x.c"
+__LINE__
+__FILE__
diff --git a/tests/cc-pp/53-line-directive-effect.expected-toks b/tests/cc-pp/53-line-directive-effect.expected-toks
@@ -0,0 +1,4 @@
+(INT 1 "53-line-directive-effect.c" 1 1)
+(INT 100 "x.c" 100 1)
+(STR "x.c" "x.c" 101 1)
+(EOF #f "53-line-directive-effect.c" 5 1)
diff --git a/tests/cc-pp/54-elif-after-else.c b/tests/cc-pp/54-elif-after-else.c
@@ -0,0 +1,7 @@
+#if 0
+1
+#else
+2
+#elif 1
+3
+#endif
diff --git a/tests/cc-pp/54-elif-after-else.expected-exit b/tests/cc-pp/54-elif-after-else.expected-exit
@@ -0,0 +1 @@
+1
