[svn:parrot] r45848 - in trunk: . t
fperrad at svn.parrot.org
fperrad at svn.parrot.org
Wed Apr 21 09:36:34 UTC 2010
Author: fperrad
Date: Wed Apr 21 09:36:33 2010
New Revision: 45848
URL: https://trac.parrot.org/parrot/changeset/45848
Log:
add t/harness.pir
Added:
trunk/t/harness.pir (contents, props changed)
Modified:
trunk/MANIFEST
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Wed Apr 21 09:02:28 2010 (r45847)
+++ trunk/MANIFEST Wed Apr 21 09:36:33 2010 (r45848)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Apr 20 20:11:26 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Wed Apr 21 09:32:21 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1712,6 +1712,7 @@
t/examples/subs.t [test]
t/examples/tutorial.t [test]
t/harness [test]
+t/harness.pir [test]
t/include/fp_equality.t [test]
t/library/cgi_query_hash.t [test]
t/library/configure.t [test]
Added: trunk/t/harness.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/t/harness.pir Wed Apr 21 09:36:33 2010 (r45848)
@@ -0,0 +1,390 @@
+#!parrot
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+.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:
+ .tailcall do(opts, argv)
+.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 '_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 'do' :anon
+ .param pmc opts
+ .param pmc files
+ set_test_prog_args(opts)
+ load_bytecode 'TAP/Harness.pbc'
+ .local pmc options, env, harness, aggregate
+ options = new 'Hash'
+ env = new 'Env'
+ $I0 = exists env['HARNESS_VERBOSE']
+ unless $I0 goto L1
+ $S0 = env['HARNESS_VERBOSE']
+ options['verbosity'] = $S0
+ L1:
+ $I0 = exists opts['archive']
+ if $I0 goto L2
+ harness = new ['TAP';'Harness']
+ options['directives'] = 1
+ goto L3
+ L2:
+ harness = new ['TAP';'Harness';'Archive']
+ harness.'archive'('parrot_test_run.tar.gz')
+ options['merge'] = 1
+ .local pmc env_data
+ env_data = collect_test_environment_data()
+ harness.'extra_props'(env_data)
+ $P0 = split ' ', 'myconfig config_lib.pir'
+ harness.'extra_files'($P0)
+ L3:
+ harness.'process_args'(options)
+ $P0 = _get_tests(opts, files)
+ aggregate = harness.'runtests'($P0)
+ $I0 = exists opts['send-to-smolder']
+ unless $I0 goto L4
+ .tailcall send_archive_to_smolder(env_data)
+ L4:
+ $I0 = aggregate.'all_passed'()
+ $I0 = not $I0
+ exit $I0
+.end
+
+.sub 'set_test_prog_args' :anon
+ .param pmc opts
+ $S0 = ''
+ $I0 = exists opts['gc-debug']
+ unless $I0 goto L1
+ $S0 .= ' --gc-debug'
+ L1:
+ $I0 = exists opts['run-exec']
+ unless $I0 goto L2
+ $S0 .= ' --run-exec'
+ L2:
+ $S0 = substr $S0, 1
+ $P0 = new 'Env'
+ $P0['TEST_PROG_ARGS'] = $S0
+.end
+
+.sub '_get_tests' :anon
+ .param pmc opts
+ .param pmc files
+ .local int nb
+ $I0 = opts['code-tests']
+ unless $I0 goto L1
+ .const string developing_tests = 't/distro/file_metadata.t 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 '_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/native_pbc/*.t
+t/dynpmc/*.t
+t/dynoplibs/*.t
+TEST
+ .const string core_tests = <<'TEST'
+t/src/*.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/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
+
+.include 'iglobals.pasm'
+
+.sub 'collect_test_environment_data' :anon
+ .local pmc config, env
+ $P0 = getinterp
+ config = $P0[.IGLOBALS_CONFIG_HASH]
+ env = new 'Env'
+ $P0 = new 'Hash'
+ .local string arch
+ arch = config['cpuarch']
+ $P0['Architecture'] = arch
+ $S0 = _get_compiler_version(config)
+ $P0['Compiler'] = $S0
+ .local string devel
+ devel = config['DEVEL']
+ $P0['DEVEL'] = devel
+ .local string optimize
+ optimize = 'none'
+ $I0 = exists config['optimize']
+ unless $I0 goto L1
+ optimize = config['optimize']
+ L1:
+ $P0['Optimize'] = optimize
+ .local string osname
+ osname = config['osname']
+ $P0['Platform'] = osname
+ .local string version
+ version = config['VERSION']
+ $P0['Version'] = version
+ .local string submitter
+ submitter = _get_submitter(config, env)
+ $P0['Submitter'] = submitter
+ _add_subversion_info($P0)
+ .return ($P0)
+.end
+
+.sub '_get_compiler_version' :anon
+ .param pmc config
+ $S0 = config['cc']
+ $I0 = index $S0, 'gcc'
+ unless $I0 >= 0 goto L1
+ $I0 = exists config['gccversion']
+ unless $I0 goto L1
+ $S0 .= ' '
+ $S1 = config['gccversion']
+ $S0 .= $S1
+ .return ($S0)
+ L1:
+ $I0 = index $S0, 'cl'
+ unless $I0 >= 0 goto L2
+ $I0 = exists config['msvcversion']
+ unless $I0 goto L2
+ $S0 .= ' '
+ $S1 = config['msvcversion']
+ $S0 .= $S1
+ .return ($S0)
+ L2:
+ $I0 = exists config['gccversion']
+ unless $I0 goto L3
+ $S0 .= ' (gcc '
+ $S1 = config['gccversion']
+ $S0 .= $S1
+ $S0 .= ')'
+ .return ($S0)
+ L3:
+ $I0 = exists config['msvcversion']
+ unless $I0 goto L4
+ $S0 .= ' (msvc '
+ $S1 = config['msvcversion']
+ $S0 .= $S1
+ $S0 .= ')'
+ .return ($S0)
+ L4:
+ .return ($S0)
+.end
+
+.sub '_get_submitter' :anon
+ .param pmc config
+ .param pmc env
+ $I0 = exists env['SMOLDER_SUBMITTER']
+ unless $I0 goto L1
+ $S0 = env['SMOLDER_SUBMITTER']
+ .return ($S0)
+ L1:
+ .local string me
+ $I0 = exists config['win32']
+ unless $I0 goto L2
+ me = env['USERNAME']
+ goto L3
+ L2:
+ me = env['LOGNAME']
+ L3:
+ $S0 = me . '@unknown'
+ .return ($S0)
+.end
+
+.include 'cclass.pasm'
+
+.sub '_add_subversion_info' :anon
+ .param pmc hash
+ $I0 = file_exists('.svn')
+ unless $I0 goto L1
+ $P0 = new 'FileHandle'
+ $P0.'open'('svn info', 'pr')
+ $S0 = $P0.'readall'()
+ $P0.'close'()
+ $I0 = length $S0
+ $S1 = 'trunk'
+ $I1 = index $S0, '/branches/'
+ unless $I1 >= 0 goto L2
+ $I1 += 10
+ $I2 = find_not_cclass .CCLASS_WHITESPACE, $S0, $I1, $I0
+ $I3 = $I2 - $I1
+ $S1 = substr $S0, $I1, $I3
+ L2:
+ hash['Branch'] = $S1
+ $P0.'open'('svn status', 'pr')
+ $P1 = new 'ResizableStringArray'
+ L3:
+ $S0 = readline $P0
+ if $S0 == '' goto L4
+ $I0 = index $S0, 'M'
+ unless $I0 == 0 goto L3
+ $S0 = chomp($S0)
+ $I0 = length $S0
+ $I0 = find_not_cclass .CCLASS_WHITESPACE, $S0, 2, $I0
+ $S0 = substr $S0, $I0
+ push $P1, $S0
+ goto L3
+ L4:
+ $P0.'close'()
+ $I0 = elements $P1
+ unless $I0 != 0 goto L1
+ $S0 = hash['DEVEL']
+ $S0 .= ' '
+ $S1 = $I0
+ $S0 .= $S1
+ $S0 .= ' mods'
+ hash['DEVEL'] = $S0
+ $S0 = join ' ', $P1
+ hash['Modifications'] = $S0
+ L1:
+ .return (hash)
+.end
+
+.sub 'send_archive_to_smolder' :anon
+ .param pmc env_data
+ load_bytecode 'osutils.pbc'
+ .const string archive = 'parrot_test_run.tar.gz'
+ .const string smolder_url = 'http://smolder.plusthree.com/app/projects/process_add_report/8'
+ .const string username = 'parrot-autobot'
+ .const string password = 'squ at wk'
+ .local pmc config
+ $P0 = getinterp
+ config = $P0[.IGLOBALS_CONFIG_HASH]
+ .local string cmd
+ cmd = "curl -F architecture="
+ $S0 = config['cpuarch']
+ cmd .= $S0
+ cmd .= " -F platform="
+ $S0 = config['osname']
+ cmd .= $S0
+ cmd .= " -F revision="
+ $S0 = config['revision']
+ cmd .= $S0
+ cmd .= " -F tags=\""
+ $S0 = _get_tags(env_data)
+ cmd .= $S0
+ cmd .= "\""
+ cmd .= " -F username="
+ cmd .= username
+ cmd .= " -F password="
+ cmd .= password
+ cmd .= " -F comments=\"EXPERIMENTAL t/harness.pir\""
+ cmd .= " -F report_file=@"
+ cmd .= archive
+ cmd .= " "
+ cmd .= smolder_url
+ .tailcall system(cmd, 1 :named('verbose'))
+.end
+
+.sub '_get_tags' :anon
+ .param pmc env_data
+ $P0 = split ' ', 'Architecture Compiler Platform Version'
+ $P1 = new 'ResizableStringArray'
+ L1:
+ unless $P0 goto L2
+ $S0 = shift $P0
+ $S1 = env_data[$S0]
+ push $P1, $S1
+ goto L1
+ L2:
+ $S0 = join ', ', $P1
+ .return ($S0)
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
More information about the parrot-commits
mailing list