# threadkit-unit-test.pkg
# Compiled by:
# src/lib/test/unit-tests.lib# Run by:
# src/lib/test/all-unit-tests.pkg# Unit tests for:
# src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkgstipulate
package tim = time; # time is from src/lib/std/time.pkg package tsc = thread_scheduler_control; # thread_scheduler_control is from src/lib/src/lib/thread-kit/src/posix/thread-scheduler-control.pkgherein
package threadkit_unit_test {
# unit_test is from src/lib/src/unit-test.pkg # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg # mailslot is from src/lib/src/lib/thread-kit/src/core-thread-kit/mailslot.pkg # maildrop is from src/lib/src/lib/thread-kit/src/core-thread-kit/maildrop.pkg include unit_test; # unit_test is from src/lib/src/unit-test.pkg include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg nonfix val before;
start_up_thread_scheduler = tsc::start_up_thread_scheduler;
shut_down_thread_scheduler = tsc::shut_down_thread_scheduler;
name = "src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit-unit-test.pkg tests";
fun test_trivial_startup_shutdown_sequence ()
=
{ # Verify that basic threadkit startup/shutdown
# process is at least minimally functional:
#
exit_status
=
start_up_thread_scheduler .{
shut_down_thread_scheduler 13;
};
assert (exit_status == 13);
};
fun test_basic_mailslot_functionality ()
=
{ # Send fifty messages through a mailslot
# and verify that they are received:
messages_to_transmit = 50;
messages_received = REF 0;
thread_scheduler .{
#
Message = NONFINAL_MESSAGE | FINAL_MESSAGE;
slot = make_mailslot (): Mailslot(Message);
make_thread "threadkit_unit_test" .{
#
for (i = 1; i < messages_to_transmit; ++i) {
#
give (slot, NONFINAL_MESSAGE);
};
give (slot, FINAL_MESSAGE);
thread_done();
};
messages_received
:=
loop 0
where
fun loop i
=
case (take slot)
#
NONFINAL_MESSAGE => loop (i+1);
FINAL_MESSAGE => i+1;
esac;
end;
};
assert (messages_to_transmit == *messages_received);
};
fun test_basic_maildrop_functionality ()
=
thread_scheduler .{
#
put_to_full_maildrop_should_fail ();
put_to_empty_maildrop_should_work ();
get_from_empty_maildrop_should_block ();
exercise_nonblocking_maildrop_peeks ();
exercise_blocking_maildrop_peeks ();
exercise_maildrop_value_swaps ();
}
where
fun put_to_full_maildrop_should_fail ()
=
{ drop = make_full_maildrop (): Maildrop(Void);
#
worked = REF FALSE;
fill (drop, ())
except
MAY_NOT_FILL_ALREADY_FULL_MAILDROP
=
worked := TRUE;
assert *worked;
};
fun put_to_empty_maildrop_should_work ()
=
{ drop = make_empty_maildrop (): Maildrop(Int);
#
worked = REF TRUE;
fill (drop, 17)
except
MAY_NOT_FILL_ALREADY_FULL_MAILDROP
=
worked := FALSE;
assert *worked;
assert (empty drop == 17);
};
fun get_from_empty_maildrop_should_block ()
=
{ drop1 = make_empty_maildrop (): Maildrop(Int);
drop2 = make_empty_maildrop (): Maildrop(Int);
#
make_thread "threadkit_unit_test 2" .{
#
fill (drop2, empty drop1 + 1);
thread_done ();
};
fill (drop1, 23);
assert (empty drop2 == 24);
};
fun exercise_nonblocking_maildrop_peeks ()
=
{ drop = make_full_maildrop 29: Maildrop(Int);
#
assert (peek drop == 29); # Peek at maildrop without emptying it.
assert (the (nonblocking_peek drop) == 29);
assert (empty drop == 29); # Read and empty maildrop.
case (nonblocking_peek drop) # Peek to verify maildrop is now empty.
#
NULL => assert TRUE;
_ => assert FALSE;
esac;
};
fun exercise_blocking_maildrop_peeks ()
=
{ drop1 = make_empty_maildrop (): Maildrop(Int);
drop2 = make_empty_maildrop (): Maildrop(Int);
#
make_thread "threadkit_unit_test 3" .{
#
fill (drop2, peek drop1 + 1);
thread_done ();
};
fill (drop1, 37);
assert (peek drop2 == 38);
};
fun exercise_maildrop_value_swaps ()
=
{ drop = make_full_maildrop (57): Maildrop( Int );
#
assert (swap (drop, 59) == 57);
assert (empty drop == 59);
};
end;
fun test_basic_mailqueue_functionality ()
=
thread_scheduler .{
#
get_from_empty_mailqueue_should_block ();
queue_and_dequeue_50_values ();
}
where
fun get_from_empty_mailqueue_should_block ()
=
{ q1 = make_mailqueue (): Mailqueue(Int);
q2 = make_mailqueue (): Mailqueue(Int);
#
make_thread "threadkit_unit_test 4" .{
#
push (q2, pull q1 + 1);
thread_done ();
};
push (q1, 93);
assert (pull q2 == 94);
};
fun queue_and_dequeue_50_values ()
=
{ messages_to_transmit = 50;
#
Message = NONFINAL_MESSAGE | FINAL_MESSAGE;
q = make_mailqueue (): Mailqueue( Message );
for (i = 1; i < messages_to_transmit; ++i) {
#
push (q, NONFINAL_MESSAGE);
};
push (q, FINAL_MESSAGE);
messages_received
=
loop 0
where
fun loop i
=
case (pull q)
#
NONFINAL_MESSAGE => loop (i+1);
FINAL_MESSAGE => (i+1);
esac;
end;
assert (messages_received == messages_to_transmit);
};
end;
fun test_basic_mailcaster_functionality ()
=
thread_scheduler .{
#
get_from_empty_mailcaster_should_block ();
queue_and_dequeue_50_values ();
}
where
fun get_from_empty_mailcaster_should_block ()
=
{ c1 = make_mailcaster (): Mailcaster(Int);
c2 = make_mailcaster (): Mailcaster(Int);
q1 = make_readqueue c1: Readqueue(Int);
q2 = make_readqueue c2: Readqueue(Int);
make_thread "threadkit_unit_test 5" .{
#
transmit (c2, receive q1 + 1);
thread_done ();
};
transmit (c1, 93);
assert (receive q2 == 94);
};
fun queue_and_dequeue_50_values ()
=
{ messages_to_transmit = 50;
#
Message = NONFINAL_MESSAGE | FINAL_MESSAGE;
# Create a mailcaster and two readqueues on it:
c = make_mailcaster (): Mailcaster( Message );
q1 = make_readqueue c: Readqueue( Message );
q2 = make_readqueue c: Readqueue( Message );
# Write 50 messages into mailcaster:
#
for (i = 1; i < messages_to_transmit; ++i) {
#
transmit (c, NONFINAL_MESSAGE);
};
transmit (c, FINAL_MESSAGE);
# Read all 50 from first readqueue:
#
messages_received
=
loop 0
where
fun loop i
=
case (receive q1)
NONFINAL_MESSAGE => loop (i+1);
FINAL_MESSAGE => (i+1);
esac;
end;
assert (messages_received == messages_to_transmit);
# Read all 50 from second readqueue:
#
messages_received
=
loop 0
where
fun loop i
=
case (receive q2)
NONFINAL_MESSAGE => loop (i+1);
FINAL_MESSAGE => (i+1);
esac;
end;
assert (messages_received == messages_to_transmit);
};
end;
fun test_basic_thread_local_property_functionality ()
=
thread_scheduler .{
#
test_generic_thread_local_property_functionality ();
test_boolean_thread_local_property_functionality ();
}
where
fun test_generic_thread_local_property_functionality ()
=
{ prop = make_per_thread_property .{ 0; };
#
Message = ONE(Int) | TWO(Int);
slot = make_mailslot (): Mailslot( Message );
make_thread "threadkit_unit_test 6" .{
#
prop.set 1;
give (slot, ONE (prop.get ()));
};
make_thread "threadkit_unit_test 7" .{
#
prop.set 2;
give (slot, TWO (prop.get ()));
};
case (take slot)
#
ONE one => assert (one == 1);
TWO two => assert (two == 2);
esac;
case (take slot)
#
ONE one => assert (one == 1);
TWO two => assert (two == 2);
esac;
};
fun test_boolean_thread_local_property_functionality ()
=
{ prop = make_boolean_per_thread_property ();
#
Message = TRUE_MESSAGE(Bool) | FALSE_MESSAGE(Bool);
slot= make_mailslot (): Mailslot( Message );
make_thread "threadkit_unit_test 8" .{
#
prop.set TRUE;
give (slot, TRUE_MESSAGE (prop.get ()));
};
make_thread "threadkit_unit_test 9" .{
#
prop.set FALSE;
give (slot, FALSE_MESSAGE (prop.get ()));
};
case (take slot)
#
TRUE_MESSAGE true_val => assert ( true_val == TRUE );
FALSE_MESSAGE false_val => assert (false_val == FALSE);
esac;
case (take slot)
#
TRUE_MESSAGE true_val => assert ( true_val == TRUE );
FALSE_MESSAGE false_val => assert (false_val == FALSE);
esac;
};
end;
fun test_basic_timeout_functionality ()
=
thread_scheduler .{
#
test_sleep_for ();
test_sleep_until ();
}
where
now = tim::get_current_time_utc;
fun test_sleep_for ()
=
{ before = now ();
#
sleep_for (tim::from_milliseconds 100);
after = now ();
elapsed_time = tim::(-) (after, before);
milliseconds = tim::to_milliseconds elapsed_time;
assert (milliseconds >= 100);
};
fun test_sleep_until ()
=
{ before = now ();
wakeup_time = tim::(+) (before, tim::from_milliseconds 100);
sleep_until wakeup_time;
after = now ();
assert (tim::(>=) (after, wakeup_time));
};
end;
fun test_basic_select_functionality ()
=
thread_scheduler .{
#
test_select_over_input_mailslots ();
test_select_over_input_maildrops ();
test_select_over_input_mailqueues ();
test_select_over_output_mailslots ();
test_select_over_timeout_mailops ();
}
where
fun test_select_over_input_mailslots ()
=
{
input_slot_1 = make_mailslot (): Mailslot(Int);
input_slot_2 = make_mailslot (): Mailslot(Int);
output_drop_1 = make_empty_maildrop (): Maildrop(Int);
output_drop_2 = make_empty_maildrop (): Maildrop(Int);
make_thread "threadkit_unit_test 10" .{
#
for (;;) {
#
select [
take' input_slot_1 ==> .{ fill (output_drop_1, #value); },
take' input_slot_2 ==> .{ fill (output_drop_2, #value); }
];
};
};
give (input_slot_1, 13);
give (input_slot_2, 17);
assert (empty output_drop_1 == 13);
assert (empty output_drop_2 == 17);
};
fun test_select_over_input_maildrops ()
=
{ input_drop_1 = make_empty_maildrop (): Maildrop(Int);
input_drop_2 = make_empty_maildrop (): Maildrop(Int);
output_drop_1 = make_empty_maildrop (): Maildrop(Int);
output_drop_2 = make_empty_maildrop (): Maildrop(Int);
make_thread "threadkit_unit_test 11" .{
#
for (;;) {
#
select [
empty' input_drop_1 ==> .{ fill (output_drop_1, #value); },
empty' input_drop_2 ==> .{ fill (output_drop_2, #value); }
];
};
};
fill (input_drop_1, 11);
fill (input_drop_2, 19);
assert (empty output_drop_1 == 11);
assert (empty output_drop_2 == 19);
};
fun test_select_over_input_mailqueues ()
=
{ input_queue_1 = make_mailqueue (): Mailqueue(Int);
input_queue_2 = make_mailqueue (): Mailqueue(Int);
output_drop_1 = make_empty_maildrop (): Maildrop(Int);
output_drop_2 = make_empty_maildrop (): Maildrop(Int);
make_thread "threadkit_unit_test 12" .{
#
for (;;) {
#
select [
pull' input_queue_1 ==> .{ fill (output_drop_1, #value); },
pull' input_queue_2 ==> .{ fill (output_drop_2, #value); }
];
};
};
push (input_queue_1, 1);
push (input_queue_2, 3);
assert (empty output_drop_1 == 1);
assert (empty output_drop_2 == 3);
};
fun test_select_over_output_mailslots ()
=
{ output_slot_1 = make_mailslot (): Mailslot(Int);
output_slot_2 = make_mailslot (): Mailslot(Int);
make_thread "threadkit_unit_test 13" .{
#
for (;;) {
#
select [
give' (output_slot_1, 3) ==> .{ (); },
give' (output_slot_2, 5) ==> .{ (); }
];
};
};
assert (take output_slot_1 == 3);
assert (take output_slot_2 == 5);
};
fun test_select_over_timeout_mailops ()
=
{ ms = tim::from_milliseconds;
#
output_slot = make_mailslot (): Mailslot(Int);
make_thread "threadkit_unit_test 14" .{
#
select [
timeout_in' (ms 100) ==> .{ give (output_slot, 100); },
timeout_in' (ms 50) ==> .{ give (output_slot, 50); },
timeout_in' (ms 10) ==> .{ give (output_slot, 10); }
];
select [
timeout_in' (ms 100) ==> .{ give (output_slot, 100); },
timeout_in' (ms 50) ==> .{ give (output_slot, 50); }
];
select [
timeout_in' (ms 100) ==> .{ give (output_slot, 100); }
];
};
assert (take output_slot == 10);
assert (take output_slot == 50);
assert (take output_slot == 100);
};
end;
fun run ()
=
{ printf "\nDoing %s:\n" name;
#
test_trivial_startup_shutdown_sequence ();
test_basic_mailslot_functionality ();
test_basic_maildrop_functionality ();
test_basic_mailqueue_functionality ();
test_basic_mailcaster_functionality ();
test_basic_thread_local_property_functionality ();
test_basic_timeout_functionality ();
test_basic_select_functionality ();
summarize_unit_tests name;
};
};
end;
## Code by Jeff Prothero: Copyright (c) 2010-2012,
## released under Gnu Public Licence version 3.