Author: particle
Date: Wed Sep 28 15:27:42 2005
New Revision: 9265
Modified:
trunk/runtime/parrot/library/Data/Escape.imc
trunk/t/library/data_escape.t
Log:
update Data::Escape to escape backslash. tests updated as well
Modified: trunk/runtime/parrot/library/Data/Escape.imc
==============================================================================
--- trunk/runtime/parrot/library/Data/Escape.imc (original)
+++ trunk/runtime/parrot/library/Data/Escape.imc Wed Sep 28 15:27:42 2005
@@ -51,85 +51,85 @@ This function returns the quoted string.
.namespace ["Data::Escape"]
+
.sub String
.param string str
- .param string char
- .local string ret
- .local int i
- .local int j
- .local int c
- .local string tmp
-
- i = 0
- j = length str
- ret = ""
-LOOP:
- if i >= j goto END
- tmp = str[i]
- ord c, tmp
-
- if c > 40 goto gt40
- if c > 31 goto gt31
-
- if c > 0 goto n00
- set tmp, "\\0"
- branch DONE
-n00:
-
- # \t
- if c != 9 goto n09
- set tmp, "\\t"
- branch DONE
-n09:
-
- # \n
- if c != 10 goto n10
- set tmp, "\\n"
- branch DONE
-n10:
+ .param string quote_char
- # \r
- if c != 13 goto n13
- set tmp, "\\r"
- branch DONE
-n13:
-
- # encode the value as an octal number
- tmp = "\\"
- $P0 = new .PerlArray
- push $P0, c
- $S0 = sprintf "%o", $P0
- concat tmp, $S0
- branch DONE
-
-gt31: # ascii codes greater than 31 below
+ .local string return
+ .local int index
+ .local int str_len
+ .local int test_char_ord
+ .local int quote_char_ord
+ .local int is_alphanum
+ .local string tmp
+ .local int mask
- # "
- ne char, '"', n34
- if c != 34 goto n34
- set tmp, "\\\""
- branch DONE
-n34:
+ .include 'cclass.pasm'
- # '
- ne char, "'", n39
- if c != 34 goto n39
- set tmp, "\\'"
- branch DONE
-n39:
+ mask = .CCLASS_ALPHANUMERIC
-gt40: # ascii codes greater than 40 below
+ index = 0
+ str_len = length str
+ return = ''
+LOOP:
+ if index >= str_len goto END
- if c != 92 goto DONE
- set tmp, "\\\\"
+ tmp = str[index]
+ is_alphanum = is_cclass mask, tmp, 0
+ if is_alphanum, DONE
+
+ ord test_char_ord, tmp
+
+ ## allow spaces as is
+ if 32 == test_char_ord goto DONE
+
+t_backslash:
+ ## escape backslash to double backslash
+ if 92 != test_char_ord goto t_newline
+ tmp = '\\'
+ branch DONE
+
+t_newline:
+ ## escape newline to \n
+ if 10 != test_char_ord goto t_tab
+ tmp = '\n'
+ branch DONE
+
+t_tab:
+ ## escape tab to \t
+ if 9 != test_char_ord goto t_quote
+ tmp = '\t'
+ branch DONE
+
+t_quote:
+ ## escape quote character
+ ord quote_char_ord, quote_char
+
+ if quote_char_ord == test_char_ord goto escape_quote_char
+ if 34 == test_char_ord goto DONE
+ if 39 == test_char_ord goto DONE
+ branch default
+
+escape_quote_char:
+ tmp = '\'
+ concat tmp, quote_char
+ branch DONE
+
+default:
+ ## otherwise encode the value as an octal number
+ .local pmc char
+ $P0 = new .ResizableIntegerArray
+ push $P0, test_char_ord
+ tmp = sprintf "\\%o", $P0
branch DONE
DONE:
- concat ret, tmp
- inc i
+ concat return, tmp
+ inc index
branch LOOP
END:
- .return(ret)
+ .return( return )
.end
=back
@@ -140,6 +140,10 @@ Jens Rieks E<lt>parrot at jensbeimsurfen
and maintainer.
Please send patches and suggestions to the Perl 6 Internals mailing list.
+=head1 HISTORY
+
+Modifications by Jerry Gay to escape backslash and use character class ops.
+
=head1 COPYRIGHT
Copyright (c) 2004, the Perl Foundation.
Modified: trunk/t/library/data_escape.t
==============================================================================
--- trunk/t/library/data_escape.t (original)
+++ trunk/t/library/data_escape.t Wed Sep 28 15:27:42 2005
@@ -16,27 +16,42 @@ use strict;
use Parrot::Test;
-my $lib= 'Data/Escape.pbc';
+my $lib= 'Data/Escape.imc';
my $ns= 'Data::Escape';
my @subs= qw/ String /;
my $PRE=<<PRE;
.sub main [EMAIL PROTECTED]
load_bytecode "$lib"
+
+ .local pmc escape_string
+
+ escape_string = find_global "$ns", 'String'
PRE
-my $POST=<<POST;
+my $POST=<<'POST';
NOK:
print "not "
OK:
- print "ok\\n"
+ print "ok"
END:
+ print "\n"
.end
POST
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "load_bytecode");
+## 1
+pir_output_is(<<CODE, <<'OUT', "load_bytecode");
+.sub main [EMAIL PROTECTED]
+ load_bytecode "$lib"
goto OK
+NOK:
+ print "not "
+OK:
+ print "ok"
+END:
+ print "\\n"
+.end
CODE
ok
OUT
@@ -45,94 +60,139 @@ OUT
## find_global tests
for my $sub ( @subs )
{
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "find_global '$sub'");
+pir_output_is(<<CODE, <<'OUT', "find_global '$sub'");
+.sub main [EMAIL PROTECTED]
+ load_bytecode "$lib"
.local pmc sub
sub = find_global "$ns", "$sub"
goto OK
+NOK:
+ print "not "
+OK:
+ print "ok"
+END:
+ print "\\n"
+.end
CODE
ok
OUT
} ## end find_global tests
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: empty string");
- .local pmc escape_string
+pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: empty string");
.local string str
-
- escape_string = find_global "$ns", 'String'
-
str = ""
- str = escape_string( str, "'" )
+ str = escape_string( str, '"' )
print str
- print "\\n"
- goto END
+ goto OK
CODE
-
+ok
OUT
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: no escapes");
- .local pmc escape_string
+pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: no escapes");
.local string str
- escape_string = find_global "$ns", 'String'
-
str = "abc 123"
- str = escape_string( str, "'" )
+ str = escape_string( str, '"' )
print str
- print "\\n"
goto END
CODE
abc 123
OUT
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: tab, carriage
return, linefeed");
- .local pmc escape_string
+pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: tab, carriage
return, linefeed");
.local string str
- escape_string = find_global "$ns", 'String'
-
- str = "a\\tb\\nc\\r"
- str = escape_string( str, "'" )
+ str = "a\tb\nc"
+ str = escape_string( str, '"' )
print str
- print "\\n"
goto END
CODE
-a\tb\nc\r
+a\tb\nc
OUT
SKIP: {
- skip 'tests not written' => 5;
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: other characters
less than 31", todo => 'test not written' );
+ skip 'tests not written' => 1;
+pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: other characters
less than 32", todo => 'test not written' );
CODE
ok
OUT
+}
+pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single quote"
);
+ .local string str
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: single quote",
todo => 'test not written' );
+ str = "a'b'c'"
+ str = escape_string( str, "'" )
+
+ print str
+ goto END
CODE
-ok
+a\'b\'c\'
OUT
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: double quote",
todo => 'test not written' );
+pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: double quote"
);
+ .local string str
+
+ str = 'a"b"c"'
+ str = escape_string( str, '"' )
+
+ print str
+ goto END
CODE
-ok
+a\"b\"c\"
OUT
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: ascii", todo =>
'test not written' );
+pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single
double: escape single" );
+ .local string str
+
+ str = "ab\"'\"'c"
+ str = escape_string( str, "'" )
+
+ print str
+ goto END
CODE
-ok
+ab"\'"\'c
OUT
-pir_output_is($PRE . <<CODE . $POST, <<'OUT', "escape_string: non-ascii", todo
=> 'test not written' );
+pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: single &
double: escape double" );
+ .local string str
+
+ str = "ab\"'\"'c"
+ str = escape_string( str, '"' )
+
+ print str
+ goto END
+CODE
+ab\"'\"'c
+OUT
+
+
+pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: backslash" );
+ .local string str
+
+ str = '\ abc \t'
+ str = escape_string( str )
+
+ print str
+ goto END
+CODE
+\\ abc \\t
+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
@@ -142,9 +202,6 @@ OUT
SKIP: {
skip 'currently causes bus error' => 1;
pir_output_is($PRE . <<'CODE' . $POST, <<'OUT', "escape_string: freeze a
simple pmc" );
- .local pmc escaper # I hardly know'er
- escaper = find_global "Data::Escape", "String"
-
.local pmc original_pmc
original_pmc = new String
original_pmc = "ok"
@@ -153,7 +210,7 @@ pir_output_is($PRE . <<'CODE' . $POST, <
frozen_pmc = freeze original_pmc
.local string escaped_frozen_pmc
- escaped_frozen_pmc = escaper(frozen_pmc)
+ escaped_frozen_pmc = escape_string( frozen_pmc, '"' )
.local string pir_code
pir_code = ".sub test @ANON\n$P1 = thaw \"%s\"\nprint $P1\n.end\n"
@@ -177,6 +234,6 @@ OUT
}
## don't forget to change the number of tests!
-BEGIN { plan tests => 11; }
+BEGIN { plan tests => 13; }
# vim: ft=imc :
