# threadkit-unit-test.pkg
#
# Unit tests for:
# src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg# Compiled by:
# src/lib/test/unit-tests.lib# Run by:
# src/lib/test/all-unit-tests.pkgstipulate
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package mps = microthread_preemptive_scheduler; # microthread_preemptive_scheduler is from src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg package tim = time; # time is from src/lib/std/time.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 nonfix my before;
my _ = log::note .{ "threadkit_unit_test/AAA"; };
# start_up_thread_scheduler = tsc::start_up_thread_scheduler;
# my _ = printf "threadkit_unit_test/BBB\n";
# shut_down_thread_scheduler = tsc::shut_down_thread_scheduler;
# my _ = printf "threadkit_unit_test/CCC\n";
name = "src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit-unit-test.pkg tests";
fun test_basic_mailslot_functionality_a ()
=
{ # Send one message through a mailslot
# and verify that it is received:
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_a/TOP" (mps::thread_scheduler_statestring ()); };
slot = make_mailslot (): Mailslot(Int);
make_thread "threadkit_unit_test" .{
#
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_a/thread/AAA (above put_in_mailslot) " (mps::thread_scheduler_statestring ()); };
put_in_mailslot (slot, 13);
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_a/thread/BBB (below put_in_mailslot): " (mps::thread_scheduler_statestring ()); };
thread_exit { success => TRUE };
};
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_a/AAA (above take) " (mps::thread_scheduler_statestring ()); };
k = take_from_mailslot slot;
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_a/BBB (below take_from_mailslot) k d=%d" (mps::thread_scheduler_statestring ()) k; };
assert (k == 13);
};
fun test_basic_mailslot_functionality_b ()
=
{ # Send fifty messages through a mailslot
# and verify that they are received:
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_b/TOP" (mps::thread_scheduler_statestring ()); };
messages_to_transmit = 50;
#
Message = NONFINAL_MESSAGE Int
| FINAL_MESSAGE Int
;
slot = make_mailslot (): Mailslot(Message);
make_thread "threadkit_unit_test" .{
#
for (i = 1; i < messages_to_transmit; ++i) {
#
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_b/GIVELUP(%d)TOP" (mps::thread_scheduler_statestring ()) i; };
put_in_mailslot (slot, NONFINAL_MESSAGE i);
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_b/GIVELUP(%d)post-give" (mps::thread_scheduler_statestring ()) i; };
};
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_b/GIVELUP/DONE: doing put_in_mailslot(slot,FINAL_MESSAGE)" (mps::thread_scheduler_statestring ()); };
put_in_mailslot (slot, FINAL_MESSAGE messages_to_transmit);
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_b/GIVELUP/DONE: doing thread_exit" (mps::thread_scheduler_statestring ()); };
thread_exit { success => TRUE };
};
messages_received
=
loop 0
where
fun loop i
=
{
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_b/TAKELUP(%d)TOP" (mps::thread_scheduler_statestring ()) i; };
k = take_from_mailslot slot;
case k NONFINAL_MESSAGE n => log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_b/TAKELUP(%d) post-take NONFINAL_MESSAGE %d" (mps::thread_scheduler_statestring ()) i n; };
FINAL_MESSAGE n => log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_b/TAKELUP(%d) post-take FINAL_MESSAGE %d" (mps::thread_scheduler_statestring ()) i n; };
esac;
case k
# case (take_from_mailslot slot)
#
NONFINAL_MESSAGE n => loop (i+1);
FINAL_MESSAGE n => i+1;
esac;
};
end;
log::note .{ sprintf "test_basic_mailslot_functionality_b/TAKELUP/DONE: mode d=%d doing assert (messages_to_transmit d=%d messages_received d=%d" (mps::get_uninterruptible_scope_nesting_depth ()) messages_to_transmit messages_received; };
assert (messages_to_transmit == messages_received);
log::note .{ "========================================================================"; };
};
# Next step is to mutate this into a test of put_in_mailslot' and take_from_mailslot'
# instead of put_in_mailslot() and take_from_mailslot():
# (I think we should also increase the loopcount above
# once we strip out the printfs())
fun test_basic_mailslot_functionality_c ()
=
{ # Send fifty messages through a mailslot
# and verify that they are received:
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/TOP" (mps::thread_scheduler_statestring ()); };
messages_to_transmit = 50;
#
Message = NONFINAL_MESSAGE Int
| FINAL_MESSAGE Int
;
slot = make_mailslot (): Mailslot(Message);
make_thread "threadkit_unit_test" .{
#
for (i = 1; i < messages_to_transmit; ++i) {
#
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/GIVELUP(%d)TOP" (mps::thread_scheduler_statestring ()) i; };
block_until_mailop_fires (put_in_mailslot' (slot, NONFINAL_MESSAGE i));
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/GIVELUP(%d)post-put_in_mailslot" (mps::thread_scheduler_statestring ()) i; };
};
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/GIVELUP/DONE doing put_in_mailslot(slot,FINAL_MESSAGE)" (mps::thread_scheduler_statestring ()); };
block_until_mailop_fires (put_in_mailslot' (slot, FINAL_MESSAGE messages_to_transmit));
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/GIVELUP/DONE: doing thread_exit" (mps::thread_scheduler_statestring ()); };
thread_exit { success => TRUE };
};
messages_received
=
loop 0
where
fun loop i
=
{
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/TAKELUP(%d)TOP:" (mps::thread_scheduler_statestring ()) i; };
k = block_until_mailop_fires (take_from_mailslot' slot);
case k NONFINAL_MESSAGE n => log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/TAKELUP(%d) post-take: NONFINAL_MESSAGE %d" (mps::thread_scheduler_statestring ()) i n; };
FINAL_MESSAGE n => log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/TAKELUP(%d) post-take: FINAL_MESSAGE %d" (mps::thread_scheduler_statestring ()) i n; };
esac;
case k
# case (block_until_mailop_fires (take_from_mailslot' slot))
#
NONFINAL_MESSAGE n => loop (i+1);
FINAL_MESSAGE n => i+1;
esac;
};
end;
log::note .{ sprintf "%s\ttest_basic_mailslot_functionality_c/TAKELUP/DONE: doing assert (messages_to_transmit d=%d messages_received d=%d" (mps::thread_scheduler_statestring ()) messages_to_transmit messages_received; };
assert (messages_to_transmit == messages_received);
log::note .{ "========================================================================"; };
};
fun test_basic_maildrop_functionality ()
=
{
log::note .{ sprintf "%s\ttest_basic_maildrop_functionality/TOP" (mps::thread_scheduler_statestring ()); };
#
put_to_full_maildrop_should_fail ();
log::note .{ sprintf "%s\ttest_basic_maildrop_functionality/BBB" (mps::thread_scheduler_statestring ()); };
put_to_empty_maildrop_should_work ();
log::note .{ sprintf "%s\ttest_basic_maildrop_functionality/CCC" (mps::thread_scheduler_statestring ()); };
get_from_empty_maildrop_should_block ();
log::note .{ sprintf "%s\ttest_basic_maildrop_functionality/DDD" (mps::thread_scheduler_statestring ()); };
exercise_nonblocking_maildrop_peeks ();
log::note .{ sprintf "%s\ttest_basic_maildrop_functionality/EEE" (mps::thread_scheduler_statestring ()); };
exercise_blocking_maildrop_peeks ();
log::note .{ sprintf "%s\ttest_basic_maildrop_functionality/FFF" (mps::thread_scheduler_statestring ()); };
exercise_maildrop_value_swaps ();
log::note .{ sprintf "%s\ttest_basic_maildrop_functionality/ZZZ" (mps::thread_scheduler_statestring ()); };
}
where
fun put_to_full_maildrop_should_fail ()
=
{ drop = make_maildrop (): Maildrop(Void);
#
worked = REF FALSE;
log::note_in_ramlog .{ sprintf "put_to_full_maildrop_should_fail calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (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;
log::note_in_ramlog .{ sprintf "put_to_empty_maildrop_should_work calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (drop, 17)
except
MAY_NOT_FILL_ALREADY_FULL_MAILDROP
=
worked := FALSE;
assert *worked;
log::note_in_ramlog .{ sprintf "put_to_empty_maildrop_should_work calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop 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" .{
#
log::note_in_ramlog .{ sprintf "get_from_empty_maildrop_should_block calling empty then fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (drop2, take_from_maildrop drop1 + 1);
thread_exit { success => TRUE };
};
log::note_in_ramlog .{ sprintf "get_from_empty_maildrop_should_block II calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (drop1, 23);
log::note_in_ramlog .{ sprintf "get_from_empty_maildrop_should_block/BBB calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop drop2 == 24);
};
fun exercise_nonblocking_maildrop_peeks ()
=
{ drop = make_maildrop 29: Maildrop(Int);
#
assert (peek_in_maildrop drop == 29); # Peek at maildrop without emptying it.
assert (the (nonblocking_peek_in_maildrop drop) == 29);
log::note_in_ramlog .{ sprintf "exercise_nonblocking_maildrop_peeks calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop drop == 29); # Read and empty maildrop.
case (nonblocking_peek_in_maildrop drop) # Peek to verify maildrop is now empty.
#
NULL => assert TRUE;
_ => assert FALSE;
esac;
};
fun exercise_blocking_maildrop_peeks ()
=
{
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/AAA" (mps::thread_scheduler_statestring ()); };
drop1 = make_empty_maildrop (): Maildrop(Int);
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/BBB" (mps::thread_scheduler_statestring ()); };
drop2 = make_empty_maildrop (): Maildrop(Int);
#
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/CCC" (mps::thread_scheduler_statestring ()); };
make_thread "threadkit_unit_test 3" .{
#
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/DDD" (mps::thread_scheduler_statestring ()); };
v0 = peek_in_maildrop drop1;
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/EEE" (mps::thread_scheduler_statestring ()); };
v1 = v0 + 1;
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/FFF" (mps::thread_scheduler_statestring ()); };
log::note_in_ramlog .{ sprintf "exercise_blocking_maildrop_peeks calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (drop2, v1);
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/EEE" (mps::thread_scheduler_statestring ()); };
thread_exit { success => TRUE };
};
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/FFF" (mps::thread_scheduler_statestring ()); };
log::note_in_ramlog .{ sprintf "exercise_blocking_maildrop_peeks II calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (drop1, 37);
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/GGG" (mps::thread_scheduler_statestring ()); };
assert (peek_in_maildrop drop2 == 38);
log::note .{ sprintf "%s\texercise_blocking_maildrop_peeks/ZZZ" (mps::thread_scheduler_statestring ()); };
};
fun exercise_maildrop_value_swaps ()
=
{ drop = make_maildrop (57): Maildrop( Int );
#
assert (maildrop_swap (drop, 59) == 57);
log::note_in_ramlog .{ sprintf "exercise_maildrop_value_swaps calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop drop == 59);
};
end;
fun test_basic_mailqueue_functionality ()
=
{
#
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" .{
#
put_in_mailqueue (q2, take_from_mailqueue q1 + 1);
thread_exit { success => TRUE };
};
put_in_mailqueue (q1, 93);
assert (take_from_mailqueue 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) {
#
put_in_mailqueue (q, NONFINAL_MESSAGE);
};
put_in_mailqueue (q, FINAL_MESSAGE);
messages_received
=
loop 0
where
fun loop i
=
case (take_from_mailqueue q)
#
NONFINAL_MESSAGE => loop (i+1);
FINAL_MESSAGE => (i+1);
esac;
end;
assert (messages_received == messages_to_transmit);
};
end;
fun test_basic_mailcaster_functionality ()
=
{
#
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_exit { success => TRUE };
};
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 ()
=
{
#
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;
put_in_mailslot (slot, ONE (prop.get ()));
};
make_thread "threadkit_unit_test 7" .{
#
prop.set 2;
put_in_mailslot (slot, TWO (prop.get ()));
};
case (take_from_mailslot slot)
#
ONE one => assert (one == 1);
TWO two => assert (two == 2);
esac;
case (take_from_mailslot 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;
put_in_mailslot (slot, TRUE_MESSAGE (prop.get ()));
};
make_thread "threadkit_unit_test 9" .{
#
prop.set FALSE;
put_in_mailslot (slot, FALSE_MESSAGE (prop.get ()));
};
case (take_from_mailslot slot)
#
TRUE_MESSAGE true_val => assert ( true_val == TRUE );
FALSE_MESSAGE false_val => assert (false_val == FALSE);
esac;
case (take_from_mailslot slot)
#
TRUE_MESSAGE true_val => assert ( true_val == TRUE );
FALSE_MESSAGE false_val => assert (false_val == FALSE);
esac;
};
end;
fun test_basic_timeout_functionality ()
=
{
#
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/AAA" (mps::thread_scheduler_statestring ()); };
test_sleep_for ();
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/BBB" (mps::thread_scheduler_statestring ()); };
test_sleep_until ();
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/ZZZ" (mps::thread_scheduler_statestring ()); };
}
where
now = tim::get_current_time_utc;
fun test_sleep_for ()
=
{
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/test_sleep_for/AAA" (mps::thread_scheduler_statestring ()); };
before = now ();
#
sleep_for 0.1;
after = now ();
elapsed_time = tim::(-) (after, before);
milliseconds = tim::to_milliseconds elapsed_time;
assert (milliseconds >= 100);
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/test_sleep_for/ZZZ" (mps::thread_scheduler_statestring ()); };
};
fun test_sleep_until ()
=
{
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/test_sleep_until/AAA" (mps::thread_scheduler_statestring ()); };
before = now ();
wakeup_time = tim::(+) (before, tim::from_milliseconds 100);
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/test_sleep_until/BBB" (mps::thread_scheduler_statestring ()); };
sleep_until wakeup_time;
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/test_sleep_until/CCC" (mps::thread_scheduler_statestring ()); };
after = now ();
assert (tim::(>=) (after, wakeup_time));
log::note .{ sprintf "%s\ttest_basic_timeout_functionality/test_sleep_until/ZZZ" (mps::thread_scheduler_statestring ()); };
};
end;
fun test_basic_select_functionality ()
=
{
log::note .{ sprintf "%s\ttest_basic_select_functionality/AAA" (mps::thread_scheduler_statestring ()); };
#
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 ();
log::note .{ sprintf "%s\ttest_basic_select_functionality/ZZZ" (mps::thread_scheduler_statestring ()); };
}
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 (;;) {
#
do_one_mailop [
take_from_mailslot' input_slot_1 ==> .{
log::note_in_ramlog .{ sprintf "test_select_over_input_mailslots calling put_in_maildrop *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (output_drop_1, #value); },
take_from_mailslot' input_slot_2 ==> .{
log::note_in_ramlog .{ sprintf "test_select_over_input_mailslots II calling put_in_maildrop *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (output_drop_2, #value); }
];
};
};
put_in_mailslot (input_slot_1, 13);
put_in_mailslot (input_slot_2, 17);
log::note_in_ramlog .{ sprintf "test_select_over_input_mailslots calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop output_drop_1 == 13);
log::note_in_ramlog .{ sprintf "test_select_over_input_mailslots/BBB calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop 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 (;;) {
#
do_one_mailop [
take_from_maildrop' input_drop_1 ==> .{
log::note_in_ramlog .{ sprintf "test_select_over_input_maildrops calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (output_drop_1, #value); },
take_from_maildrop' input_drop_2 ==> .{
log::note_in_ramlog .{ sprintf "test_select_over_input_maildrops II calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (output_drop_2, #value); }
];
};
};
log::note_in_ramlog .{ sprintf "test_select_over_input_maildrops III calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (input_drop_1, 11);
log::note_in_ramlog .{ sprintf "test_select_over_input_maildrops IV calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (input_drop_2, 19);
log::note_in_ramlog .{ sprintf "test_select_over_input_maildrops calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop output_drop_1 == 11);
log::note_in_ramlog .{ sprintf "test_select_over_input_maildrops/BBB calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop 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 (;;) {
#
do_one_mailop [
take_from_mailqueue' input_queue_1 ==> .{
log::note_in_ramlog .{ sprintf "test_select_over_input_mailqueues calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (output_drop_1, #value); },
take_from_mailqueue' input_queue_2 ==> .{
log::note_in_ramlog .{ sprintf "test_select_over_input_mailqueues II calling fill *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
put_in_maildrop (output_drop_2, #value); }
];
};
};
put_in_mailqueue (input_queue_1, 1);
put_in_mailqueue (input_queue_2, 3);
log::note_in_ramlog .{ sprintf "test_select_over_input_mailqueues calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop output_drop_1 == 1);
log::note_in_ramlog .{ sprintf "test_select_over_input_mailqueues/BBB calling empty *uninterruptible_scope_mutex d=%d" *microthread_preemptive_scheduler::uninterruptible_scope_mutex; };
assert (take_from_maildrop 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 (;;) {
#
do_one_mailop [
put_in_mailslot' (output_slot_1, 3) ==> .{ (); },
put_in_mailslot' (output_slot_2, 5) ==> .{ (); }
];
};
};
assert (take_from_mailslot output_slot_1 == 3);
assert (take_from_mailslot output_slot_2 == 5);
};
fun test_select_over_timeout_mailops ()
=
{ output_slot = make_mailslot (): Mailslot(Int);
make_thread "threadkit_unit_test 14" .{
#
do_one_mailop [
timeout_in' 0.100 ==> .{ put_in_mailslot (output_slot, 100); },
timeout_in' 0.050 ==> .{ put_in_mailslot (output_slot, 50); },
timeout_in' 0.010 ==> .{ put_in_mailslot (output_slot, 10); }
];
do_one_mailop [
timeout_in' 0.100 ==> .{ put_in_mailslot (output_slot, 100); },
timeout_in' 0.050 ==> .{ put_in_mailslot (output_slot, 50); }
];
do_one_mailop [
timeout_in' 0.100 ==> .{ put_in_mailslot (output_slot, 100); }
];
};
assert (take_from_mailslot output_slot == 10);
assert (take_from_mailslot output_slot == 50);
assert (take_from_mailslot output_slot == 100);
};
end;
fun test_basic_succeed_vs_fail_functionality ()
=
{
test_exit_state_of_thread_that_succeeded ();
test_exit_state_of_thread_that_failed ();
test_exit_state_of_thread_killed_by_exception ();
test_exit_state_of_task_that_succeeded ();
test_exit_state_of_task_that_failed ();
test_exit_state_of_task_killed_by_exception ();
test_exit_state_of_2_thread_task_that_succeeded ();
test_exit_state_of_2_thread_task_that_failed_a ();
test_exit_state_of_2_thread_task_that_failed_b ();
test_exit_state_of_2_thread_task_that_failed_c ();
test_exit_state_of_2_thread_task_killed_by_exception_a ();
test_exit_state_of_2_thread_task_killed_by_exception_b ();
test_exit_state_of_thread_killed_as_successful ();
test_exit_state_of_thread_killed_as_failure ();
}
where
fun test_exit_state_of_thread_that_succeeded ()
=
{
test_thread = make_thread "successful thread" .{ thread_exit { success => TRUE }; };
thread_finished' = thread_done__mailop test_thread;
block_until_mailop_fires thread_finished';
assert (get_thread's_state test_thread == state::SUCCESS);
};
fun test_exit_state_of_thread_that_failed ()
=
{
test_thread = make_thread "unsuccessful thread" .{ thread_exit { success => FALSE }; };
thread_finished' = thread_done__mailop test_thread;
block_until_mailop_fires thread_finished';
assert (get_thread's_state test_thread == state::FAILURE);
};
fun test_exit_state_of_thread_killed_by_exception ()
=
{
printf "\nThe following FAIL exception is a test -- IGNORE IT: ";
test_thread = make_thread "exceptional thread" .{ raise exception FAIL "testing..."; };
thread_finished' = thread_done__mailop test_thread;
block_until_mailop_fires thread_finished';
assert (get_thread's_state test_thread == state::FAILURE_DUE_TO_UNCAUGHT_EXCEPTION);
};
fun test_exit_state_of_task_that_succeeded ()
=
{
test_task = make_task "successful task" [ ("successful thread", .{ thread_exit { success => TRUE }; } ) ];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::SUCCESS);
};
fun test_exit_state_of_task_that_failed ()
=
{
test_task = make_task "unsuccessful task" [ ("unsuccessful thread", .{ thread_exit { success => FALSE }; } ) ];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::FAILURE);
};
fun test_exit_state_of_task_killed_by_exception ()
=
{
printf "\nThe following FAIL exception is a test -- IGNORE IT: ";
test_task = make_task "exceptional task" [ ("exceptional thread", .{ raise exception FAIL "testing..."; } ) ];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::FAILURE_DUE_TO_UNCAUGHT_EXCEPTION);
};
fun test_exit_state_of_2_thread_task_that_succeeded ()
=
{
test_task = make_task "successful task" [ ("successful thread", .{ thread_exit { success => TRUE }; } ),
("successful thread", .{ thread_exit { success => TRUE }; } )
];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::SUCCESS);
};
fun test_exit_state_of_2_thread_task_that_failed_a ()
=
{
test_task = make_task "unsuccessful task" [ ("unsuccessful thread", .{ thread_exit { success => FALSE }; } ),
("unsuccessful thread", .{ thread_exit { success => FALSE }; } )
];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::FAILURE);
};
fun test_exit_state_of_2_thread_task_that_failed_b ()
=
{
test_task = make_task "unsuccessful task" [ ("unsuccessful thread", .{ thread_exit { success => FALSE }; } ),
("unsuccessful thread", .{ thread_exit { success => TRUE }; } )
];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::FAILURE);
};
fun test_exit_state_of_2_thread_task_that_failed_c ()
=
{
test_task = make_task "unsuccessful task" [ ("unsuccessful thread", .{ thread_exit { success => TRUE }; } ),
("unsuccessful thread", .{ thread_exit { success => FALSE }; } )
];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::FAILURE);
};
fun test_exit_state_of_2_thread_task_killed_by_exception_a ()
=
{
printf "\nThe following FAIL exception is a test -- IGNORE IT: ";
test_task = make_task "exceptional task" [ ("exceptional thread", .{ raise exception FAIL "testing..."; } ),
("successful thread", .{ thread_exit { success => TRUE }; } )
];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::FAILURE_DUE_TO_UNCAUGHT_EXCEPTION);
};
fun test_exit_state_of_2_thread_task_killed_by_exception_b ()
=
{
printf "\nThe following FAIL exception is a test -- IGNORE IT: ";
test_task = make_task "exceptional task" [ ("successful thread", .{ thread_exit { success => TRUE }; } ),
("exceptional thread", .{ raise exception FAIL "testing..."; } )
];
task_finished' = task_done__mailop test_task;
block_until_mailop_fires task_finished';
assert (get_task's_state test_task == state::FAILURE_DUE_TO_UNCAUGHT_EXCEPTION);
};
fun test_exit_state_of_thread_killed_as_successful ()
=
{
log::note .{ sprintf "%s\tsucc/TOP" (mps::thread_scheduler_statestring ()); };
log::note .{ "succ/AAA"; };
test_thread = make_thread "infinite-loop thread" .{ fun loop () = loop (); loop (); };
log::note .{ "succ/BBB"; };
thread_finished' = thread_done__mailop test_thread;
log::note .{ "succ/CCC"; };
yield ();
log::note .{ "succ/DDD"; };
yield ();
log::note .{ "succ/EEE"; };
yield ();
log::note .{ "succ/FFF"; };
assert (get_thread's_state test_thread == state::ALIVE);
log::note .{ "succ/GGG"; };
kill_thread { thread => test_thread, success => TRUE };
log::note .{ "succ/HHH"; };
block_until_mailop_fires thread_finished';
log::note .{ "succ/III"; };
assert (get_thread's_state test_thread == state::SUCCESS);
log::note .{ "succ/ZZZ"; };
};
fun test_exit_state_of_thread_killed_as_failure ()
=
{
log::note .{ "fail/AAA"; };
test_thread = make_thread "infinite-loop thread" .{ loop () where fun loop () = loop (); end; };
log::note .{ "fail/BBB"; };
thread_finished' = thread_done__mailop test_thread;
log::note .{ "fail/CCC"; };
yield ();
log::note .{ "fail/DDD"; };
yield ();
log::note .{ "fail/EEE"; };
yield ();
log::note .{ "fail/FFF"; };
assert (get_thread's_state test_thread == state::ALIVE);
log::note .{ "fail/GGG"; };
kill_thread { thread => test_thread, success => FALSE };
log::note .{ "fail/HHH"; };
block_until_mailop_fires thread_finished';
log::note .{ "fail/III"; };
assert (get_thread's_state test_thread == state::FAILURE);
log::note .{ "fail/ZZZ"; };
};
end;
fun run ()
=
{ my _ = printf "\nDoing %s:\n" name;
#
log::note .{ sprintf "%s\tthreadkit-unit-test/001: calling test_basic_mailslot_functionality_c" (mps::thread_scheduler_statestring ()); };
test_basic_mailslot_functionality_c ();
log::note .{ sprintf "%s\tthreadkit-unit-test/TOP: calling test_basic_mailslot_functionality_a" (mps::thread_scheduler_statestring ()); };
test_basic_mailslot_functionality_a ();
log::note .{ sprintf "%s\tthreadkit-unit-test/000: calling test_basic_mailslot_functionality_b" (mps::thread_scheduler_statestring ()); };
test_basic_mailslot_functionality_b ();
log::note .{ sprintf "%s\tthreadkit-unit-test/AAA: calling test_basic_maildrop_functionality" (mps::thread_scheduler_statestring ()); };
test_basic_maildrop_functionality ();
log::note .{ sprintf "%s\tthreadkit-unit-test/BBB calling test_basic_mailqueue_functionality" (mps::thread_scheduler_statestring ()); };
test_basic_mailqueue_functionality ();
log::note .{ sprintf "%s\tthreadkit-unit-test/CCC calling test_basic_mailcaster_functionality" (mps::thread_scheduler_statestring ()); };
test_basic_mailcaster_functionality ();
log::note .{ sprintf "%s\tthreadkit-unit-test/DDD calling test_basic_thread_local_property_functionality" (mps::thread_scheduler_statestring ()); };
test_basic_thread_local_property_functionality ();
log::note .{ sprintf "%s\tthreadkit-unit-test/EEE calling test_basic_timeout_functionality" (mps::thread_scheduler_statestring ()); };
test_basic_timeout_functionality ();
log::note .{ sprintf "%s\tthreadkit-unit-test/FFF calling test_basic_select_functionality" (mps::thread_scheduler_statestring ()); };
test_basic_select_functionality ();
log::note .{ sprintf "%s\tthreadkit-unit-test/GGG calling test_basic_succeed_vs_fail_functionality" (mps::thread_scheduler_statestring ()); };
test_basic_succeed_vs_fail_functionality ();
log::note .{ sprintf "%s\tthreadkit-unit-test/ZZZ" (mps::thread_scheduler_statestring ()); };
summarize_unit_tests name;
};
};
end;
## Code by Jeff Prothero: Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.