PreviousUpNext

15.4.913  src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit-unit-test.pkg

# 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.pkg

stipulate
    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.pkg
herein

    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.



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext