cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use with-exception-handler in place of with-throw-handler

Browse source
This commit is contained in:
Christopher Baines 2025-02-25 10:38:10 +00:00
parent 1da2a09cfb
commit e591346684
7 changed files with 109 additions and 98 deletions
Download patch file Download diff file Expand all files Collapse all files

60
scripts/guix-data-service-process-jobs.in
View file

@ -25,6 +25,7 @@
(use-modules (srfi srfi-1)
(srfi srfi-37)
(ice-9 match)
(knots)
(guix-data-service database)
(guix-data-service jobs))
@ -110,37 +111,34 @@
(simple-format #t "Ready to process jobs...\n")
(with-exception-handler
(lambda (exn)
(simple-format
(current-error-port)
"exception: ~A\n"
exn)
(exit 1))
(lambda ()
(with-throw-handler #t
(lambda ()
(process-jobs
conn
#:max-processes (assq-ref opts 'max-processes)
#:latest-branch-revision-max-processes
(or (assq-ref opts 'latest-branch-revision-max-processes)
(* 2 (assq-ref opts 'max-processes)))
#:skip-system-tests?
(assq-ref opts 'skip-system-tests)
#:extra-inferior-environment-variables
(filter-map
(match-lambda
(('inferior-environment-variable key val)
(cons key val))
(_ #f))
opts)
#:per-job-parallelism
(assq-ref opts 'per-job-parallelism)
#:ignore-systems (assq-ref opts 'ignore-systems)
#:ignore-targets (assq-ref opts 'ignore-targets)
#:free-space-requirement
(assq-ref opts 'free-space-requirement)
#:timeout
(assq-ref opts 'timeout)))
(lambda _
(backtrace))))
(with-exception-handler
(lambda (exn)
(print-backtrace-and-exception/knots exn)
(raise-exception exn))
(lambda ()
(process-jobs
conn
#:max-processes (assq-ref opts 'max-processes)
#:latest-branch-revision-max-processes
(or (assq-ref opts 'latest-branch-revision-max-processes)
(* 2 (assq-ref opts 'max-processes)))
#:skip-system-tests?
(assq-ref opts 'skip-system-tests)
#:extra-inferior-environment-variables
(filter-map
(match-lambda
(('inferior-environment-variable key val)
(cons key val))
(_ #f))
opts)
#:per-job-parallelism
(assq-ref opts 'per-job-parallelism)
#:ignore-systems (assq-ref opts 'ignore-systems)
#:ignore-targets (assq-ref opts 'ignore-targets)
#:free-space-requirement
(assq-ref opts 'free-space-requirement)
#:timeout
(assq-ref opts 'timeout)))))
#:unwind? #t))))