t/harness.pir

   1 #!parrot
   2 # Copyright (C) 2010, Parrot Foundation.
   3 # $Id$
   4
   5 .sub 'main' :main
   6     .param pmc argv
   7     $S0  = shift argv
   8     .local int argc
   9     argc = elements argv
  10     if argc > 0 goto L1
  11     help()
  12     end
  13   L1:
  14     .local pmc opts
  15     opts = _parse_opts(argv)
  16     $I0 = exists opts['help']
  17     unless $I0 goto L2
  18     help()
  19     end
  20   L2:
  21     .tailcall do(opts, argv)
  22 .end
  23
  24 .sub 'help' :anon
  25     say <<"HELP"
  26 parrot t/harness.pir [options] [testfiles]
  27     --core-tests
  28     --runcore-tests
  29     --code-tests
  30     --archive  ... create a TAP archive of the test run
  31     --send-to-smolder ... send the TAP archive to the Parrot Smolder server
  32 HELP
  33 .end
  34
  35 .sub '_parse_opts' :anon
  36     .param pmc argv
  37     load_bytecode 'Getopt/Obj.pbc'
  38     $P0 = new ['Getopt';'Obj']
  39     $P0.'notOptStop'(1)
  40     push $P0, 'gc-debug'
  41     push $P0, 'core-tests'
  42     push $P0, 'runcore-tests'
  43     push $P0, 'code-tests'
  44     push $P0, 'run-exec'
  45     push $P0, 'archive'
  46     push $P0, 'send-to-smolder'
  47     push $P0, 'help|h'
  48     $P1 = $P0.'get_options'(argv)
  49     .return ($P1)
  50 .end
  51
  52 .sub 'do' :anon
  53     .param pmc opts
  54     .param pmc files
  55     set_test_prog_args(opts)
  56     load_bytecode 'TAP/Harness.pbc'
  57     .local pmc options, env, harness, aggregate
  58     options = new 'Hash'
  59     env = new 'Env'
  60     $I0 = exists env['HARNESS_VERBOSE']
  61     unless $I0 goto L1
  62     $S0 = env['HARNESS_VERBOSE']
  63     options['verbosity'] = $S0
  64   L1:
  65     $I0 = exists opts['archive']
  66     if $I0 goto L2
  67     harness = new ['TAP';'Harness']
  68     options['directives'] = 1
  69     goto L3
  70   L2:
  71     harness = new ['TAP';'Harness';'Archive']
  72     harness.'archive'('parrot_test_run.tar.gz')
  73     options['merge'] = 1
  74     .local pmc env_data
  75     env_data = collect_test_environment_data()
  76     harness.'extra_props'(env_data)
  77     $P0 = split ' ', 'myconfig config_lib.pir'
  78     harness.'extra_files'($P0)
  79   L3:
  80     harness.'process_args'(options)
  81     $P0 = _get_tests(opts, files)
  82     aggregate = harness.'runtests'($P0)
  83     $I0 = exists opts['send-to-smolder']
  84     unless $I0 goto L4
  85     .tailcall send_archive_to_smolder(env_data)
  86   L4:
  87     $I0 = aggregate.'all_passed'()
  88     $I0 = not $I0
  89     exit $I0
  90 .end
  91
  92 .sub 'set_test_prog_args' :anon
  93     .param pmc opts
  94     $S0 = ''
  95     $I0 = exists opts['gc-debug']
  96     unless $I0 goto L1
  97     $S0 .= ' --gc-debug'
  98   L1:
  99     $I0 = exists opts['run-exec']
 100     unless $I0 goto L2
 101     $S0 .= ' --run-exec'
 102   L2:
 103     $S0 = substr $S0, 1
 104     $P0 = new 'Env'
 105     $P0['TEST_PROG_ARGS'] = $S0
 106 .end
 107
 108 .sub '_get_tests' :anon
 109     .param pmc opts
 110     .param pmc files
 111     .local int nb
 112     $I0 = opts['code-tests']
 113     unless $I0 goto L1
 114     .const string developing_tests = 't/distro/file_metadata.t t/codingstd/*.t'
 115     files = glob(developing_tests)
 116     goto L2
 117   L1:
 118     nb = elements files
 119     unless nb == 0 goto L2
 120     files = _get_common_tests(opts)
 121   L2:
 122     nb = elements files
 123     # currently, FixedStringArray hasn't the method sort.
 124     # see TT #1356
 125     $P0 = new 'FixedPMCArray'
 126     set $P0, nb
 127     $I0 = 0
 128     $P1 = iter files
 129   L3:
 130     unless $P1 goto L4
 131     $S0 = shift $P1
 132     $P2 = split "\\", $S0
 133     $S0 = join "/", $P2
 134     $P2 = box $S0
 135     $P0[$I0] = $P2
 136     inc $I0
 137     goto L3
 138   L4:
 139     $P0.'sort'()
 140     .return ($P0)
 141 .end
 142
 143 .sub '_get_common_tests' :anon
 144     .param pmc opts
 145     .const string runcore_tests = <<'TEST'
 146 t/compilers/imcc/*/*.t
 147 t/op/*.t
 148 t/pmc/*.t
 149 t/oo/*.t
 150 t/native_pbc/*.t
 151 t/dynpmc/*.t
 152 t/dynoplibs/*.t
 153 TEST
 154     .const string core_tests = <<'TEST'
 155 t/src/*.t
 156 t/run/*.t
 157 t/perl/*.t
 158 TEST
 159     .const string library_tests = <<'TEST'
 160 t/compilers/pct/*.t
 161 t/compilers/pge/*.t
 162 t/compilers/pge/p5regex/*.t
 163 t/compilers/pge/perl6regex/*.t
 164 t/compilers/tge/*.t
 165 t/library/*.t
 166 t/tools/*.t
 167 t/profiling/*.t
 168 TEST
 169     .const string configure_tests = <<'TEST'
 170 t/configure/*.t
 171 t/steps/*.t
 172 t/postconfigure/*.t
 173 TEST
 174     $S0 = runcore_tests
 175     $I0 = exists opts['runcore-tests']
 176     if $I0 goto L1
 177     $S0 .= core_tests
 178     $I0 = exists opts['core-tests']
 179     if $I0 goto L1
 180     $S0 .= library_tests
 181     $S0 .= configure_tests
 182   L1:
 183     $P0 = split "\n", $S0
 184     $S0 = join ' ', $P0
 185     $P0 = glob($S0)
 186     .return ($P0)
 187 .end
 188
 189 .include 'iglobals.pasm'
 190
 191 .sub 'collect_test_environment_data' :anon
 192     .local pmc config, env
 193     $P0 = getinterp
 194     config = $P0[.IGLOBALS_CONFIG_HASH]
 195     env = new 'Env'
 196     $P0 = new 'Hash'
 197     .local string arch
 198     arch = config['cpuarch']
 199     $P0['Architecture'] = arch
 200     $S0 = _get_compiler_version(config)
 201     $P0['Compiler'] = $S0
 202     .local string devel
 203     devel = config['DEVEL']
 204     $P0['DEVEL'] = devel
 205     .local string optimize
 206     optimize = 'none'
 207     $I0 = exists config['optimize']
 208     unless $I0 goto L1
 209     optimize = config['optimize']
 210   L1:
 211     $P0['Optimize'] = optimize
 212     .local string osname
 213     osname = config['osname']
 214     $P0['Platform'] = osname
 215     .local string version
 216     version = config['VERSION']
 217     $P0['Version'] = version
 218     .local string submitter
 219     submitter = _get_submitter(config, env)
 220     $P0['Submitter'] = submitter
 221     _add_subversion_info($P0)
 222     .return ($P0)
 223 .end
 224
 225 .sub '_get_compiler_version' :anon
 226     .param pmc config
 227     $S0 = config['cc']
 228     $I0 = index $S0, 'gcc'
 229     unless $I0 >= 0 goto L1
 230     $I0 = exists config['gccversion']
 231     unless $I0 goto L1
 232     $S0 .= ' '
 233     $S1 = config['gccversion']
 234     $S0 .= $S1
 235     .return ($S0)
 236   L1:
 237     $I0 = index $S0, 'cl'
 238     unless $I0 >= 0 goto L2
 239     $I0 = exists config['msvcversion']
 240     unless $I0 goto L2
 241     $S0 .= ' '
 242     $S1 = config['msvcversion']
 243     $S0 .= $S1
 244     .return ($S0)
 245   L2:
 246     $I0 = exists config['gccversion']
 247     unless $I0 goto L3
 248     $S0 .= ' (gcc '
 249     $S1 = config['gccversion']
 250     $S0 .= $S1
 251     $S0 .= ')'
 252     .return ($S0)
 253   L3:
 254     $I0 = exists config['msvcversion']
 255     unless $I0 goto L4
 256     $S0 .= ' (msvc '
 257     $S1 = config['msvcversion']
 258     $S0 .= $S1
 259     $S0 .= ')'
 260     .return ($S0)
 261   L4:
 262     .return ($S0)
 263 .end
 264
 265 .sub '_get_submitter' :anon
 266     .param pmc config
 267     .param pmc env
 268     $I0 = exists env['SMOLDER_SUBMITTER']
 269     unless $I0 goto L1
 270     $S0 = env['SMOLDER_SUBMITTER']
 271     .return ($S0)
 272   L1:
 273     .local string me
 274     $I0 = exists config['win32']
 275     unless $I0 goto L2
 276     me = env['USERNAME']
 277     goto L3
 278   L2:
 279     me = env['LOGNAME']
 280   L3:
 281     $S0 = me . '@unknown'
 282     .return ($S0)
 283 .end
 284
 285 .include 'cclass.pasm'
 286
 287 .sub '_add_subversion_info' :anon
 288     .param pmc hash
 289     $I0 = file_exists('.svn')
 290     unless $I0 goto L1
 291     $P0 = new 'FileHandle'
 292     $P0.'open'('svn info', 'pr')
 293     $S0 = $P0.'readall'()
 294     $P0.'close'()
 295     $I0 = length $S0
 296     $S1 = 'trunk'
 297     $I1 = index $S0, '/branches/'
 298     unless $I1 >= 0 goto L2
 299     $I1 += 10
 300     $I2 = find_not_cclass .CCLASS_WHITESPACE, $S0, $I1, $I0
 301     $I3 = $I2 - $I1
 302     $S1 = substr $S0, $I1, $I3
 303   L2:
 304     hash['Branch'] = $S1
 305     $P0.'open'('svn status', 'pr')
 306     $P1 = new 'ResizableStringArray'
 307   L3:
 308     $S0 = readline $P0
 309     if $S0 == '' goto L4
 310     $I0 = index $S0, 'M'
 311     unless $I0 == 0 goto L3
 312     $S0 = chomp($S0)
 313     $I0 = length $S0
 314     $I0 = find_not_cclass .CCLASS_WHITESPACE, $S0, 2, $I0
 315     $S0 = substr $S0, $I0
 316     push $P1, $S0
 317     goto L3
 318   L4:
 319     $P0.'close'()
 320     $I0 = elements $P1
 321     unless $I0 != 0 goto L1
 322     $S0 = hash['DEVEL']
 323     $S0 .= ' '
 324     $S1 = $I0
 325     $S0 .= $S1
 326     $S0 .= ' mods'
 327     hash['DEVEL'] = $S0
 328     $S0 = join ' ', $P1
 329     hash['Modifications'] = $S0
 330   L1:
 331     .return (hash)
 332 .end
 333
 334 .sub 'send_archive_to_smolder' :anon
 335     .param pmc env_data
 336     load_bytecode 'osutils.pbc'
 337     .const string archive = 'parrot_test_run.tar.gz'
 338     .const string smolder_url = 'http://smolder.plusthree.com/app/projects/process_add_report/8'
 339     .const string username = 'parrot-autobot'
 340     .const string password = 'squ@wk'
 341     .local pmc config
 342     $P0 = getinterp
 343     config = $P0[.IGLOBALS_CONFIG_HASH]
 344     .local string cmd
 345     cmd = "curl -F architecture="
 346     $S0 = config['cpuarch']
 347     cmd .= $S0
 348     cmd .= " -F platform="
 349     $S0 = config['osname']
 350     cmd .= $S0
 351     cmd .= " -F revision="
 352     $S0 = config['revision']
 353     cmd .= $S0
 354     cmd .= " -F tags=\""
 355     $S0 = _get_tags(env_data)
 356     cmd .= $S0
 357     cmd .= "\""
 358     cmd .= " -F username="
 359     cmd .= username
 360     cmd .= " -F password="
 361     cmd .= password
 362     cmd .= " -F comments=\"EXPERIMENTAL t/harness.pir\""
 363     cmd .= " -F report_file=@"
 364     cmd .= archive
 365     cmd .= " "
 366     cmd .= smolder_url
 367     .tailcall system(cmd, 1 :named('verbose'))
 368 .end
 369
 370 .sub '_get_tags' :anon
 371     .param pmc env_data
 372     $P0 = split ' ', 'Architecture Compiler Platform Version'
 373     $P1 = new 'ResizableStringArray'
 374   L1:
 375     unless $P0 goto L2
 376     $S0 = shift $P0
 377     $S1 = env_data[$S0]
 378     push $P1, $S1
 379     goto L1
 380   L2:
 381     $S0 = join ', ', $P1
 382     .return ($S0)
 383 .end
 384
 385
 386 # Local Variables:
 387 #   mode: pir
 388 #   fill-column: 100
 389 # End:
 390 # vim: expandtab shiftwidth=4 ft=pir: