t/op/sprintf.t

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