t/op/sprintf.t

   1 #!./parrot
   2 # Copyright (C) 2006-2008, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/op/sprintf.t  -- sprintf tests
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/op/sprintf.t
  12
  13 =head1 DESCRIPTION
  14
  15 These tests are based on C<sprintf> tests from perl 5.9.4.
  16
  17 Tests C<sprintf>, excluding handling of 64-bit integers or long
  18 doubles (if supported), of machine-specific short and long
  19 integers, machine-specific floating point exceptions (infinity,
  20 not-a-number, etc.), of the effects of locale, and of features
  21 specific to multi-byte characters (under the utf8 pragma and such).
  22
  23 Individual tests are stored in the F<sprintf_tests> file in the same
  24 directory; There is one test per line. In each test, there are three
  25 required fields:
  26
  27 =over 4
  28
  29 =item * printf template
  30
  31 =item * data to be formatted (as a parrot expression)
  32
  33 =item * expected result of formatting
  34
  35 =back
  36
  37 Optional fields contain a comment.
  38
  39 Each field is separated by one or more tabs.  If formatting requires more than
  40 one data item (for example, if variable field widths are used), the Parrot
  41 data expression should return a reference to an array having the requisite
  42 number of elements.  Even so, subterfuge is sometimes required:
  43 see tests for C<%n> and C<%p>.
  44
  45 =head1 XXX: FIXME: TODO:
  46
  47 Tests that are expected to fail on a certain OS can be marked as such
  48 by trailing the comment with a C<skip:> section. Skips are tags separated
  49 by space consisting of a C<$^O> optionally trailed with C<:osvers>. In the
  50 latter case, all os-levels below that are expected to fail. A special
  51 tag C<all> is allowed for todo tests that should fail on any system.
  52
  53         %G      1234567e96      1.23457E+102    exponent too big skip: os390
  54         %.0f    -0.1    -0      C library bug: no minus skip: VMS
  55         %d      4       1       4 != 1 skip: all
  56
  57 =cut
  58
  59
  60 .const int TESTS = 308
  61
  62 #.loadlib 'sys_ops'
  63 #.loadlib 'io_ops'
  64
  65 .sub main :main
  66     load_bytecode 'Test/Builder.pbc'
  67     .include "iglobals.pasm"
  68     .include "sysinfo.pasm"
  69
  70     # Variable declarations, initializations
  71     .local pmc test       # the test harness object.
  72                test = new [ 'Test'; 'Builder' ]
  73
  74     .local pmc todo_tests # keys indicate test file; values test number.
  75                todo_tests = new 'Hash'
  76
  77     .local pmc skip_tests # keys indicate tests ID; values reasons.
  78                skip_tests = new 'Hash'
  79
  80     .local string test_dir # the directory containing tests
  81                   test_dir = 't/op/'
  82
  83     .local pmc test_files # values are test file names to run.
  84                test_files = new 'ResizablePMCArray'
  85
  86     # populate the list of test files
  87     push test_files, 'sprintf_tests'
  88
  89
  90     .local pmc file_iterator # iterate over list of files..
  91                file_iterator = iter test_files
  92
  93     .local int test_number   # the number of the test we're running
  94                test_number = 0
  95
  96     # these vars are in the loops below
  97     .local string test_line  # one line of one test file, a single test
  98     .local int ok            # is this a passing test?
  99
 100     # for any given test:
 101     .local string template    # the sprintf template
 102     .local string data        # the data to format with the template
 103     .local string expected    # expected result of this test
 104     .local string description # user-facing description of the test
 105     .local int    skip_it     # skip this test on this platform?
 106     .local string actual      # actual result of the test
 107
 108     todo_tests = 'set_todo_info'()
 109     skip_tests = 'set_skip_info'()
 110
 111     # how many tests to run?
 112     test.'plan'(TESTS)
 113
 114   outer_loop:
 115     unless file_iterator goto end_outer_loop
 116     .local string test_name       # file name of the current test file
 117                   test_name = shift file_iterator
 118
 119     .local string test_file       # full name of the current test file
 120                   test_file = test_dir . test_name
 121
 122     .local int local_test_number  # local test number in test file
 123                local_test_number = 0
 124
 125     # Open the test file
 126     .local pmc file_handle   # currently open file
 127                file_handle = new ['FileHandle']
 128                file_handle.'open'(test_file, 'r')
 129
 130     unless file_handle goto bad_file
 131
 132     # loop over the file, one at a time.
 133
 134   loop:
 135     # read in the file one line at a time...
 136     $I0 = file_handle.'eof'()
 137     if $I0 goto end_loop
 138
 139     test_line = file_handle.'readline'()
 140
 141     # skip lines without tabs, and comment lines
 142     $I0 = index test_line, "\t"
 143     if $I0 == -1 goto loop
 144     $I0 = index test_line, '#'
 145     if $I0 == 0 goto loop
 146     inc test_number
 147     inc local_test_number
 148
 149   parse_data:
 150     push_eh eh_bad_line
 151     ( template, data, expected, description, skip_it ) = parse_data( test_line )
 152     pop_eh
 153
 154     # prepend test filename and line number to description
 155     description = 'build_test_desc'( description, template )
 156
 157     .local pmc data_hash
 158     data_hash = new 'Hash'
 159     data_hash["''"] = ''
 160     data_hash['2**32-1'] = 0xffffffff
 161     $N0 = data_hash['2**32-1']
 162     inc $N0
 163     data_hash['2**38'] = $N0
 164     data_hash["'string'"] = 'string'
 165
 166     $I0 = exists data_hash[data]
 167     unless $I0 goto got_data
 168     data = data_hash[data]
 169
 170   got_data:
 171 #    data     = backslash_escape (data)
 172 #    expected = backslash_escape (expected)
 173
 174     # Should this test be skipped?
 175     $S0  = description
 176     $S0 .= ' (skipped on this platform)'
 177     if skip_it goto must_skip
 178     $I0 = exists skip_tests[test_name]
 179     unless $I0 goto not_skip
 180     $P0 = skip_tests[test_name]
 181     $I0 = exists $P0[local_test_number]
 182     unless $I0 goto not_skip
 183     $S0 = $P0[local_test_number]
 184   must_skip:
 185     test.'skip'(1, $S0)
 186     goto loop
 187
 188   not_skip:
 189     push_eh eh_sprintf
 190     actual = 'sprintf'(template, data)
 191     pop_eh
 192     unless_null actual, sprintf_ok
 193     $P1 = new 'Exception'
 194     $P1[0] = 'sprintf error'
 195     throw $P1
 196   sprintf_ok:
 197
 198     if expected == actual goto is_ok
 199     description .= ' actual: >'
 200     description .= actual
 201     description .= '<'
 202     description .= ' expected: >'
 203     description .= expected
 204     description .= '<'
 205     goto is_nok
 206
 207     # remove /'s
 208     $S0 = substr expected, 0, 1
 209     if $S0 != "/" goto eh_bad_line
 210     expected = replace expected, 0, 1, ''
 211     expected = replace expected, -1, 1, ''
 212
 213     $I0 = index $S1, expected
 214     if $I0 == -1 goto is_nok
 215     # goto is_ok
 216
 217   is_ok:
 218     ok = 1
 219     goto emit_test
 220   is_nok:
 221     ok = 0
 222
 223   emit_test:
 224     $I0 = exists todo_tests[test_name]
 225     unless $I0 goto not_todo
 226     $P0 = todo_tests[test_name]
 227     $I0 = exists $P0[local_test_number]
 228     unless $I0 goto not_todo
 229     test.'todo'(ok,description)
 230     goto loop
 231   not_todo:
 232     test.'ok'(ok,description)
 233
 234     goto loop
 235   end_loop:
 236     file_handle.'close'()
 237     goto outer_loop
 238   end_outer_loop:
 239
 240     test.'finish'()
 241     end
 242
 243   bad_file:
 244     print "Unable to open '"
 245     print test_file
 246     print "'\n"
 247
 248   eh_sprintf:
 249     .local pmc exception
 250     .local string message
 251     get_results '0', exception
 252     message = exception
 253     $I0 = index message, 'is not a valid sprintf format'
 254     if $I0 == -1 goto other_error
 255     $I0 = index expected, ' INVALID'
 256     if $I0 == -1 goto bad_error
 257     ok = 1
 258     goto emit_test
 259   other_error:
 260   bad_error:
 261     ok = 0
 262     goto emit_test
 263   eh_bad_line:
 264     $S0 = "Test not formatted properly!"
 265     test.'ok'(0, $S0)
 266     goto loop
 267
 268 .end
 269
 270
 271 .sub 'sprintf'
 272     .param pmc args :slurpy
 273
 274     $S0 = shift args
 275     $S1 = sprintf $S0, args
 276
 277     .return ($S1)
 278 .end
 279
 280
 281 # set todo information
 282 .sub 'set_todo_info'
 283     .local pmc todo_tests # keys indicate test file; values test number
 284                todo_tests = new 'Hash'
 285
 286     .local pmc todo_info
 287                todo_info = new 'Hash'
 288     .local pmc jmpstack
 289                jmpstack = new 'ResizableIntegerArray'
 290
 291     .local string test_file
 292
 293     local_branch jmpstack,  reset_todo_info
 294     test_file = 'sprintf_tests'
 295     # TODOs
 296     todo_info[64] = 'undecided perl5 vs. posix behavior'
 297     todo_info[153] = '%hf should be rejected'
 298     todo_info[187] = '%h alone is invalid'
 299     todo_info[191] = '%l alone is invalid'
 300     todo_info[223] = '%v alone is invalid, but a valid parrot extension'
 301     todo_info[304] = 'undecided'
 302     todo_info[305] = 'undecided'
 303     todo_info[306] = 'undecided'
 304
 305     # end TODOs
 306     todo_tests[test_file] = todo_info
 307
 308     .return (todo_tests)
 309
 310   reset_todo_info:
 311     todo_info = new 'Hash'
 312     local_return jmpstack
 313
 314   set_todo_loop:
 315     if $I0 > $I1 goto end_loop
 316     todo_info[$I0] = 1
 317     $I0 += 1
 318     goto set_todo_loop
 319   end_loop:
 320     local_return jmpstack
 321 .end
 322
 323
 324 # set skip information
 325 .sub 'set_skip_info'
 326     .local pmc skip_tests # keys indicate test file; values test number
 327                skip_tests = new 'Hash'
 328
 329     .local pmc skip_info
 330                skip_info = new 'Hash'
 331     .local pmc jmpstack
 332                jmpstack = new 'ResizableIntegerArray'
 333
 334     .local string test_file
 335
 336     local_branch jmpstack,  reset_skip_info
 337     test_file = 'sprintf_tests'
 338     skip_info[5] = 'parrot extension (%B)'
 339     skip_info[7] = 'perl5-specific extension (%D)'
 340     skip_info[9] = 'perl5-specific extension (%F)'
 341     skip_info[16] = 'parrot extension (%H)'
 342     skip_info[20] = 'parrot extension (%L)'
 343     skip_info[23] = 'perl5-specific extension (%O)'
 344     skip_info[24] = 'parrot extension (%P)'
 345     skip_info[27] = 'parrot extension (%S)'
 346     skip_info[29] = 'perl5-specific extension (%U)'
 347
 348     $S0 = 'perl5-specific extension (%v...)'
 349     $I0 = 71
 350     $I1 = 99
 351     local_branch jmpstack,  set_skip_loop
 352
 353     skip_info[114] = 'harness needs support for * modifier'
 354     skip_info[144] = 'perl5 expresssion as test value'
 355     skip_info[131] = 'harness needs support for * modifier'
 356     skip_info[141] = 'harness needs support for * modifier'
 357     skip_info[161] = 'harness needs support for * modifier'
 358     skip_info[166] = 'harness needs support for * modifier'
 359     skip_info[193] = 'perl5-specific test'
 360     skip_info[200] = 'perl5-specific test'
 361     skip_info[201] = 'perl5-specific test'
 362     skip_info[202] = 'parrot extension (%p)'
 363     skip_info[204] = 'parrot extension (%r)'
 364     skip_info[210] = 'harness needs support for * modifier'
 365     skip_info[214] = 'harness needs support for * modifier'
 366     skip_info[233] = 'harness needs support for * modifier'
 367     skip_info[234] = 'perl5-specific extension (%v...)'
 368     skip_info[235] = 'perl5-specific extension (%v...)'
 369     skip_info[300] = 'harness needs support for * modifier'
 370
 371     $S0 = 'perl5-specific test'
 372     $I0 = 238
 373     $I1 = 251
 374     local_branch jmpstack,  set_skip_loop
 375
 376     $S0 = 'perl5-specific extension (%v...)'
 377     $I0 = 252
 378     $I1 = 298
 379     local_branch jmpstack,  set_skip_loop
 380
 381     skip_info[307] = 'perl5-specific extension (%v...)'
 382     skip_info[308] = 'perl5-specific extension (%v...)'
 383
 384     skip_tests[test_file] = skip_info
 385
 386     .return (skip_tests)
 387
 388   reset_skip_info:
 389     skip_info = new 'Hash'
 390     local_return jmpstack
 391
 392   set_skip_loop:
 393     if $I0 > $I1 goto end_loop
 394     if $S0 != '' goto set_skip_info
 395     $S0 = 'unknown reason'
 396   set_skip_info:
 397     skip_info[$I0] = $S0
 398     $I0 += 1
 399     goto set_skip_loop
 400   end_loop:
 401     $S0 = ''
 402     local_return jmpstack
 403 .end
 404
 405
 406 .sub 'parse_data'
 407     .param string record      # the data record
 408
 409     .local string template    # the sprintf template
 410     .local string data        # the data to format with the template
 411     .local string expected    # expected result of this test
 412     .local string description # user-facing description of the test
 413     .local int    skip_it     # skip this test on this platform
 414                   skip_it = 0
 415
 416     # NOTE: there can be multiple tabs between entries, so skip until
 417     # we have something.
 418     # remove the trailing newline from record
 419     record = chopn record, 1
 420     $P1 = split "\t", record
 421     $I0 = elements $P1 # length of array
 422     .local int tab_number
 423                tab_number = 0
 424   get_template:
 425     if tab_number >= $I0 goto bad_line
 426     template       = $P1[tab_number]
 427     inc tab_number
 428     if template == '' goto get_template
 429   get_data:
 430     if tab_number >= $I0 goto bad_line
 431     data           = $P1[tab_number]
 432     inc tab_number
 433     if data == '' goto get_data
 434     expected = ''
 435   get_expected:
 436     if tab_number >= $I0 goto empty_expected
 437     expected       = $P1[tab_number]
 438     inc tab_number
 439     if expected == '' goto get_expected
 440     ## FIXME: description handling
 441   get_description:
 442     if tab_number >= $I0 goto no_desc
 443     description    = $P1[tab_number]
 444     inc tab_number
 445     if description == '' goto get_description
 446
 447     ( description, skip_it ) = find_skip_in_description( description )
 448
 449     # chop (description)
 450     # substr description, -1, 1, ''
 451
 452   return:
 453   empty_expected:
 454     .return ( template, data, expected, description, skip_it )
 455
 456   no_desc:
 457     description = ''
 458     goto return
 459
 460   bad_line:
 461       $P1 = new 'Exception'
 462       $P1[0] = 'invalid data format'
 463       throw $P1
 464 .end
 465
 466
 467 .sub 'find_skip_in_description'
 468     .param string description
 469
 470     .local pmc parts
 471     parts = split ' skip: ', description
 472
 473     $I0 = parts
 474     if $I0 > 1 goto check_os
 475     .return( description, 0 )
 476
 477   check_os:
 478     description = shift parts
 479
 480     .local string skip_list
 481     skip_list = shift parts
 482
 483     .local pmc skip_os
 484     skip_os = split ' ', skip_list
 485
 486     .local pmc it
 487     it = iter skip_os
 488
 489     load_bytecode 'config.pbc'
 490     $P1 = _config()
 491     .local string osname
 492     osname = $P1['osname']
 493
 494   iter_loop:
 495     unless it goto iter_end
 496     .local string os_name
 497     os_name = shift it
 498     eq os_name, osname, skip_it
 499     goto iter_loop
 500   iter_end:
 501     .return( description, 0 )
 502
 503   skip_it:
 504     .return( description, 1 )
 505 .end
 506
 507
 508 .sub 'build_test_desc'
 509     .param string desc
 510     .param string testname
 511
 512     $S0  = '['
 513     $S0 .= testname
 514     $S0 .= '] '
 515
 516     desc = concat $S0, desc
 517
 518     .return (desc)
 519 .end
 520
 521
 522 # The following tests are not currently run, for the reasons stated:
 523
 524 =pod
 525
 526 =begin problematic
 527
 528 >%.0f<      >1.5<         >2<   >Standard vague: no rounding rules<
 529 >%.0f<      >2.5<         >2<   >Standard vague: no rounding rules<
 530
 531 =end problematic
 532
 533 =cut
 534
 535 # Local Variables:
 536 #   mode: pir
 537 #   fill-column: 100
 538 # End:
 539 # vim: expandtab shiftwidth=4 ft=pir: