This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #117265] TODO tests for overloading issues
authorTony Cook <tony@develop-help.com>
Mon, 2 Sep 2013 23:05:09 +0000 (09:05 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 9 Sep 2013 05:22:18 +0000 (15:22 +1000)
t/io/open.t

index e170ab6..711c27e 100644 (file)
@@ -10,7 +10,7 @@ $|  = 1;
 use warnings;
 use Config;
 
-plan tests => 145;
+plan tests => 153;
 
 my $Perl = which_perl();
 
@@ -407,19 +407,34 @@ pass("no crash when open autovivifies glob in freed package");
     my ($final_mode, $final_mtime) = (stat $temp)[2, 9];
 
     my $fn = "$temp\0.invalid";
+    my $fno = bless \(my $fn2 = "$temp\0.overload"), "OverloadTest";
     is(open(I, $fn), undef, "open with nul in pathnames since 5.18 [perl #117265]");
     like($WARN, qr/^Invalid \\0 character in pathname for open: $temp_match\\0\.invalid/,
          "warn on embedded nul"); $WARN = '';
-    is (unlink($fn), 0);
-    like($WARN, qr/^Invalid \\0 character in pathname for unlink: $temp_match\\0\.invalid/,
-         "also on unlink"); $WARN = '';
-    is(chmod(0444, $fn), 0);
+    is(open(I, $fno), undef, "open with nul in pathnames since 5.18 [perl #117265] (overload)");
+    like($WARN, qr/^Invalid \\0 character in pathname for open: $temp_match\\0\.overload/,
+         "warn on embedded nul"); $WARN = '';
+
+    is(chmod(0444, $fn), 0, "chmod fails with \\0 in name");
     like($WARN, qr/^Invalid \\0 character in pathname for chmod: $temp_match\\0\.invalid/,
          "also on chmod"); $WARN = '';
-    is (glob($fn), ());
+
+    $TODO = "broken for overloading";
+    is(chmod(0444, $fno), 0, "chmod fails with \\0 in name (overload)");
+    like($WARN, qr/^Invalid \\0 character in pathname for chmod: $temp_match\\0\.overload/,
+         "also on chmod"); $WARN = '';
+    undef $TODO;
+
+    is (glob($fn), undef, "glob fails with \\0 in name");
     like($WARN, qr/^Invalid \\0 character in pattern for glob: $temp_match\\0\.invalid/,
          "also on glob"); $WARN = '';
 
+    $TODO = "broken for overloading";
+    is (glob($fno), undef, "glob fails with \\0 in name (overload)");
+    like($WARN, qr/^Invalid \\0 character in pattern for glob: $temp_match\\0\.overload/,
+         "also on glob"); $WARN = '';
+    undef $TODO;
+
     {
         no warnings 'syscalls';
         $WARN = '';
@@ -446,7 +461,21 @@ pass("no crash when open autovivifies glob in freed package");
         is($!+0, ENOENT, "check errno");
     }
 
+    is (unlink($fn), 0, "unlink fails with \\0 in name");
+    like($WARN, qr/^Invalid \\0 character in pathname for unlink: $temp_match\\0\.invalid/,
+         "also on unlink"); $WARN = '';
+
+    $TODO = "broken for overloading";
+    is (unlink($fno), 0, "unlink fails with \\0 in name (overload)");
+    like($WARN, qr/^Invalid \\0 character in pathname for unlink: $temp_match\\0\.overload/,
+         "also on unlink"); $WARN = '';
+
+    local $TODO = "this is broken for overloading";
     ok(-f $temp, "nothing removed the temp file");
     is((stat $temp)[2], $final_mode, "nothing changed its mode");
     is((stat $temp)[9], $final_mtime, "nothing changes its mtime");
 }
+
+
+package OverloadTest;
+use overload '""' => sub { ${$_[0]} };