unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
From: ludo@gnu.org (Ludovic Courtès)
To: Eric Bavier <bavier@cray.com>
Cc: 28779@debbugs.gnu.org
Subject: bug#28779: tests/workers.scm failure
Date: Thu, 16 Nov 2017 09:29:38 +0100	[thread overview]
Message-ID: <87shdelj7x.fsf@gnu.org> (raw)
In-Reply-To: <BN6PR11MB1716104DFEB0F233C68756E5B7750@BN6PR11MB1716.namprd11.prod.outlook.com> (Eric Bavier's message of "Tue, 10 Oct 2017 15:48:42 +0000")

[-- Attachment #1: Type: text/plain, Size: 1162 bytes --]

Hi Eric,

Eric Bavier <bavier@cray.com> skribis:

> test-name: enqueue
> location: /home/users/bavier/src/guix/tests/workers.scm:26
> source:
> + (test-equal
> +   "enqueue"
> +   4242
> +   (let* ((pool (make-pool))
> +          (result 0)
> +          (#{1+!}# (let ((lock (make-mutex)))
> +                     (lambda ()
> +                       (with-mutex lock (set! result (+ result 1)))))))
> +     (let loop ((i 4242))
> +       (unless
> +         (zero? i)
> +         (pool-enqueue! pool #{1+!}#)
> +         (loop (- i 1))))
> +     (let poll ()
> +       (unless
> +         (pool-idle? pool)
> +         (pk 'busy result)
> +         (sleep 1)
> +         (poll)))
> +     result))
> expected-value: 4242
> actual-value: 4241
> result: FAIL
>
>
> To me the reason seems to be that the 'pool-idle? procedure indicates whether or not the task queue is empty, not whether all tasks have completed execution, so the poll loop exits before all 1+! updates are finished and the test fails.  

Indeed, good catch.

The attached patch is a bit crude but it should fix the problem.

Thoughts?

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 3017 bytes --]

diff --git a/guix/workers.scm b/guix/workers.scm
index 846f5e50a..0f6f54bab 100644
--- a/guix/workers.scm
+++ b/guix/workers.scm
@@ -45,12 +45,13 @@
 ;;; Code:
 
 (define-record-type <pool>
-  (%make-pool queue mutex condvar workers)
+  (%make-pool queue mutex condvar workers busy)
   pool?
   (queue    pool-queue)
   (mutex    pool-mutex)
   (condvar  pool-condition-variable)
-  (workers  pool-workers))
+  (workers  pool-workers)
+  (busy     pool-busy))
 
 (define-syntax-rule (without-mutex mutex exp ...)
   (dynamic-wind
@@ -62,12 +63,14 @@
       (lock-mutex mutex))))
 
 (define* (worker-thunk mutex condvar pop-queue
-                       #:key (thread-name "guix worker"))
+                       #:key idle busy (thread-name "guix worker"))
   "Return the thunk executed by worker threads."
   (define (loop)
     (match (pop-queue)
       (#f                                         ;empty queue
-       (wait-condition-variable condvar mutex))
+       (idle)
+       (wait-condition-variable condvar mutex)
+       (busy))
       ((? procedure? proc)
        ;; Release MUTEX while executing PROC.
        (without-mutex mutex
@@ -97,19 +100,24 @@ threads as reported by the operating system."
   (let* ((mutex   (make-mutex))
          (condvar (make-condition-variable))
          (queue   (make-q))
+         (busy    count)
          (procs   (unfold (cut >= <> count)
                           (lambda (n)
                             (worker-thunk mutex condvar
                                           (lambda ()
                                             (and (not (q-empty? queue))
                                                  (q-pop! queue)))
+                                          #:busy (lambda ()
+                                                   (set! busy (+ 1 busy)))
+                                          #:idle (lambda ()
+                                                   (set! busy (- busy 1)))
                                           #:thread-name thread-name))
                           1+
                           0))
          (threads (map (lambda (proc)
                          (call-with-new-thread proc))
                        procs)))
-    (%make-pool queue mutex condvar threads)))
+    (%make-pool queue mutex condvar threads (lambda () busy))))
 
 (define (pool-enqueue! pool thunk)
   "Enqueue THUNK for future execution by POOL."
@@ -118,9 +126,11 @@ threads as reported by the operating system."
     (signal-condition-variable (pool-condition-variable pool))))
 
 (define (pool-idle? pool)
-  "Return true if POOL doesn't have any task in its queue."
+  "Return true if POOL doesn't have any task in its queue and all the workers
+are currently idle (i.e., waiting for a task)."
   (with-mutex (pool-mutex pool)
-    (q-empty? (pool-queue pool))))
+    (and (q-empty? (pool-queue pool))
+         (zero? ((pool-busy pool))))))
 
 (define-syntax-rule (eventually pool exp ...)
   "Run EXP eventually on one of the workers of POOL."

  reply	other threads:[~2017-11-16  8:30 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-10-10 15:48 bug#28779: tests/workers.scm failure Eric Bavier
2017-11-16  8:29 ` Ludovic Courtès [this message]
2017-11-17  2:58   ` Eric Bavier
2017-11-17 10:10     ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87shdelj7x.fsf@gnu.org \
    --to=ludo@gnu.org \
    --cc=28779@debbugs.gnu.org \
    --cc=bavier@cray.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).