[svn:parrot] r35430 - trunk/t/library

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:

• [svn:parrot] r35430 - trunk/t/library by jkeenan