t/op/sprintf.t

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