memtest

gistfile1.pir

#!parrot

.loadlib 'io_ops'

.sub main :main
    .param pmc argv
    $S0  = shift argv
    .local int argc
    argc = elements argv
    if argc > 0 goto L1
    help()
    end
  L1:
    .local pmc opts
    opts = _parse_opts(argv)
    $I0 = exists opts['help']
    unless $I0 goto L2
    help()
    end
  L2:
    $P0 = _get_tests(opts, argv)
    run_tests($P0)
.end

.sub 'help' :anon
    say <<"HELP"
parrot t/harness.pir [options] [testfiles]
    --core-tests
    --runcore-tests
    --code-tests
    --archive  ... create a TAP archive of the test run
    --send-to-smolder ... send the TAP archive to the Parrot Smolder server
HELP
.end

.sub '_get_tests' :anon
    .param pmc opts
    .param pmc files
    .local int nb
    
    load_bytecode 'TAP/Harness.pbc'
    
    $I0 = opts['code-tests']
    unless $I0 goto L1
    .const string developing_tests = 't/codingstd/*.t'
    files = glob(developing_tests)
    goto L2
  L1:
    nb = elements files
    unless nb == 0 goto L2
    files = _get_common_tests(opts)
  L2:
    nb = elements files
    # currently, FixedStringArray hasn't the method sort.
    # see TT #1356
    $P0 = new 'FixedPMCArray'
    set $P0, nb
    $I0 = 0
    $P1 = iter files
  L3:
    unless $P1 goto L4
    $S0 = shift $P1
    $P2 = split "\\", $S0
    $S0 = join "/", $P2
    $P2 = box $S0
    $P0[$I0] = $P2
    inc $I0
    goto L3
  L4:
    $P0.'sort'()
    .return ($P0)
.end

.sub '_parse_opts' :anon
    .param pmc argv
    load_bytecode 'Getopt/Obj.pbc'
    $P0 = new ['Getopt';'Obj']
    $P0.'notOptStop'(1)
    push $P0, 'gc-debug'
    push $P0, 'core-tests'
    push $P0, 'runcore-tests'
    push $P0, 'code-tests'
    push $P0, 'run-exec'
    push $P0, 'archive'
    push $P0, 'send-to-smolder'
    push $P0, 'help|h'
    $P1 = $P0.'get_options'(argv)
    .return ($P1)
.end

.sub '_get_common_tests' :anon
    .param pmc opts
    .const string runcore_tests = <<'TEST'
t/compilers/imcc/*/*.t
t/op/*.t
t/pmc/*.t
t/oo/*.t
t/pir/*.t
t/native_pbc/*.t
TEST
    .const string core_tests = <<'TEST'
t/src/*.t
t/src/embed/*.t
t/run/*.t
t/perl/*.t
TEST
    .const string library_tests = <<'TEST'
t/compilers/pct/*.t
t/compilers/pge/*.t
t/compilers/pge/p5regex/*.t
t/compilers/pge/perl6regex/*.t
t/compilers/tge/*.t
t/compilers/opsc/*.t
t/compilers/data_json/*.t
t/dynoplibs/*.t
t/dynpmc/*.t
t/library/*.t
t/tools/*.t
t/profiling/*.t
TEST
    .const string configure_tests = <<'TEST'
t/configure/*.t
t/steps/*.t
t/postconfigure/*.t
TEST
    $S0 = runcore_tests
    $I0 = exists opts['runcore-tests']
    if $I0 goto L1
    $S0 .= core_tests
    $I0 = exists opts['core-tests']
    if $I0 goto L1
    $S0 .= library_tests
    $S0 .= configure_tests
  L1:
    $P0 = split "\n", $S0
    $S0 = join ' ', $P0
    $P0 = glob($S0)
    .return ($P0)
.end

.sub run_tests
    .param pmc tests
    $I0 = 0
    $I1 = elements tests
  loop:
    if $I0 == $I1 goto endloop

    $S0 = tests[$I0]     
    $S2 = $S0 . ".mem"
    
    $S1 = "valgrind -q --leak-check=full --log-file=" . $S2
    $S1 = $S1 . " ./parrot " 
    $S1 = $S1 . $S0
    
    say $S1
    
    $P1 = new 'FileHandle'
    $P1.'open'($S1, 'rp')    
    $S1 = $P1.'readall'()
    say $S1
    
    $P1 = new 'FileHandle'
    $P1.'open'($S2, 'r')
    $S1 = $P1.'readall'()
    say $S1
    
    inc $I0    
    goto loop
  endloop:
.end