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