Bump version numbers

[perl5.git] / lib / overload.t

diff --git a/lib/overload.t b/lib/overload.t
index f98f0c4..4184e23 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -3,6 +3,11 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require Config;
+    if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
+       print "1..0 # Skip -- Perl configured without List::Util module\n";
+       exit 0;
+    }
 }
 
 package Oscalar;
@@ -41,17 +46,20 @@ sub numify { 0 + "${$_[0]}" }       # Not needed, additional overhead
 
 package main;
 
-$test = 0;
+our $test = 0;
 $| = 1;
 print "1..",&last,"\n";
 
 sub test {
   $test++; 
   if (@_ > 1) {
+    my $comment = "";
+    $comment = " # " . $_ [2] if @_ > 2;
     if ($_[0] eq $_[1]) {
-      print "ok $test\n";
+      print "ok $test$comment\n";
     } else {
-      print "not ok $test: '$_[0]' ne '$_[1]'\n";
+      $comment .= ": '$_[0]' ne '$_[1]'";
+      print "not ok $test$comment\n";
     }
   } else {
     if (shift) {
@@ -729,7 +737,7 @@ else {
   $iter = iterator->new(5);
   test scalar <${iter}>, '5';  # 176
   $acc = '';
-  $acc .= " $out" while $out = <${iter}>;
+  $acc .= " $out" while $out = <$iter>;
   test $acc, ' 4 3 2 1 0';     # 177
 }
 {
@@ -1046,5 +1054,74 @@ $r = Foo->new(0);
 
 test(($r || 0) == 0); # 222
 
+package utf8_o;
+
+use overload 
+  '""'  =>  sub { return $_[0]->{var}; }
+  ;
+  
+sub new
+  {
+    my $class = shift;
+    my $self =  {};
+    $self->{var} = shift;
+    bless $self,$class;
+  }
+
+package main;
+
+
+my $utfvar = new utf8_o 200.2.1;
+test("$utfvar" eq 200.2.1); # 223 - stringify
+test("a$utfvar" eq "a".200.2.1); # 224 - overload via sv_2pv_flags
+
+# 225..227 -- more %{} tests.  Hangs in 5.6.0, okay in later releases.
+# Basically this example implements strong encapsulation: if Hderef::import()
+# were to eval the overload code in the caller's namespace, the privatisation
+# would be quite transparent.
+package Hderef;
+use overload '%{}' => sub { (caller(0))[0] eq 'Foo' ? $_[0] : die "zap" };
+package Foo;
+@Foo::ISA = 'Hderef';
+sub new { bless {}, shift }
+sub xet { @_ == 2 ? $_[0]->{$_[1]} :
+         @_ == 3 ? ($_[0]->{$_[1]} = $_[2]) : undef }
+package main;
+my $a = Foo->new;
+$a->xet('b', 42);
+test ($a->xet('b'), 42);
+test (!defined eval { $a->{b} });
+test ($@ =~ /zap/);
+
+test (overload::StrVal(qr/a/) =~ /^Regexp=SCALAR\(0x[0-9a-f]+\)$/);
+
+{
+   package t229;
+   use overload '='  => sub { 42 },
+                '++' => sub { my $x = ${$_[0]}; $_[0] };
+   sub new { my $x = 42; bless \$x }
+
+   my $warn;
+   {  
+     local $SIG{__WARN__} = sub { $warn++ };
+      my $x = t229->new;
+      my $y = $x;
+      eval { $y++ };
+   }
+   main::test (!$warn);
+}
+
+{
+    my ($int, $out1, $out2);
+    {
+        BEGIN { $int = 0; overload::constant 'integer' => sub {$int++; 17}; }
+        $out1 = 0;
+        $out2 = 1;
+    }
+    test($int,  2,  "#24313"); # 230
+    test($out1, 17, "#24313"); # 231
+    test($out2, 17, "#24313"); # 232
+}
+
 # Last test is:
-sub last {222}
+sub last {232}