Skip to content

Commit

Permalink
Added named arguments to string tests
Browse files Browse the repository at this point in the history
git-svn-id: http://svn.pugscode.org/pugs@25016 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information
frew committed Jan 24, 2009
1 parent 1edfa3f commit c84935c
Show file tree
Hide file tree
Showing 18 changed files with 61 additions and 32 deletions.
3 changes: 2 additions & 1 deletion S29-str/capitalize.t
Expand Up @@ -2,7 +2,7 @@ use v6;

use Test;

plan 11;
plan 12;

# L<S29/Str/capitalize>

Expand All @@ -14,6 +14,7 @@ my $a = "";
is capitalize($a), "", "capitalize empty string";
$a = "puGS Is cOOl!";
is capitalize($a), "Pugs Is Cool!", "capitalize string works";
is capitalize(:string($a)), "Pugs Is Cool!", "capitalize string works with positional argument";
is $a, "puGS Is cOOl!", "original string not touched";
is $a.capitalize, "Pugs Is Cool!", "capitalize string works";
is $a, "puGS Is cOOl!", "original string not touched";
Expand Down
3 changes: 2 additions & 1 deletion S29-str/chomp.t
Expand Up @@ -2,7 +2,7 @@ use v6;

use Test;

plan 31;
plan 32;

=begin pod
Expand All @@ -25,6 +25,7 @@ Basic tests for the chomp() builtin
is($foo, 'foo', 'our variable is chomped correctly');
$foo .= chomp;
is($foo, 'foo', 'our variable is chomped again with no effect');
is(chomp(:string("station\n")), 'station', 'chomp works with a named argument');
}

{
Expand Down
3 changes: 2 additions & 1 deletion S29-str/chop.t
Expand Up @@ -3,14 +3,15 @@ use Test;

# L<S29/Str/"=item chop">

plan 10;
plan 11;

#
# Tests already covered by the specs
#

my $str = "foo";
is(chop($str), "fo", "o removed");
is(chop(:string($str)), "fo", "chop works with named arguments");
is($str, "foo", "original string unchanged");

is($str.chop, "fo", "o removed");
Expand Down
3 changes: 2 additions & 1 deletion S29-str/comb.t
Expand Up @@ -2,7 +2,7 @@ use v6;

use Test;

plan 18;
plan 19;

# L<S29/Str/=item comb>

Expand All @@ -19,6 +19,7 @@ is "a bc d".comb(:limit(2)), <a bc>, 'default matcher with supplied limit';
{
my Str $hair = "Th3r3 4r3 s0m3 numb3rs 1n th1s str1ng";
is $hair.comb(/\d+/), <3 3 4 3 0 3 3 1 1 1>, 'no limit returns all matches';
is comb(:input($hair), /\d+/), <3 3 4 3 0 3 3 1 1 1>, 'comb works with named argument for input';
is $hair.comb(/\d+/, -10), <>, 'negative limit returns no matches';
is $hair.comb(/\d+/, 0), <>, 'limit of 0 returns no matches';
is $hair.comb(/\d+/, 1), <3>, 'limit of 1 returns 1 match';
Expand Down
5 changes: 3 additions & 2 deletions S29-str/index.t
Expand Up @@ -3,7 +3,7 @@ use Test;

# L<S29/Str/"=item index">

plan 35;
plan 36;

# Type of return value
#?rakudo 2 skip 'StrPos not implemented'
Expand Down Expand Up @@ -43,7 +43,7 @@ is(index("Hello", "", 999), 5, "Substr is empty, pos > length of str");

# More difficult strings

is(index("ababcabcd", "abcd"), 5, "Start-of-substr matches several times");
is(index("ababcabcd", "abcd"), 5, "Start-of-substr matches several times");

#?rakudo 2 skip 'unicode'
is(index("uuúuúuùù", "úuù"), 4, "Accented chars");
Expand All @@ -53,6 +53,7 @@ is(index("Ümlaut", "Ü"), 0, "Umlaut");
# call directly with the .notation

is("Hello".index("l"), 2, ".index on string");
is(index(:string('station'), "t"), 1, "index works with named argument");

# work on variables

Expand Down
5 changes: 3 additions & 2 deletions S29-str/lc.t
Expand Up @@ -2,12 +2,13 @@ use v6;

use Test;

plan 12;
plan 13;

# L<S29/Str/lc>

is(lc("hello world"), "hello world", "lowercasing string which is already lowercase");
is(lc("Hello World"), "hello world", "simple lc test");
is(lc(:string("STATION")), "station", "lc works with named argument");
is(lc(""), "", "empty string");
#?rakudo 3 skip 'unicode'
is(lc("ÅÄÖ"), "åäö", "some finnish non-ascii chars");
Expand All @@ -16,7 +17,7 @@ is(lc("ÓÒÚÙ"), "óòúù", "accented chars");
is(lc('A'..'C'), "a b c", "lowercasing char-range");

{
$_ = "Hello World";
$_ = "Hello World";
my $x = .lc;
is($x, "hello world", 'lc uses $_ as default');
}
Expand Down
3 changes: 2 additions & 1 deletion S29-str/lcfirst.t
Expand Up @@ -2,11 +2,12 @@ use v6;

use Test;

plan 8;
plan 9;

# L<S29/Str/lcfirst>

is lcfirst("HELLO WORLD"), "hELLO WORLD", "simple";
is lcfirst(:string('FREW')), 'fREW', 'lcfirst works with named argument';
is lcfirst(""), "", "empty string";
#?rakudo 2 skip 'unicode'
is lcfirst("ÜÜÜÜ"), "üÜÜÜ", "umlaut";
Expand Down
3 changes: 2 additions & 1 deletion S29-str/length.t
Expand Up @@ -15,7 +15,7 @@ L<"http://www.unicode.org/unicode/reports/tr11/">
=end pod

plan 57;
plan 58;

eval_dies_ok('"moose".length', 'Str.length properly not implemented');

Expand All @@ -26,6 +26,7 @@ eval_dies_ok('"moose".length', 'Str.length properly not implemented');
#?rakudo 3 skip '.bytes not implemented'
is("".bytes, 0, "empty string");
is("moose".bytes, 5, "moose");
is(bytes(:string('station')), 7, "bytes works with named argument");
my $x = undef;
dies_ok { $x.bytes }, "undef.bytes fail()s";
# See thread "undef.chars" on p6l started by Ingo Blechschmidt:
Expand Down
13 changes: 7 additions & 6 deletions S29-str/quotemeta.t
Expand Up @@ -4,7 +4,7 @@ use v6;
# NOTES ON PORTING quotemeta.t FROM Perl 5.9.3
#
# 1. The original test suite did include may tests to exercise the
# behaviour in double-quotes interpolation with \Q and \E, and their
# behaviour in double-quotes interpolation with \Q and \E, and their
# interaction with other modification like \L and \U. These
# interpolating sequences no longer exist.
#
Expand All @@ -23,7 +23,7 @@ use v6;
use Test;


plan 11;
plan 12;

# For the moment I don't know how to handle the lack of Config.pm...
# Sorry for ebcdic users!
Expand All @@ -35,9 +35,10 @@ is('Config.pm', 'available', 'Config.pm availability');
# L<S29/Str/quotemeta>

is(quotemeta("HeLLo World-72_1"), "HeLLo\\ World\\-72_1", "simple quotemeta test");
is(quotemeta(:string("fREW => fROOH represents encephelon welkin")), "frew\\ \\=\\>\\ frooh\\ represents\\ encephelon\\ welkin", "quotemeta works with named argument");
is(quotemeta(""), "", "empty string");

$_ = "HeLLo World-72_1";
$_ = "HeLLo World-72_1";
my $x = .quotemeta;
is($x, "HeLLo\\ World\\-72_1", 'quotemeta uses $_ as default');

Expand All @@ -51,7 +52,7 @@ is($x, "HeLLo\\ World\\-72_1", 'quotemeta uses $_ as default');
if (%Config<ebcdic> eq 'define') {
$_ = (129 .. 233).map({ chr($_); }).join('');
is($_.chars, 96, "quotemeta starting string");

# 105 characters - 52 letters = 53 backslashes
# 105 characters + 53 backslashes = 158 characters
$_ = quotemeta $_;
Expand All @@ -62,11 +63,11 @@ if (%Config<ebcdic> eq 'define') {
else {
$_ = (0 .. 255).map({ chr($_); }).join('');
is($_.chars, 256, "quotemeta starting string");

# Original test in Perl 5.9.3:
# 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
# 96 characters + 33 backslashes = 129 characters
#
#
# Then added remaining 32 + 128, all escaped:
# 129 + (32 + 128) * 2 = 449
#
Expand Down
3 changes: 2 additions & 1 deletion S29-str/rindex.t
Expand Up @@ -3,12 +3,13 @@ use Test;

# L<S29/Str/"=item rindex">

plan 32;
plan 33;

# Simple - with just a single char

is(rindex("Hello World", "H"), 0, "One char, at beginning");
is(rindex("Hello World", "l"), 9, "One char, in the middle");
is(rindex(:string("fROOH => fRUE: Robotic Ominous Ossified Herald"), "O"), 2, "rindex works with named argument");
is(rindex("Hello World", "d"), 10, "One char, in the end");
ok(!defined(rindex("Hello World", "x")), "One char, no match");

Expand Down
3 changes: 2 additions & 1 deletion S29-str/sameaccent.t
Expand Up @@ -3,9 +3,10 @@ use Test;

# L<S29/Str/"=item sameaccent">

plan 7;
plan 8;

is(sameaccent('ABb', 'ƗƗƗ'), 'ȺɃƀ', 'sameaccent as a function works');
is(sameaccent(:string('ABb'), 'ƗƗƗ'), 'ȺɃƀ', 'sameaccent works with named argument');

# should this be an exception or a Failure instead?
is(sameaccent('AF', 'ƗƗ'), 'ȺF', 'sameaccent without matching character silently fails');
Expand Down
3 changes: 2 additions & 1 deletion S29-str/samecase.t
Expand Up @@ -9,14 +9,15 @@ Basic test for the samecase() builtin with a string (Str).
=end pod

plan 8;
plan 9;

# As a function
is( samecase('Perl6', 'abcdE'), 'perl6', 'as a function');

# As a method
is( ''.samecase(''), '', 'empty string' );
is( 'Hello World !'.samecase('AbCdEfGhIjKlMnOpQrStUvWxYz'), 'HeLlO WoRlD !', 'literal');
is( samecase(:string( "fRUE => fRIOUX's Rectitude is Underpinned by Equivalence"), 'AbCdEfGhIjKlMnOpQrStUvWxYz'), "FrUe => FrIoUx's rEcTiTuDE is Underpinned by Equivalence", 'samecase works with a named argument');

# On a variable
my Str $a = 'Just another Perl6 hacker';
Expand Down
10 changes: 6 additions & 4 deletions S29-str/split-simple.t
Expand Up @@ -2,7 +2,7 @@ use v6;
use Test;

# L<S29/Str/"=item split">
plan 32;
plan 34;

=begin description
Expand All @@ -13,15 +13,17 @@ here is a start from scratch that should be easier to run.

#?DOES 2
sub split_test(@splitted, @expected, Str $desc) {
ok @splitted.elems == @expected.elems,
ok @splitted.elems == @expected.elems,
"split created the correct value amount for: $desc";
is @splitted.join('|-|'), @expected.join('|-|'),
"values matched for: $desc"
}

split_test 'a1b24f'.split(/\d+/), <a b f>, 'Str.split(/regex/) works';
split_test split(:input('fRIOUX => fiSMBoC RESEARCHES IMAGINATIVE ORGANIC UNIFICATIONS like XUOIRf'),/\s+/), <fRIOUX =\> fiSMBoC RESEARCHES IMAGINATIVE ORGANIC UNIFICATIONS like XUOIRf>, 'split(Rule) works with a named argument';
split_test split(:input('ORGANIC => Original Renditions of Genetic Art Naturally Increasing in Complexity'),' '), <ORGANIC =\> Original Renditions of Genetic Art Naturally Increasing in Complexity>, 'split(Str) works with a named argument';
split_test split(/\d+/, 'a1b24f'), <a b f>, 'split(/regex/, Str) works';
split_test 'a1b'.split(1), <a b>, 'Str.split(Any) works (with Str semantics';
split_test 'a1b'.split(1), <a b>, 'Str.split(Any) works (with Str semantics';
{
split_test 123.split(2), <1 3>, 'Int.split(Int) works';
split_test split(2, 123), <1 3>, 'split(Int, Int) works';
Expand Down Expand Up @@ -53,7 +55,7 @@ split_test(
# zero-width assertions shouldn't loop
# with additional spaces
# a b 3 4 d 5 z split on <before \d>
# ^ ^ ^
# ^ ^ ^
# => result: 'ab', '3', '4d', '5z'
# (confirmed by perl 5)

Expand Down
14 changes: 11 additions & 3 deletions S29-str/split.t
Expand Up @@ -8,7 +8,7 @@ use Test;
# this test really wants is_deeply()
# and got it, except for a couple of cases that fail because of Match objects
# being returned -- Aankhen
plan 27;
plan 29;

# split on an empty string

Expand All @@ -30,9 +30,17 @@ sub split_test(@splitted, @expected, Str $desc) {
is @splitted[$_], @expected[$_],
"the %ords{$_ + 1} value matched for: $desc"
for 0 .. @splitted.end;
is_deeply [~<< @splitted], [~<< @expected], "values match";
is_deeply [~<< @splitted], [~<< @expected], "values match";
}

is_deeply split(:input("fiSMBoC => fREW is Station's Most Bodacious Creation"), " "),
qw/fiSMBoC => fREW is Station's Most Bodacious Creation/,
q{split(:input(Str), " "};

is_deeply split(:input("UNIFICATIONS => Unions Normally Identified From Initial Characters; Aesthetically Tailored to Infer Other Notions Subconsciously"), /\s+/),
qw/UNIFICATIONS => Unions Normally Identified From Initial Characters; Aesthetically Tailored to Infer Other Notions Subconsciously/,
q{split(:input(Str), /\s+/};

is_deeply split("", "forty-two"),
qw/f o r t y - t w o/,
q{split "", Str};
Expand Down Expand Up @@ -127,7 +135,7 @@ is_deeply "abcd".split(/<null>/), <a b c d>,

{
' ' ~~ /(\s)/;

if $0 eq ' ' {
is_deeply "foo bar baz".split(/<prior>/), <foo bar baz>,
q{"foo bar baz".split(/<prior>/)};
Expand Down
3 changes: 2 additions & 1 deletion S29-str/sprintf.t
Expand Up @@ -2,11 +2,12 @@ use v6;

use Test;

plan 41;
plan 42;

# L<S29/Str/"identical to" "C library sprintf">

is sprintf("Hi"), "Hi", "sprintf() works with zero args";
is sprintf(:format("RESEARCH => Robots Eagerly Sailing Epic Artificial Rhythmic Cyclical Homonyms")), "RESEARCH => Robots Eagerly Sailing Epic Artificial Rhythmic Cyclical Homonyms", "sprintf() works with named argument";
is sprintf("%%"), "%", "sprintf() escapes % correctly";
is sprintf("%03d", 3), "003", "sprintf() works with one arg";
is sprintf("%03d %02d", 3, 1), "003 01", "sprintf() works with two args";
Expand Down
6 changes: 5 additions & 1 deletion S29-str/substr.t
Expand Up @@ -2,7 +2,7 @@ use v6;

use Test;

plan 43;
plan 45;

# L<S29/Str/=item substr>

Expand All @@ -15,6 +15,7 @@ plan 43;
is(substr($str, -1), "r", "last char");
is(substr($str, -4, 2), "ob", "counted from the end");
is(substr($str, 1, 2), "oo", "arbitrary middle");
is(substr(:string("IMAGINATIVE => Insane Mimicries of Amazingly Gorgeous, Incomplete Networks, Axiomatic Theorems, and Immortally Vivacious Ecstasy"), 1, 2), "MA", "substr works with named argument");
is(substr($str, 3), "bar", "length omitted");
is(substr($str, 3, 10), "bar", "length goes past end");
ok(!defined(substr($str, 20, 5)), "substr outside of string");
Expand All @@ -36,6 +37,9 @@ plan 43;
substr($str, 2, 1, "i");
is($str, "foibar", "fourth arg to substr replaced part");

substr(:string($str), 2, 1, "a");
is($str, "foabar", "substr with replacement works with named argument");

substr($str, -1, 1, "blah");
is($str, "foibablah", "longer replacement expands string");

Expand Down
7 changes: 4 additions & 3 deletions S29-str/uc.t
Expand Up @@ -2,11 +2,12 @@ use v6;

use Test;

plan 11;
plan 12;

# L<S29/"Str"/=item uc>

is(uc("Hello World"), "HELLO WORLD", "simple");
is(uc(:string("station")), "STATION", "uc with named argument");
is(uc(""), "", "empty string");
#?rakudo skip "unicode"
#?DOES 3
Expand All @@ -31,12 +32,12 @@ is(uc(lc('HELL..')), 'HELL..', "uc/lc test");

## Bug: GERMAN SHARP S ("ß") should uc() to "SS", but it doesn't
## Compare with: perl -we 'use utf8; print uc "ß"'
#
#
# XXX newest Unicode release has an upper-case ß codepoint - please
# clarify if this should be used instead. Commenting the test so far.
#
# Unicode 5.1.0 SpecialCasing.txt has 00DF -> 0053 0053
# nothing maps to 1E9E, the new "capital sharp s"
# nothing maps to 1E9E, the new "capital sharp s"
# so I think this is right -rhr
#?rakudo skip "unicode"
#?DOES 1
Expand Down

0 comments on commit c84935c

Please sign in to comment.