timeit perl t\t\fastok.t > t.txt

Version Number:   Windows NT 5.1 (Build 2600)
Exit Time:        2:11 am, Saturday, April 4 2015
Elapsed Time:     0:02:00.671
Process Time:     0:01:59.234
System Calls:     3664127
Context Switches: 320686
Page Faults:      948528
Bytes Read:       3339101868
Bytes Written:    100048020
Bytes Other:      73765993

##</code><code>##

timeit perl t\t\fastprint.t > t.txt

Version Number:   Windows NT 5.1 (Build 2600)
Exit Time:        2:19 am, Saturday, April 4 2015
Elapsed Time:     0:00:02.156
Process Time:     0:00:02.109
System Calls:     21413
Context Switches: 6818
Page Faults:      14663
Bytes Read:       270297
Bytes Written:    60606608
Bytes Other:      6971963

##</code><code>##

unshift(@INC, '.');
require 't/t/GenTAP.pm';
require Test::More; #load but dont call anything in Test::More
#we want runtime mem overlead, not loadtime, otherwise the require will happen
#inside GenTAP if it isn't done here
system('pause');#sample memory
GenTAP(0, 0, 'ok', 1000000);
system('pause');#sample memory

##</code><code>##

timeit perl t\t\fasttinyok.t > t.txt

Version Number:   Windows NT 5.1 (Build 2600)
Exit Time:        7:42 pm, Tuesday, April 7 2015
Elapsed Time:     0:00:05.218
Process Time:     0:00:05.140
System Calls:     49612
Context Switches: 24005
Page Faults:      17396
Bytes Read:       146216
Bytes Written:    57859498
Bytes Other:      17639334

##</code><code>##

timeit perl t\t\fastok.t > t.txt

Version Number:   Windows NT 5.1 (Build 2600)
Exit Time:        11:37 pm, Tuesday, April 14 2015
Elapsed Time:     0:02:10.859
Process Time:     0:02:09.375
System Calls:     2399091
Context Switches: 238722
Page Faults:      543275
Bytes Read:       3031284
Bytes Written:    103643867
Bytes Other:      87114348

##</code><code>##

C:\sources\Win32-APipe>timeit C:\perl521\bin\perl.exe "-MExtUtils::Command::MM"
"-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib\li
b', 'blib\arch')" t\t\fastprint.t
t\t\fastprint.t .. ok
All tests successful.
Files=1, Tests=1000000, 66 wallclock secs (65.86 usr +  0.13 sys = 65.98 CPU)
Result: PASS

Version Number:   Windows NT 5.1 (Build 2600)
Exit Time:        3:00 am, Saturday, April 4 2015
Elapsed Time:     0:01:06.406
Process Time:     0:01:06.203
System Calls:     483839
Context Switches: 182749
Page Faults:      78950
Bytes Read:       62566241
Bytes Written:    53961404
Bytes Other:      11595189

C:\sources\Win32-APipe>

##</code><code>##

C:\sources\Win32-APipe>C:\perl521\bin\perl.exe "-MExtUtils::Command::MM" "-MTest
::Harness" "-e" "undef *Test::Harness::Switches; system 'pause'; test_harness(0,
 'blib\lib', 'blib\arch'); system 'pause';" t\t\fastprint.t
Press any key to continue . . .
t\t\fastprint.t .. ok
All tests successful.
Files=1, Tests=1000000, 65 wallclock secs (65.05 usr +  0.11 sys = 65.16 CPU)
Result: PASS
Press any key to continue . . .

C:\sources\Win32-APipe>

##</code><code>##

All tests successful.
Files=1, Tests=1000000, 65 wallclock secs (65.05 usr +  0.11 sys = 65.16 CPU)
Result: PASS

##</code><code>##

sub in_todo {
    my($todo, $caller);
    $todo = defined((caller++$caller)[0])?(caller$caller)[0]->can('is_todo')?(caller$caller)[0]->is_todo?1:undef:undef:0 until defined $todo;
    $todo;
}

##</code><code>##

use strict;
use warnings;
use constant UVMAX => 2**32; #%Config doesn't have this, this will do
use Time::HiRes qw( sleep );

#void GenTap($time_per_sleep, $sleep_count, $emitter, $test_count)
# time_per_sleep -
#  seconds to sleep when a sleep is triggered, floating point okay and will sleep
#  fractions of a second (uses Time::HiRes)
# sleep_count -
#  integer count of number of times to sleep, the sleeps will be evenly
#  distributed between tests
# emitter -
#   ok - use ok()
#   print - use perl core print()
#   block - use perl core print with atleast 4KB of multiline output per print
# test_count -
#   number of tests to run, will be interleaved with sleeps if applicable
sub GenTAP {
    die "usage: GenTAP" if @_ != 4;
    my ($time_per_sleep, $sleep_count, $emitter, $test_count) = @_;
    die "invalid test count" if $test_count >= UVMAX;
    my($testnum, $tests_before_sleep, $tests_left_before_sleep, $buffer, $ok) = (1, UVMAX, UVMAX);

#emmit a plan
    if($emitter eq 'ok') {
        require Test::More;
        Test::More::plan(tests => $test_count);
        $ok = \&Test::More::ok;
    } elsif($emitter eq 'tinyok') {
        require Test::Tiny;
        Test::Tiny->import(tests => $test_count);
        $ok = \&Test::Tiny::ok;
        $emitter = 'ok'; # less branchin in main loop
    } else {
        my $plan = "1..$test_count\n";
        if($emitter eq 'print') {
            print $plan;
        } elsif ($emitter eq 'block') {
            $buffer = $plan;
        } else {
            die "unknown emitter";        
        }
    }
    
    $tests_left_before_sleep = $tests_before_sleep = $test_count / $sleep_count if $sleep_count;
    
    while ($testnum <= $test_count) {
# UC 1 random character in each test name for a touch of crazy
# and test output that isn't identical each time, UCing a space produce no change
# which is intentional, since sometimes the line should not be "typo-ed"
        my $testname =  "All work and no play makes Jack a dull boy";
        my $replace = int(rand(length("All work and no play makes Jack a dull boy")));
        substr($testname, $replace, 1, uc(substr($testname, $replace, 1)));
        if ($emitter eq 'ok') {
            &$ok(1, $testname);
        } else {
            my $testline = 'ok '.$testnum.' '.$testname."\n";
            if ($emitter eq 'print') {
                print $testline;
            #} elsif ($emitter eq 'block') {
            } else { #checked above
                $buffer .= $testline;
                if(length($buffer) > 4096) {
                    print $buffer;
                    $buffer = '';
                }
            }
        }
        sleep($time_per_sleep), ($tests_left_before_sleep = $tests_before_sleep) if --$tests_left_before_sleep == 0;
        $testnum++;
    }
    
    #flush the buffer in block mode
    print $buffer if $emitter eq 'block' && length($buffer);
}
1;

##</code><code>##

unshift(@INC, '.');
require 't/t/GenTAP.pm';
GenTAP(0, 0, 'print', 1000000);

##</code><code>##

unshift(@INC, '.');
require 't/t/GenTAP.pm';
GenTAP(0, 0, 'ok', 1000000);

##</code><code>##

unshift(@INC, '.');
require 't/t/GenTAP.pm';
GenTAP(0, 0, 'tinyok', 1000000);