Ticket #160: t_library.diff

File t_library.diff, 14.3 KB (added by geraud, 13 years ago)

  • t/library/File_Spec.t

     
    1 #! perl 
    2 # Copyright (C) 2001-2008, The Perl Foundation. 
     1#! parrot 
     2# Copyright (C) 2001-2009, The Perl Foundation. 
    33# $Id$ 
    44 
    5 use strict; 
    6 use warnings; 
    7 use lib qw( t . lib ../lib ../../lib ); 
    8 use Test::More; 
    9 use Parrot::Test tests => 20; 
    10  
    115=head1 NAME 
    126 
    13 t/library/File-Spec.t - test File::Spec module 
     7t/library/File_Spec.t - test File::Spec module 
    148 
    159=head1 SYNOPSIS 
    1610 
    17     % prove t/library/File-Spec.t 
     11    % prove t/library/File_Spec.t 
    1812 
    1913=head1 DESCRIPTION 
    2014 
    … …  
    2519############################## 
    2620# File::Spec 
    2721 
    28 my $PRE = <<'PRE'; 
    29 .sub 'main' :main 
    30         load_bytecode 'library/File/Spec.pir' 
     22.sub main :main 
     23    .include 'test_more.pir' 
     24    plan(22) 
    3125 
    32         .local int classtype 
    33         .local pmc spec 
     26    FS_load_bytecode() 
     27    FS_new() 
     28    FS_can() 
     29    FS_isa() 
     30    FS_version() 
     31    FS_private_subs() 
     32.end 
    3433 
    35         spec = new 'File::Spec' 
     34.sub FS_load_bytecode 
     35    load_bytecode 'File/Spec.pir' 
     36    ok(1, 'load_bytecode') 
     37.end 
    3638 
    37 PRE 
    38 my $POST = <<'POST'; 
    39         goto OK 
    40 NOK: 
    41         print "not " 
    42 OK: 
    43         print "ok" 
    44 END: 
    45         print "\n" 
     39.sub FS_new 
     40    .local pmc spec 
     41 
     42    spec = new 'File::Spec' 
     43    ok(1, 'new') 
    4644.end 
    47 POST 
    4845 
    49 ## 1 
    50 pir_output_is( <<'CODE'. $POST, <<'OUT', "load_bytecode" ); 
    51 .sub 'main' :main 
    52         load_bytecode 'File/Spec.pir' 
    53 CODE 
    54 ok 
    55 OUT 
     46.sub FS_can 
     47    .local pmc spec 
     48    .local pmc method_list 
    5649 
    57 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', "new" ); 
    58 CODE 
    59 ok 
    60 OUT 
     50    $S0 = '__isa VERSION devnull tmpdir case_tolerant file_name_is_absolute ' 
     51    $S0 = concat $S0, 'catfile catdir path canonpath splitpath splitdir ' 
     52    $S0 = concat $S0, 'catpath abs2rel rel2abs' 
     53    method_list = split ' ', $S0 
    6154 
    62 my @meths = ( 
    63     qw/ 
    64         __isa VERSION devnull tmpdir case_tolerant file_name_is_absolute catfile 
    65         catdir path canonpath splitpath splitdir catpath abs2rel rel2abs 
    66         / 
    67 ); 
    68 pir_output_is( $PRE . <<"CODE". $POST, <<'OUT', "can ($_)" ) for @meths; 
    69         .local pmc meth 
    70         \$I0 = can spec, "$_" 
    71         unless \$I0, NOK 
    72 CODE 
    73 ok 
    74 OUT 
     55    spec = new 'File::Spec' 
    7556 
    76 pir_output_like( $PRE . <<'CODE'. $POST, <<'OUT', "isa" ); 
    77         .local pmc class 
    78         class= new 'String' 
     57  LOOP: 
     58    $I0 = elements method_list 
     59    if $I0 == 0 goto END_TEST 
     60    $S0 = method_list.'shift'() 
     61    $I0 = can spec, $S0 
     62    $S1 = concat 'File::Spec can ', $S0 
     63    ok($I0, $S1) 
     64    goto LOOP 
    7965 
    80         class= spec.'__isa'() 
    81         print class 
    82         print "\n" 
    83 CODE 
    84 /^File::Spec::.+/ 
    85 OUT 
     66  END_TEST: 
     67.end 
    8668 
    87 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', "version" ); 
    88         .local pmc version 
    89         version= spec.'VERSION'() 
    90         print version 
    91         goto END 
    92 CODE 
    93 0.1 
    94 OUT 
     69.sub FS_isa 
     70    .local pmc spec 
    9571 
    96 ## testing private subs 
    97 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', "_get_module" ); 
    98         .local string module 
    99         .local pmc get_module 
    100         get_module = get_hll_global [ 'File::Spec' ], '_get_module' 
    101         module= get_module( 'MSWin32' ) 
    102         print module 
    103         print "\n" 
    104         module= get_module( 'foobar' ) 
    105         print module 
    106         goto END 
    107 CODE 
    108 Win32 
    109 Unix 
    110 OUT 
     72    spec = new 'File::Spec' 
     73    isa_ok(spec, 'File::Spec') 
     74    $S0 = spec.'__isa'() 
     75    like($S0, "File '::' Spec '::' .+", 'The object isa File::Spec::.+') 
     76.end 
    11177 
     78.sub FS_version 
     79    .local pmc spec 
     80 
     81    spec = new 'File::Spec' 
     82    $S0 = spec.'VERSION'() 
     83    is($S0, '0.1', 'VERSION 0.1') 
     84.end 
     85 
     86.sub FS_private_subs 
     87    .local pmc spec 
     88 
     89    spec = new 'File::Spec' 
     90    .local string module 
     91    .local pmc get_module 
     92    get_module = get_hll_global [ 'File::Spec' ], '_get_module' 
     93 
     94    module = get_module( 'MSWin32' ) 
     95    is(module, 'Win32', 'File::Spec module for MSWin32 is Win32') 
     96 
     97    module = get_module( 'foobar' ) 
     98    is(module, 'Unix',  'File::Spec module for foobar is Unix') 
     99.end 
     100 
    112101# Local Variables: 
    113 #   mode: cperl 
    114 #   cperl-indent-level: 4 
     102#   mode: pir 
    115103#   fill-column: 100 
    116104# End: 
    117 # vim: expandtab shiftwidth=4: 
     105# vim: expandtab shiftwidth=4 ft=pir: 

  • t/library/data_escape.t

     
    1 #!perl 
    2 # Copyright (C) 2001-2006, The Perl Foundation. 
     1#! parrot 
     2# Copyright (C) 2001-2009, The Perl Foundation. 
    33# $Id$ 
    44 
    5 use strict; 
    6 use warnings; 
    7 use lib qw( t . lib ../lib ../../lib ); 
    8 use Test::More; 
    9 use Parrot::Test tests => 22; 
    10  
    115=head1 NAME 
    126 
    137t/library/data_escape.t - Data::Escape tests 
    … …  
    1812 
    1913=cut 
    2014 
    21 my $lib  = 'Data/Escape.pir'; 
    22 my $ns   = 'Data::Escape'; 
    23 my @subs = qw/ String /; 
    24  
    25 my $PRE = <<"PRE"; 
    2615.sub main :main 
    27     load_bytecode "$lib" 
     16    .include 'test_more.pir' 
     17    plan(22) 
    2818 
    29     .local pmc escape_string 
    30  
    31     escape_string = get_global ['$ns'], 'String' 
    32 PRE 
    33  
    34 my $POST = <<'POST'; 
    35 NOK: 
    36     print "not " 
    37 OK: 
    38     print "ok" 
    39 END: 
    40     print "\n" 
     19    DE_load_bytecode() 
     20    DE_get_global() 
     21    DE_escape_string_empty_string() 
     22    DE_escape_string_no_escapes() 
     23    DE_escape_string_tab_carriage_return_linefeed() 
     24    DE_escape_string_other_characters_less_than_32() 
     25    DE_escape_string_single_quote() 
     26    DE_escape_string_double_quote() 
     27    DE_escape_string_single_and_double_escape_single() 
     28    DE_escape_string_single_and_double_escape_double() 
     29    DE_escape_string_backslash() 
     30    DE_escape_string_unprintable_followed_by_numbers() 
     31    DE_escape_string_non_ascii() 
     32    DE_escape_string_freeze_a_simple_pmc() 
     33    DE_unicode_test() 
    4134.end 
    42 POST 
    4335 
    44 ## 1 
    45 pir_output_is( <<CODE, <<'OUT', "load_bytecode" ); 
    46 .sub main :main 
    47     load_bytecode "$lib" 
    48     goto OK 
    49 NOK: 
    50     print "not " 
    51 OK: 
    52     print "ok" 
    53 END: 
    54     print "\\n" 
     36.sub DE_load_bytecode 
     37    load_bytecode 'Data/Escape.pir' 
     38    ok(1, 'load_bytecode') 
    5539.end 
    56 CODE 
    57 ok 
    58 OUT 
    5940 
    60 ## get_global tests 
    61 for my $sub (@subs) { 
    62     pir_output_is( <<CODE, <<'OUT', "get_global ['$sub']" ); 
    63 .sub main :main 
    64     load_bytecode "$lib" 
    65     .local pmc sub 
    66     sub = get_global ['$ns'], "$sub" 
    67     goto OK 
    68 NOK: 
    69     print "not " 
    70 OK: 
    71     print "ok" 
    72 END: 
    73     print "\\n" 
     41.sub DE_get_global 
     42    .local pmc sub_list, sub_obj 
     43    .local string test_message 
     44 
     45    $S0 = 'String' 
     46    sub_list = split ' ', $S0 
     47 
     48  LOOP: 
     49    $I0 = elements sub_list 
     50    if $I0 == 0 goto END_TEST 
     51    $S0 = sub_list.'shift'() 
     52    test_message = concat "get_global ['Data::Escape'], '", $S0 
     53    test_message = concat test_message, "'" 
     54    sub_obj = get_global ['Data::Escape'], $S0 
     55    ok(1, test_message) 
     56 
     57  END_TEST: 
    7458.end 
    75 CODE 
    76 ok 
    77 OUT 
    78 } ## end get_global tests 
    7959 
    80 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: empty string" ); 
     60.sub DE_escape_string_empty_string 
     61    .local pmc escape_string 
     62    escape_string = get_global ['Data::Escape'], 'String' 
     63 
    8164    .local string str 
    8265    str = "" 
    8366    str = escape_string( str, '"' ) 
     67    is(str, '', 'escape_string: empty string') 
     68.end 
    8469 
    85     print str 
    86     goto OK 
    87 CODE 
    88 ok 
    89 OUT 
     70.sub DE_escape_string_no_escapes 
     71    .local pmc escape_string 
     72    escape_string = get_global ['Data::Escape'], 'String' 
    9073 
    91 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: no escapes" ); 
    9274    .local string str 
    93  
    9475    str = "abc 123" 
    9576    str = escape_string( str, '"' ) 
     77    is(str, 'abc 123', 'escape_string: no escapes') 
     78.end 
    9679 
    97     print str 
    98     goto END 
    99 CODE 
    100 abc 123 
    101 OUT 
     80.sub DE_escape_string_tab_carriage_return_linefeed 
     81    .local pmc escape_string 
     82    escape_string = get_global ['Data::Escape'], 'String' 
    10283 
    103 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: tab, carriage return, linefeed" ); 
    10484    .local string str 
    105  
    10685    str = "a\tb\nc" 
    10786    str = escape_string( str, '"' ) 
     87    is(str, 'a\tb\nc', 'escape_string: tab, carriage return, linefeed') 
     88.end 
    10889 
    109     print str 
    110     goto END 
    111 CODE 
    112 a\tb\nc 
    113 OUT 
     90.sub DE_escape_string_other_characters_less_than_32 
     91    .local pmc escape_string 
     92    escape_string = get_global ['Data::Escape'], 'String' 
    11493 
    115 pir_output_is( $PRE . <<CODE . $POST, <<'OUT', "escape_string: other characters less than 32" ); 
    11694    .local string str, x 
    11795 
    11896    .local int index 
    11997    index = 0 
    12098    str = '' 
    12199 
    122 LOOP: 
     100  LOOP: 
    123101    if index >= 32 goto DONE 
    124102 
    125103    x = chr index 
    … …  
    128106    inc index 
    129107    branch LOOP 
    130108 
    131 DONE: 
     109  DONE: 
    132110    str = escape_string( str, "'" ) 
     111    is(str, '\000\001\002\003\004\005\006\007\010\t\n\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037', 'escape_string: other characters less than 32') 
     112.end 
    133113 
    134     print str 
    135     goto END 
    136 CODE 
    137 \000\001\002\003\004\005\006\007\010\t\n\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037 
    138 OUT 
     114.sub DE_escape_string_single_quote 
     115    .local pmc escape_string 
     116    escape_string = get_global ['Data::Escape'], 'String' 
    139117 
    140 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single quote" ); 
    141118    .local string str 
    142  
    143     str = "a'b'c'" 
     119    str = "a'b'c" 
    144120    str = escape_string( str, "'" ) 
     121    is(str, "a\\'b\\'c", 'escape_string: single quote') 
     122.end 
    145123 
    146     print str 
    147     goto END 
    148 CODE 
    149 a\'b\'c\' 
    150 OUT 
     124.sub DE_escape_string_double_quote 
     125    .local pmc escape_string 
     126    escape_string = get_global ['Data::Escape'], 'String' 
    151127 
    152 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: double quote" ); 
    153128    .local string str 
    154  
    155     str = 'a"b"c"' 
     129    str = 'a"b"c' 
    156130    str = escape_string( str, '"' ) 
     131    is(str, 'a\"b\"c', 'escape_string: double quote') 
     132.end 
    157133 
    158     print str 
    159     goto END 
    160 CODE 
    161 a\"b\"c\" 
    162 OUT 
     134.sub DE_escape_string_single_and_double_escape_single 
     135    .local pmc escape_string 
     136    escape_string = get_global ['Data::Escape'], 'String' 
    163137 
    164 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single  double: escape single" ); 
    165138    .local string str 
    166  
    167139    str = "ab\"'\"'c" 
    168140    str = escape_string( str, "'" ) 
     141    is(str, "ab\"\\'\"\\'c",'escape_string: single and double, escape single') 
     142.end 
    169143 
    170     print str 
    171     goto END 
    172 CODE 
    173 ab"\'"\'c 
    174 OUT 
     144.sub DE_escape_string_single_and_double_escape_double 
     145    .local pmc escape_string 
     146    escape_string = get_global ['Data::Escape'], 'String' 
    175147 
    176 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single & double: escape double" ); 
    177148    .local string str 
    178  
    179149    str = "ab\"'\"'c" 
    180150    str = escape_string( str, '"' ) 
     151    is(str, "ab\\\"'\\\"'c", 'escape_string: single and double, escape double') 
     152.end 
    181153 
    182     print str 
    183     goto END 
    184 CODE 
    185 ab\"'\"'c 
    186 OUT 
     154.sub DE_escape_string_backslash 
     155    .local pmc escape_string 
     156    escape_string = get_global ['Data::Escape'], 'String' 
    187157 
    188 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: backslash" ); 
    189158    .local string str 
    190  
    191159    str = '\ abc \t' 
    192160    str = escape_string( str, '"' ) 
     161    is(str, '\\ abc \\t', 'escape_string: backslash') 
     162.end 
    193163 
    194     print str 
    195     goto END 
    196 CODE 
    197 \\ abc \\t 
    198 OUT 
     164.sub DE_escape_string_unprintable_followed_by_numbers 
     165    .local pmc escape_string 
     166    escape_string = get_global ['Data::Escape'], 'String' 
    199167 
    200 pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: unprintable followed by numbers" ); 
    201168    .local string str 
    202  
    203169    str = chr 2 
    204170    concat str, '123' 
    205171    str = escape_string( str, '"' ) 
     172    is(str, '\002123', 'escape_string: unprintable followed by numbers') 
     173.end 
    206174 
    207     print str 
    208     goto END 
    209 CODE 
    210 \002123 
    211 OUT 
     175.sub DE_escape_string_non_ascii 
     176    todo(0, 'escape_string: non-ascii', 'test not written') 
     177.end 
    212178 
    213 SKIP: { 
    214     skip 'test not written' => 1; 
    215     pir_output_is( 
    216         $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: non-ascii", todo => 'test not written' ); 
    217 CODE 
    218 ok 
    219 OUT 
    220 } 
     179.sub DE_escape_string_freeze_a_simple_pmc 
     180    .local pmc escape_string 
     181    escape_string = get_global ['Data::Escape'], 'String' 
    221182 
    222 pir_output_is( $PRE . <<'CODE', <<'OUT', "escape_string: freeze a simple pmc" ); 
    223183    .local pmc original_pmc 
    224184    original_pmc = new 'String' 
    225185    original_pmc = "ok\n" 
    … …  
    234194    pir_code = ".sub test :anon\n$P1 = thaw binary:\"" 
    235195 
    236196    pir_code .= escaped_frozen_pmc 
    237     pir_code .= "\"\nprint $P1\n.end\n" 
     197    pir_code .= "\"\n.return($P1)\n.e" 
     198    # split sub ending to play nice with some editors 
     199    pir_code .= "nd\n" 
    238200 
    239201    .local pmc pir_compiler 
    240202    pir_compiler = compreg "PIR" 
    241203 
    242204    .local pmc compiled_sub 
    243205    compiled_sub = pir_compiler(pir_code) 
    244     compiled_sub() 
     206    $P0 = compiled_sub() 
     207    is($P0, "ok\n", 'escape_string: freeze a simple pmc') 
    245208.end 
    246 CODE 
    247 ok 
    248 OUT 
    249209 
    250 my @codes = qw/ 0666 0777 0888 0999 6666 7777 8888 9999/; 
     210.sub _unicode_gen 
     211    .param string codepoint 
    251212 
    252 my $unicode_test = $PRE . << 'CODE' . $POST; 
    253     .local string str 
    254     str = unicode:"\u%s" 
     213    .local string pir_code 
     214    pir_code  = ".sub ugen :anon\n$S0 = unicode:\"\\u" 
     215    pir_code .= codepoint 
     216    pir_code .= "\"\n.return($S0)\n.e" 
     217    # split sub ending to play nice with some editors 
     218    pir_code .= "nd\n" 
     219 
     220    .local pmc pir_compiler, compiled_sub 
     221    pir_compiler = compreg "PIR" 
     222    compiled_sub = pir_compiler(pir_code) 
     223    .tailcall compiled_sub() 
     224.end 
     225 
     226.sub DE_unicode_test 
     227    .local pmc escape_string 
     228    escape_string = get_global ['Data::Escape'], 'String' 
     229 
     230    .local pmc codepoint_list 
     231    $S0 = '0666 0777 0888 0999 6666 7777 8888 9999' 
     232    codepoint_list = split ' ', $S0 
     233 
     234    .local string s_codepoint, i_codepoint 
     235    .local string str, expected, test_message 
     236 
     237  LOOP: 
     238    $I0 = elements codepoint_list 
     239    if $I0 == 0 goto TEST_END 
     240    s_codepoint = codepoint_list.'shift'() 
     241    $I1 = s_codepoint 
     242    i_codepoint = $I1 
     243 
     244    expected  = concat "\\x{", i_codepoint 
     245    expected .= "}" 
     246    test_message  = concat "escape_string: unicode: ", s_codepoint 
     247    str = _unicode_gen(s_codepoint) 
     248 
    255249    str = escape_string( str, '"' ) 
    256     print str 
    257     goto END 
    258 CODE 
     250    is(str, expected, test_message) 
     251    goto LOOP 
    259252 
    260 foreach my $codepoint (@codes) { 
    261     pir_output_is( 
    262         ( sprintf $unicode_test, $codepoint ), 
    263         ( sprintf "\\x{%i}\n", $codepoint ), 
    264         "escape_string: unicode: $codepoint" 
    265     ); 
    266 } 
     253  TEST_END: 
     254.end 
    267255 
    268256# Local Variables: 
    269 #   mode: cperl 
    270 #   cperl-indent-level: 4 
     257#   mode: pir 
    271258#   fill-column: 100 
    272259# End: 
    273 # vim: expandtab shiftwidth=4: 
     260# vim: expandtab shiftwidth=4 ft=pir: