diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-02-28 01:01:51 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-02-28 01:01:51 +0100 |
commit | ca1e3ad2faa59d5b32289f84e0937fa476e21a1a (patch) | |
tree | 288f0b63733f849c94b8a41226946bc8229ec448 /guix | |
parent | f9efe568c3cd46f0aecb5bdd35731e98a29dbcea (diff) |
utils: Change 'patch-shebangs' to use binary input.
* guix/build/utils.scm (get-char*): New procedure.
(patch-shebang): Use it instead of 'read-char'.
(fold-port-matches): Remove local 'get-char' and use 'get-char*'
instead.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/utils.scm | 22 |
1 files changed, 11 insertions, 11 deletions
diff --git a/guix/build/utils.scm b/guix/build/utils.scm index a3f8911491..c98c4ca0f0 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -618,6 +618,14 @@ transferred and the continuation of the transfer as a thunk." (stat:atimensec stat) (stat:mtimensec stat))) +(define (get-char* p) + ;; We call it `get-char', but that's really a binary version + ;; thereof. (The real `get-char' cannot be used here because our + ;; bootstrap Guile is hacked to always use UTF-8.) + (match (get-u8 p) + ((? integer? x) (integer->char x)) + (x x))) + (define patch-shebang (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$"))) (lambda* (file @@ -653,8 +661,8 @@ FILE are kept unchanged." (call-with-ascii-input-file file (lambda (p) - (and (eq? #\# (read-char p)) - (eq? #\! (read-char p)) + (and (eq? #\# (get-char* p)) + (eq? #\! (get-char* p)) (let ((line (false-if-exception (read-line p)))) (and=> (and line (regexp-exec shebang-rx line)) (lambda (m) @@ -753,21 +761,13 @@ for each unmatched character." (map char-set (string->list pattern)) pattern)) - (define (get-char p) - ;; We call it `get-char', but that's really a binary version - ;; thereof. (The real `get-char' cannot be used here because our - ;; bootstrap Guile is hacked to always use UTF-8.) - (match (get-u8 p) - ((? integer? x) (integer->char x)) - (x x))) - ;; Note: we're not really striving for performance here... (let loop ((chars '()) (pattern initial-pattern) (matched '()) (result init)) (cond ((null? chars) - (loop (list (get-char port)) + (loop (list (get-char* port)) pattern matched result)) |