andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

HACK resurrect configure.

This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-12-29 16:50:22 +01:00
parent 30f49c25d4
commit 6cfb8d4cfb
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
1 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
configure vendored
View File

@ -86,10 +86,10 @@ MES_ARENA=100000000 exec ${SCHEME-guile} -L . --no-auto-compile -e '(configure)'
(define (verbose string . rest) (define (verbose string . rest)
(if %verbose? (apply stderr (cons string rest)))) (if %verbose? (apply stderr (cons string rest))))
(define (gulp-pipe* . command) (define (gulp-pipe command)
(let* ((err (current-error-port)) (let* ((err (current-error-port))
(foo (set-current-error-port (open-output-file ".error"))) (foo (set-current-error-port (open-output-file ".error")))
(port (apply open-pipe* OPEN_READ command)) (port (open-pipe command "r"))
(output (read-string port)) (output (read-string port))
(status (close-pipe port)) (status (close-pipe port))
(error (with-input-from-file ".error" read-string))) (error (with-input-from-file ".error" read-string)))
@ -100,6 +100,9 @@ MES_ARENA=100000000 exec ${SCHEME-guile} -L . --no-auto-compile -e '(configure)'
(if (not (zero? status)) "" (if (not (zero? status)) ""
(string-trim-right (string-append output error))))) (string-trim-right (string-append output error)))))
(define (gulp-pipe* . command)
(gulp-pipe (string-join command)))
(define (tuple< a b) (define (tuple< a b)
(cond (cond
((and (null? a) (null? b)) #t) ((and (null? a) (null? b)) #t)
@ -195,20 +198,17 @@ MES_ARENA=100000000 exec ${SCHEME-guile} -L . --no-auto-compile -e '(configure)'
(version-option (dependency-version-option dependency)) (version-option (dependency-version-option dependency))
(commands (dependency-commands dependency))) (commands (dependency-commands dependency)))
(let loop ((commands commands)) (let loop ((commands commands))
(if (null? commands) dependency (if (or (null? commands)
(not (car commands))) dependency
(let ((command (car commands))) (let ((command (car commands)))
(stdout "checking for ~a~a... " name (stdout "checking for ~a~a... " (if (string-index command #\space) name command)
(if (null? expected) "" (if (null? expected) ""
(format #f " [~a]" (version->string expected)))) (format #f " [~a]" (version->string expected))))
(let* ((output (gulp-pipe* command version-option)) (let* ((output (gulp-pipe (string-append command " " (if version-option version-option ""))))
;;(foo (stderr "output=~s\n" output))
(actual (string->version output)) (actual (string->version output))
;;(foo (stderr "actual=~s\n" actual))
;;(foo (stderr "expected=~s\n" expected))
(pass? (and actual (tuple< expected actual))) (pass? (and actual (tuple< expected actual)))
;;(foo (stderr "PASS?~s\n" pass?))
(dependency (set-field dependency (dependency-version-found) actual))) (dependency (set-field dependency (dependency-version-found) actual)))
(stdout "~a ~a\n" (if pass? (if (pair? actual) "" " yes") (stdout "~a ~a\n" (if pass? (if (pair? actual) "" "yes")
(if actual " no, found" "no")) (if actual " no, found" "no"))
(or (version->string actual) "")) (or (version->string actual) ""))
(if pass? (let ((file-name (or (PATH-search-path command) (if pass? (let ((file-name (or (PATH-search-path command)