m'try it';
s'first part'second part';
s/yet another/tail here/;
- tr/z-Z/z-Z/;
+ tr/A-Z/a-z/;
}
test($out, '_<foo>_'); # 117
test($out2, "_<a\a>_foo_<,\,>_"); # 129
test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
qq oups1
- q second part q tail here s z-Z tr z-Z tr"); # 130
+ q second part q tail here s A-Z tr a-z tr"); # 130
test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq"); # 131
test($res, 1); # 132
test($a, "_<oups
sub new { my ($p, $v) = @_; bless \$v, $p }
sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }
}
-{
+
+# XXX iterator overload not intended to work with CORE::GLOBAL?
+if (defined &CORE::GLOBAL::glob) {
+ test '1', '1'; # 175
+ test '1', '1'; # 176
+ test '1', '1'; # 177
+}
+else {
my $iter = iterator->new(5);
my $acc = '';
my $out;
}, 'deref';
# Hash:
my @cont = sort %$deref;
- test "@cont", '23 5 fake foo'; # 178
+ if ("\t" eq "\011") { # ascii
+ test "@cont", '23 5 fake foo'; # 178
+ }
+ else { # ebcdic alpha-numeric sort order
+ test "@cont", 'fake foo 23 5'; # 178
+ }
my @keys = sort keys %$deref;
test "@keys", 'fake foo'; # 179
my @val = sort values %$deref;
test "@sorted", '22 11 5 2 1'; # 189
# Scalar
test $$deref, 123; # 190
- # Glob
- @sorted = sort $deref 11, 2, 5, 1, 22;
+ # Code
+ @sorted = sort $srt 11, 2, 5, 1, 22;
test "@sorted", '22 11 5 2 1'; # 191
# Array
test "@$deref", '11 12 13'; # 192
$bar->{three} = 13;
test $bar->[3], 13; # 206
+{
+ package B;
+ use overload bool => sub { ${+shift} };
+}
+
+my $aaa;
+{ my $bbbb = 0; $aaa = bless \$bbbb, B }
+
+test !$aaa, 1; # 207
+
+unless ($aaa) {
+ test 'ok', 'ok'; # 208
+} else {
+ test 'is not', 'ok'; # 208
+}
+
+# check that overload isn't done twice by join
+{ my $c = 0;
+ package Join;
+ use overload '""' => sub { $c++ };
+ my $x = join '', bless([]), 'pq', bless([]);
+ main::test $x, '0pq1'; # 209
+};
+
+# Test module-specific warning
+{
+ # check the Odd number of arguments for overload::constant warning
+ my $a = "" ;
+ local $SIG{__WARN__} = sub {$a = $_[0]} ;
+ $x = eval ' overload::constant "integer" ; ' ;
+ test($a eq "") ; # 210
+ use warnings 'overload' ;
+ $x = eval ' overload::constant "integer" ; ' ;
+ test($a =~ /^Odd number of arguments for overload::constant at/) ; # 211
+}
+
+{
+ # check the `$_[0]' is not an overloadable type warning
+ my $a = "" ;
+ local $SIG{__WARN__} = sub {$a = $_[0]} ;
+ $x = eval ' overload::constant "fred" => sub {} ; ' ;
+ test($a eq "") ; # 212
+ use warnings 'overload' ;
+ $x = eval ' overload::constant "fred" => sub {} ; ' ;
+ test($a =~ /^`fred' is not an overloadable type at/); # 213
+}
+
+{
+ # check the `$_[1]' is not a code reference warning
+ my $a = "" ;
+ local $SIG{__WARN__} = sub {$a = $_[0]} ;
+ $x = eval ' overload::constant "integer" => 1; ' ;
+ test($a eq "") ; # 214
+ use warnings 'overload' ;
+ $x = eval ' overload::constant "integer" => 1; ' ;
+ test($a =~ /^`1' is not a code reference at/); # 215
+}
+
+# make sure that we don't inifinitely recurse
+{
+ my $c = 0;
+ package Recurse;
+ use overload '""' => sub { shift },
+ '0+' => sub { shift },
+ 'bool' => sub { shift },
+ fallback => 1;
+ my $x = bless([]);
+ main::test("$x" =~ /Recurse=ARRAY/); # 216
+ main::test($x); # 217
+ main::test($x+0 =~ /Recurse=ARRAY/); # 218
+};
+
# Last test is:
-sub last {206}
+sub last {218}