Author: jkeenan Date: Sun Jan 11 17:48:40 2009 New Revision: 35430 Modified: trunk/t/library/File_Spec.t trunk/t/library/data_escape.t
Log: Applying patch submitted by Geraud Continsouzas in https://trac.parrot.org/parrot/ticket/160: conversion on tests from Perl 5 (using Parrot::Test) to PIR. Modified: trunk/t/library/File_Spec.t ============================================================================== --- trunk/t/library/File_Spec.t (original) +++ trunk/t/library/File_Spec.t Sun Jan 11 17:48:40 2009 @@ -1,20 +1,14 @@ -#! perl -# Copyright (C) 2001-2008, The Perl Foundation. +#! parrot +# Copyright (C) 2001-2009, The Perl Foundation. # $Id$ -use strict; -use warnings; -use lib qw( t . lib ../lib ../../lib ); -use Test::More; -use Parrot::Test tests => 20; - =head1 NAME -t/library/File-Spec.t - test File::Spec module +t/library/File_Spec.t - test File::Spec module =head1 SYNOPSIS - % prove t/library/File-Spec.t + % prove t/library/File_Spec.t =head1 DESCRIPTION @@ -25,93 +19,87 @@ ############################## # File::Spec -my $PRE = <<'PRE'; -.sub 'main' :main - load_bytecode 'library/File/Spec.pir' - - .local int classtype - .local pmc spec - - spec = new 'File::Spec' - -PRE -my $POST = <<'POST'; - goto OK -NOK: - print "not " -OK: - print "ok" -END: - print "\n" -.end -POST - -## 1 -pir_output_is( <<'CODE'. $POST, <<'OUT', "load_bytecode" ); -.sub 'main' :main - load_bytecode 'File/Spec.pir' -CODE -ok -OUT - -pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', "new" ); -CODE -ok -OUT - -my @meths = ( - qw/ - __isa VERSION devnull tmpdir case_tolerant file_name_is_absolute catfile - catdir path canonpath splitpath splitdir catpath abs2rel rel2abs - / -); -pir_output_is( $PRE . <<"CODE". $POST, <<'OUT', "can ($_)" ) for @meths; - .local pmc meth - \$I0 = can spec, "$_" - unless \$I0, NOK -CODE -ok -OUT - -pir_output_like( $PRE . <<'CODE'. $POST, <<'OUT', "isa" ); - .local pmc class - class= new 'String' - - class= spec.'__isa'() - print class - print "\n" -CODE -/^File::Spec::.+/ -OUT - -pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', "version" ); - .local pmc version - version= spec.'VERSION'() - print version - goto END -CODE -0.1 -OUT - -## testing private subs -pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', "_get_module" ); - .local string module - .local pmc get_module - get_module = get_hll_global [ 'File::Spec' ], '_get_module' - module= get_module( 'MSWin32' ) - print module - print "\n" - module= get_module( 'foobar' ) - print module - goto END -CODE -Win32 -Unix -OUT +.sub main :main + .include 'test_more.pir' + plan(22) + + FS_load_bytecode() + FS_new() + FS_can() + FS_isa() + FS_version() + FS_private_subs() +.end + +.sub FS_load_bytecode + load_bytecode 'File/Spec.pir' + ok(1, 'load_bytecode') +.end + +.sub FS_new + .local pmc spec + + spec = new 'File::Spec' + ok(1, 'new') +.end + +.sub FS_can + .local pmc spec + .local pmc method_list + + $S0 = '__isa VERSION devnull tmpdir case_tolerant file_name_is_absolute ' + $S0 = concat $S0, 'catfile catdir path canonpath splitpath splitdir ' + $S0 = concat $S0, 'catpath abs2rel rel2abs' + method_list = split ' ', $S0 + + spec = new 'File::Spec' + + LOOP: + $I0 = elements method_list + if $I0 == 0 goto END_TEST + $S0 = method_list.'shift'() + $I0 = can spec, $S0 + $S1 = concat 'File::Spec can ', $S0 + ok($I0, $S1) + goto LOOP + + END_TEST: +.end + +.sub FS_isa + .local pmc spec + + spec = new 'File::Spec' + isa_ok(spec, 'File::Spec') + $S0 = spec.'__isa'() + like($S0, "File '::' Spec '::' .+", 'The object isa File::Spec::.+') +.end + +.sub FS_version + .local pmc spec + + spec = new 'File::Spec' + $S0 = spec.'VERSION'() + is($S0, '0.1', 'VERSION 0.1') +.end + +.sub FS_private_subs + .local pmc spec + + spec = new 'File::Spec' + .local string module + .local pmc get_module + get_module = get_hll_global [ 'File::Spec' ], '_get_module' + + module = get_module( 'MSWin32' ) + is(module, 'Win32', 'File::Spec module for MSWin32 is Win32') + + module = get_module( 'foobar' ) + is(module, 'Unix', 'File::Spec module for foobar is Unix') +.end # Local Variables: -# mode: cperl -# cperl-indent-level: 4 +# mode: pir # fill-column: 100 # End: -# vim: expandtab shiftwidth=4: +# vim: expandtab shiftwidth=4 ft=pir: Modified: trunk/t/library/data_escape.t ============================================================================== --- trunk/t/library/data_escape.t (original) +++ trunk/t/library/data_escape.t Sun Jan 11 17:48:40 2009 @@ -1,13 +1,7 @@ -#!perl -# Copyright (C) 2001-2006, The Perl Foundation. +#! parrot +# Copyright (C) 2001-2009, The Perl Foundation. # $Id$ -use strict; -use warnings; -use lib qw( t . lib ../lib ../../lib ); -use Test::More; -use Parrot::Test tests => 22; - =head1 NAME t/library/data_escape.t - Data::Escape tests @@ -18,108 +12,92 @@ =cut -my $lib = 'Data/Escape.pir'; -my $ns = 'Data::Escape'; -my @subs = qw/ String /; - -my $PRE = <<"PRE"; .sub main :main - load_bytecode "$lib" + .include 'test_more.pir' + plan(22) - .local pmc escape_string + DE_load_bytecode() + DE_get_global() + DE_escape_string_empty_string() + DE_escape_string_no_escapes() + DE_escape_string_tab_carriage_return_linefeed() + DE_escape_string_other_characters_less_than_32() + DE_escape_string_single_quote() + DE_escape_string_double_quote() + DE_escape_string_single_and_double_escape_single() + DE_escape_string_single_and_double_escape_double() + DE_escape_string_backslash() + DE_escape_string_unprintable_followed_by_numbers() + DE_escape_string_non_ascii() + DE_escape_string_freeze_a_simple_pmc() + DE_unicode_test() +.end - escape_string = get_global ['$ns'], 'String' -PRE +.sub DE_load_bytecode + load_bytecode 'Data/Escape.pir' + ok(1, 'load_bytecode') +.end + +.sub DE_get_global + .local pmc sub_list, sub_obj + .local string test_message + + $S0 = 'String' + sub_list = split ' ', $S0 + + LOOP: + $I0 = elements sub_list + if $I0 == 0 goto END_TEST + $S0 = sub_list.'shift'() + test_message = concat "get_global ['Data::Escape'], '", $S0 + test_message = concat test_message, "'" + sub_obj = get_global ['Data::Escape'], $S0 + ok(1, test_message) -my $POST = <<'POST'; -NOK: - print "not " -OK: - print "ok" -END: - print "\n" + END_TEST: .end -POST -## 1 -pir_output_is( <<CODE, <<'OUT', "load_bytecode" ); -.sub main :main - load_bytecode "$lib" - goto OK -NOK: - print "not " -OK: - print "ok" -END: - print "\\n" -.end -CODE -ok -OUT - -## get_global tests -for my $sub (@subs) { - pir_output_is( <<CODE, <<'OUT', "get_global ['$sub']" ); -.sub main :main - load_bytecode "$lib" - .local pmc sub - sub = get_global ['$ns'], "$sub" - goto OK -NOK: - print "not " -OK: - print "ok" -END: - print "\\n" -.end -CODE -ok -OUT -} ## end get_global tests +.sub DE_escape_string_empty_string + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: empty string" ); .local string str str = "" str = escape_string( str, '"' ) + is(str, '', 'escape_string: empty string') +.end - print str - goto OK -CODE -ok -OUT +.sub DE_escape_string_no_escapes + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: no escapes" ); .local string str - str = "abc 123" str = escape_string( str, '"' ) + is(str, 'abc 123', 'escape_string: no escapes') +.end - print str - goto END -CODE -abc 123 -OUT +.sub DE_escape_string_tab_carriage_return_linefeed + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: tab, carriage return, linefeed" ); .local string str - str = "a\tb\nc" str = escape_string( str, '"' ) + is(str, 'a\tb\nc', 'escape_string: tab, carriage return, linefeed') +.end - print str - goto END -CODE -a\tb\nc -OUT +.sub DE_escape_string_other_characters_less_than_32 + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<CODE . $POST, <<'OUT', "escape_string: other characters less than 32" ); .local string str, x .local int index index = 0 str = '' -LOOP: + LOOP: if index >= 32 goto DONE x = chr index @@ -128,98 +106,80 @@ inc index branch LOOP -DONE: + DONE: str = escape_string( str, "'" ) + 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') +.end - print str - goto END -CODE -\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 -OUT +.sub DE_escape_string_single_quote + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single quote" ); .local string str - - str = "a'b'c'" + str = "a'b'c" str = escape_string( str, "'" ) + is(str, "a\\'b\\'c", 'escape_string: single quote') +.end - print str - goto END -CODE -a\'b\'c\' -OUT +.sub DE_escape_string_double_quote + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: double quote" ); .local string str - - str = 'a"b"c"' + str = 'a"b"c' str = escape_string( str, '"' ) + is(str, 'a\"b\"c', 'escape_string: double quote') +.end - print str - goto END -CODE -a\"b\"c\" -OUT +.sub DE_escape_string_single_and_double_escape_single + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single double: escape single" ); .local string str - str = "ab\"'\"'c" str = escape_string( str, "'" ) + is(str, "ab\"\\'\"\\'c",'escape_string: single and double, escape single') +.end - print str - goto END -CODE -ab"\'"\'c -OUT +.sub DE_escape_string_single_and_double_escape_double + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single & double: escape double" ); .local string str - str = "ab\"'\"'c" str = escape_string( str, '"' ) + is(str, "ab\\\"'\\\"'c", 'escape_string: single and double, escape double') +.end - print str - goto END -CODE -ab\"'\"'c -OUT +.sub DE_escape_string_backslash + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: backslash" ); .local string str - str = '\ abc \t' str = escape_string( str, '"' ) + is(str, '\\ abc \\t', 'escape_string: backslash') +.end - print str - goto END -CODE -\\ abc \\t -OUT +.sub DE_escape_string_unprintable_followed_by_numbers + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: unprintable followed by numbers" ); .local string str - str = chr 2 concat str, '123' str = escape_string( str, '"' ) + is(str, '\002123', 'escape_string: unprintable followed by numbers') +.end - print str - goto END -CODE -\002123 -OUT - -SKIP: { - skip 'test not written' => 1; - pir_output_is( - $PRE . <<'CODE' . $POST, <<'OUT', "escape_string: non-ascii", todo => 'test not written' ); -CODE -ok -OUT -} +.sub DE_escape_string_non_ascii + todo(0, 'escape_string: non-ascii', 'test not written') +.end + +.sub DE_escape_string_freeze_a_simple_pmc + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' -pir_output_is( $PRE . <<'CODE', <<'OUT', "escape_string: freeze a simple pmc" ); .local pmc original_pmc original_pmc = new 'String' original_pmc = "ok\n" @@ -234,40 +194,67 @@ pir_code = ".sub test :anon\n$P1 = thaw binary:\"" pir_code .= escaped_frozen_pmc - pir_code .= "\"\nprint $P1\n.end\n" + pir_code .= "\"\n.return($P1)\n.e" + # split sub ending to play nice with some editors + pir_code .= "nd\n" .local pmc pir_compiler pir_compiler = compreg "PIR" .local pmc compiled_sub compiled_sub = pir_compiler(pir_code) - compiled_sub() + $P0 = compiled_sub() + is($P0, "ok\n", 'escape_string: freeze a simple pmc') .end -CODE -ok -OUT -my @codes = qw/ 0666 0777 0888 0999 6666 7777 8888 9999/; +.sub _unicode_gen + .param string codepoint + + .local string pir_code + pir_code = ".sub ugen :anon\n$S0 = unicode:\"\\u" + pir_code .= codepoint + pir_code .= "\"\n.return($S0)\n.e" + # split sub ending to play nice with some editors + pir_code .= "nd\n" + + .local pmc pir_compiler, compiled_sub + pir_compiler = compreg "PIR" + compiled_sub = pir_compiler(pir_code) + .tailcall compiled_sub() +.end + +.sub DE_unicode_test + .local pmc escape_string + escape_string = get_global ['Data::Escape'], 'String' + + .local pmc codepoint_list + $S0 = '0666 0777 0888 0999 6666 7777 8888 9999' + codepoint_list = split ' ', $S0 + + .local string s_codepoint, i_codepoint + .local string str, expected, test_message + + LOOP: + $I0 = elements codepoint_list + if $I0 == 0 goto TEST_END + s_codepoint = codepoint_list.'shift'() + $I1 = s_codepoint + i_codepoint = $I1 + + expected = concat "\\x{", i_codepoint + expected .= "}" + test_message = concat "escape_string: unicode: ", s_codepoint + str = _unicode_gen(s_codepoint) -my $unicode_test = $PRE . << 'CODE' . $POST; - .local string str - str = unicode:"\u%s" str = escape_string( str, '"' ) - print str - goto END -CODE - -foreach my $codepoint (@codes) { - pir_output_is( - ( sprintf $unicode_test, $codepoint ), - ( sprintf "\\x{%i}\n", $codepoint ), - "escape_string: unicode: $codepoint" - ); -} + is(str, expected, test_message) + goto LOOP + + TEST_END: +.end # Local Variables: -# mode: cperl -# cperl-indent-level: 4 +# mode: pir # fill-column: 100 # End: -# vim: expandtab shiftwidth=4: +# vim: expandtab shiftwidth=4 ft=pir:
