suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

xform: accomodate unusual #pragma placement

Browse Source 
The Mac OS 10.15 headers include a `#pragma` just before the closing
`;` of a `struct` declaration. That confuses poor xform. Handle this
special case by  detecting it and swapping the order of the `#pragma`
and `;`.
This commit is contained in:
Matthew Flatt 2019-09-30 18:10:47 -06:00
parent fa1c2219ab
commit 27c1847ce8
1 changed files with 14 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
racket/collects/compiler/private/xform.rkt
View File

@ -495,7 +495,7 @@
(and precompiled-header
(open-input-file (change-extension precompiled-header #".e"))))
(define re:boring #rx#"^(?:(?:[ \t]*)|(?:# .*)|(?:#line .*)|(?:#pragma implementation.*)|(?:#pragma interface.*)|(?:#pragma once)|(?:#pragma warning.*)|(?:#ident.*))$")
(define re:uninteresting #rx#"^(?:(?:[ \t]*)|(?:# .*)|(?:#line .*)|(?:#pragma implementation.*)|(?:#pragma interface.*)|(?:#pragma once)|(?:#pragma GCC diagnostic.*)|(?:#pragma warning.*)|(?:#ident.*))$")
(define re:uninteresting #rx#"^(?:(?:[ \t]*)|(?:# .*)|(?:#line .*)|(?:#pragma implementation.*)|(?:#pragma interface.*)|(?:#pragma once)|(?:#pragma (?:GCC|clang) diagnostic.*)|(?:#pragma warning.*)|(?:#ident.*))$")
(define (skip-to-interesting-line p)
(let ([l (read-bytes-line p 'any)])
(cond
@ -506,7 +506,7 @@
(when recorded-cpp-in
;; Skip over common part:
(let loop ([lpos 1])
(let ([pl (read-bytes-line recorded-cpp-in 'any)])
(let ([pl (skip-to-interesting-line recorded-cpp-in)])
(unless (eof-object? pl)
(let ([l (skip-to-interesting-line (car cpp-process))])
(unless (equal? pl l)
@ -4073,11 +4073,18 @@
(cond
[(null? e) (values (reverse result) null)]
[(pragma? (car e))
(unless (null? result)
(error 'pragma "unexpected pragma: ~a at: ~a:~a"
(pragma-s (car e))
(pragma-file (car e)) (pragma-line (car e))))
(values (list (car e)) (cdr e))]
(cond
[(null? result)
(values (list (car e)) (cdr e))]
[(and (pair? (cdr e))
(eq? semi (tok-n (cadr e))))
;; Swap order of pragma and terminating semicolon
(values (reverse (cons (cadr e) result))
(cons (car e) (cddr e)))]
[else
(error 'pragma "unexpected pragma: ~a at: ~a:~a"
(pragma-s (car e))
(pragma-file (car e)) (pragma-line (car e)))])]
[(compiler-pragma? e)
(unless (null? result)
(error 'pragma "unexpected MSVC compiler pragma"))