view release on metacpan or  search on metacpan

t/op/chop.t  view on Meta::CPAN

BEGIN {
    chdir 't' if -d 't';
    require './test.pl';
    set_up_inc('../lib');
    require './charset_tools.pl';
}

my $tests_count = 148;
plan tests => $tests_count;

$_ = 'abc';
$c = foo();
is ($c . $_, 'cab', 'optimized');

$_ = 'abc';
$c = chop($_);
is ($c . $_ , 'cab', 'unoptimized');

sub foo {
    chop;
}

@foo = ("hi \n","there\n","!\n");
@bar = @foo;
chop(@bar);
is (join('',@bar), 'hi there!', 'chop list of strings');

$foo = "\n";
chop($foo,@foo);
is (join('',$foo,@foo), 'hi there!', 'chop on list reduces one-character element to an empty string');

$_ = "foo\n\n";
$got = chomp();
is($got, 1, 'check return value when chomp string ending with two newlines; $/ is set to default of one newline');
is ($_, "foo\n", 'chomp string ending with two newlines while $/ is set to one newline' );

$_ = "foo\n";
$got = chomp();
is($got, 1, 'check return value chomp string ending with one newline while $/ is set to a newline');
is ($_, "foo", 'test typical use of chomp; chomp a string ending in a single newline while $/ is set to default of one newline');

$_ = "foo";
$got = chomp();
is($got, 0, 'check return value when chomp a string that does not end with current value of $/, 0 should be returned');
is ($_, "foo", 'chomp a string that does not end with the current value of $/');

$_ = "foo";
$/ = "oo";
$got = chomp();
is ($got, "2", 'check return value when chomp string with $/ consisting of more than one character, and with the ending of the string matching $/');
is ($_, "f", 'chomp a string when $/ consists of two characters that are at the end of the string, check that chomped string contains remnant of original string');

$_ = "bar";
$/ = "oo";
$got = chomp();
is($got, "0", 'check return value when call chomp with $/ consisting of more than one character, and with the ending of the string NOT matching $/');
is ($_, "bar", 'chomp a string when $/ consists of two characters that are NOT at the end of the string');

$_ = "f\n\n\n\n\n";
$/ = "";
$got = chomp();
is ($got, 5, 'check return value when chomp in paragraph mode on string ending with 5 newlines');
is ($_, "f", 'chomp in paragraph mode on string ending with 5 newlines');

$_ = "f\n\n";
$/ = "";
$got = chomp();
is ($got, 2, 'check return value when chomp in paragraph mode on string ending with 2 newlines');
is ($_, "f", 'chomp in paragraph mode on string ending with 2 newlines');

$_ = "f\n";
$/ = "";
$got = chomp();
is ($got, 1, 'check return value when chomp in paragraph mode on string ending with 1 newline');
is ($_, "f", 'chomp in paragraph mode on string ending with 1 newlines');

$_ = "f";
$/ = "";
$got = chomp();
is ($got, 0, 'check return value when chomp in paragraph mode on string ending with no newlines');
is ($_, "f", 'chomp in paragraph mode on string lacking trailing newlines');

$_ = "xx";
$/ = "xx";
$got = chomp();
is ($got, 2, 'check return value when chomp string that consists solely of current value of $/');
is ($_, "", 'chomp on string that consists solely of current value of $/; check that empty string remains');

$_ = "axx";
$/ = "xx";
$got = chomp();
is ($got, 2, 'check return value when chomp string that ends with current value of $/. $/ contains two characters');
is ($_, "a", 'check that when chomp string that ends with currnt value of $/, the part of original string that wasn\'t in $/ remains');

$_ = "axx";
$/ = "yy";
$got = chomp();
is ($got, 0, 'check return value when chomp string that does not end with $/');
is ($_, "axx", 'chomp a string that does not end with $/, the entire string should remain intact');

# This case once mistakenly behaved like paragraph mode.
$_ = "ab\n";
$/ = \3;
$got = chomp();
is ($got, 0, 'check return value when call chomp with $_ = "ab\\n", $/ = \3' );
is ($_, "ab\n", 'chomp with $_ = "ab\\n", $/ = \3' );

# Go Unicode.

$_ = "abc\x{1234}";
chop;
is ($_, "abc", 'Go Unicode');

$_ = "abc\x{1234}d";
chop;
is ($_, "abc\x{1234}");

$_ = "\x{1234}\x{2345}";
chop;
is ($_, "\x{1234}");

my @stuff = qw(this that);
is (chop(@stuff[0,1]), 't');

# bug id 20010305.012 (#5972)
@stuff = qw(ab cd ef);
is (chop(@stuff = @stuff), 'f');

@stuff = qw(ab cd ef);
is (chop(@stuff[0, 2]), 'f');

my %stuff = (1..4);
is (chop(@stuff{1, 3}), '4');

# chomp should not stringify references unless it decides to modify them
$_ = [];
$/ = "\n";
$got = chomp();