diff options
| author | Christopher Baines <mail@cbaines.net> | 2025-04-08 18:14:41 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2025-04-08 18:14:41 +0100 |
| commit | d78c2dff53f21b6c2f2c4668df46ee18fb1e6431 (patch) | |
| tree | f514c1c27d1c47b78b6d52851d778f41b53cdcfe | |
| parent | 7f3ea5eb9321e0a6d3da6bb47bf725bcec0f5937 (diff) | |
| download | qa-frontpage-d78c2dff53f21b6c2f2c4668df46ee18fb1e6431.tar qa-frontpage-d78c2dff53f21b6c2f2c4668df46ee18fb1e6431.tar.gz | |
Check the exit val from close-pipe
| -rw-r--r-- | guix-qa-frontpage/git-repository.scm | 32 |
1 files changed, 25 insertions, 7 deletions
diff --git a/guix-qa-frontpage/git-repository.scm b/guix-qa-frontpage/git-repository.scm index 15f8fec..13e5a03 100644 --- a/guix-qa-frontpage/git-repository.scm +++ b/guix-qa-frontpage/git-repository.scm @@ -132,8 +132,14 @@ (let loop ((line (read-line pipe)) (lines '())) (if (eof-object? line) - (begin - (close-pipe pipe) + (let ((exit-val + (status:exit-val (close-pipe pipe)))) + (unless (= 0 exit-val) + (raise-exception + (make-exception-with-message + (simple-format #f "error doing git show on ~A (exit-val: ~A)" + branch + exit-val)))) (if (null? lines) #f @@ -150,8 +156,15 @@ (let loop ((line (read-line pipe)) (lines '())) (if (eof-object? line) - (begin - (close-pipe pipe) + (let ((exit-val + (status:exit-val (close-pipe pipe)))) + (unless (= 0 exit-val) + (raise-exception + (make-exception-with-message + (simple-format #f "error doing merge-base on ~A ~A (exit-val: ~A)" + a + b + exit-val)))) (if (null? lines) #f @@ -167,9 +180,14 @@ (let loop ((line (read-line pipe)) (result '())) (if (eof-object? line) - (begin - (close-pipe pipe) - + (let ((exit-val + (status:exit-val (close-pipe pipe)))) + (unless (= 0 exit-val) + (raise-exception + (make-exception-with-message + (simple-format #f "error doing ls-remote on ~A (exit-val: ~A)" + remote + exit-val)))) result) (let ((commit (string-take line 40)) (branch (string-drop line 52))) |