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