diff --git a/Makefile.am b/Makefile.am index 5dccd82b..2d5c7691 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ # Makefile.am - top level -# Copyright (C) 2018, 2019, 2020 Michael L. Gran +# Copyright (C) 2018, 2019, 2020, 2021 Michael L. Gran # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -373,6 +373,7 @@ TESTS = \ test/oop.scm \ test/value.scm \ test/flags.scm \ + test/task.scm \ test/type.scm \ test/signals.scm \ test/logging.scm \ diff --git a/test/task.scm b/test/task.scm new file mode 100644 index 00000000..3d140d03 --- /dev/null +++ b/test/task.scm @@ -0,0 +1,125 @@ +(use-modules (gi) (gi types) (gi repository) + (oop goops) + (system foreign) + (ice-9 format) + (srfi srfi-64)) + +(use-typelibs ("GLib" "2.0") ("Gio" "2.0")) + +(test-begin "task") + +(define loop #f) + +(test-assert "new MainLoop" + (begin (set! loop (main-loop:new #f #t)) + (is-a? loop ))) + +(test-assert "create a task" + (let ((T (task:new))) + (task:is-valid? T))) + +(test-assert "create a task acting on an object" + (let* ((obj (make )) + (T (task:new obj))) + (task:is-valid? T obj))) + +(test-assert "create a task with a Cancellable" + (let* ((kancel (cancellable:new)) + (T (task:new #f kancel))) + (task:is-valid? T))) + +(test-equal "return pointer from a task" + #x1234 + (let ((T (task:new))) + (idle-add PRIORITY_DEFAULT + (lambda (data) + (return-pointer T (make-pointer #x1234)) + (quit loop) + #f)) + (main-loop:run loop) + (pointer-address (propagate-pointer T)))) + +(test-equal "return pointer from a task via its callback" + #x1234 + (let* ((return-value #f) + (iter 0) + (T (task:new + #f + #f + (lambda (source task data) + (set! return-value (pointer-address (propagate-pointer task))))))) + (idle-add PRIORITY_DEFAULT + (lambda (data) + (when (zero? iter) + (return-pointer T (make-pointer #x1234))) + (set! iter (1+ iter)) + (if return-value + (begin + (quit loop) + #f) + ;; else + #t))) + (main-loop:run loop) + return-value)) + +(test-equal "return pointer from a task run in thread" + #x1234 + (let ((T (task:new (make )))) + (run-in-thread T + (lambda (task source data kancel) + (return-pointer T (make-pointer #x1234)))) + (idle-add PRIORITY_DEFAULT + (lambda (data) + (if (get-completed? T) + (begin + (quit loop) + #f) + ;; else + #t))) + (main-loop:run loop) + (pointer-address (propagate-pointer T)))) + +(test-assert "cancel task and check cancellable" + (let* ((kancel (cancellable:new)) + (T (task:new #f kancel))) + (idle-add PRIORITY_DEFAULT + (lambda (data) + (cancel kancel) + (quit loop) + #f)) + (main-loop:run loop) + (is-cancelled? kancel))) + +(test-assert "cancel task and check task was cancelled" + (let* ((kancel (cancellable:new)) + (T (task:new #f kancel))) + (idle-add PRIORITY_DEFAULT + (lambda (data) + (cancel kancel) + (quit loop) + #f)) + (main-loop:run loop) + (return-error-if-cancelled? T))) + + +(test-equal "attach pointer to a task and retrieve" + #xBEEF + (let ((T (task:new))) + (set-task-data T (make-pointer #xBEEF)) + (pointer-address (get-task-data T)))) + +(test-assert "attach pointer and DestroyNotify to a task" + (let ((T (task:new)) + (destroyed #f)) + ;; Add some data, plus a lambda to be called when the data + ;; is overwritten. + (set-task-data T + (make-pointer #xFACE) + (lambda (ptr) + (set! destroyed #t))) + ;; Overwrite the data. + (set-task-data T + (make-pointer #xD00D)) + destroyed)) + +(test-end "task")