[io grant] Fudge .child-secure tests

We'll make .child behave like .child-secure later Discussion: https://irclog.perlgeek.de/perl6-dev/2017-04-17#i_14439386
Raku · Apr 17, 2017 · 7a063b5 · 7a063b5
1 parent 458500d
commit 7a063b5
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 15 deletions.
diff --git a/S32-io/io-path.t b/S32-io/io-path.t
@@ -180,40 +180,44 @@ subtest '.link' => {
     }
 }
 
-subtest '.child-secure' => {
+#?rakudo todo 'wait until 6.d to swap .child to .child-secure'
+#?DOES 1
+{
+subtest 'secureness of .child' => {
     plan 10;
 
     my $parent = make-temp-dir;
     my $non-resolving-parent = make-temp-file.child('bar');
 
-    fails-like { $non-resolving-parent.child-secure('../foo') }, X::IO::Resolve,
+    fails-like { $non-resolving-parent.child('../foo') }, X::IO::Resolve,
         'non-resolving parent fails (given path is non-child)';
 
-    fails-like { $non-resolving-parent.child-secure('foo') }, X::IO::Resolve,
+    fails-like { $non-resolving-parent.child('foo') }, X::IO::Resolve,
         'non-resolving parent fails (given path is child)';
 
-    fails-like { $parent.child-secure('foo/bar') }, X::IO::Resolve,
+    fails-like { $parent.child('foo/bar') }, X::IO::Resolve,
         'resolving parent fails (given path is a child, but not resolving)';
 
-    fails-like { $parent.child-secure('../foo') }, X::IO::NotAChild,
+    fails-like { $parent.child('../foo') }, X::IO::NotAChild,
         'resolved parent fails (given path is not a child)';
 
-    is-path $parent.child-secure('foo'), $parent.child('foo'),
+    is-path $parent.child('foo'), $parent.child('foo'),
         'resolved parent with resolving, non-existent child';
 
-    $parent.child-secure('foo').mkdir;
-    is-path $parent.child-secure('foo'), $parent.child('foo'),
+    $parent.child('foo').mkdir;
+    is-path $parent.child('foo'), $parent.child('foo'),
         'resolved parent with resolving, existent child';
 
-    is-path $parent.child-secure('foo/bar'), $parent.child('foo/bar'),
+    is-path $parent.child('foo/bar'), $parent.child('foo/bar'),
         'resolved parent with resolving, existent child in a subdir';
 
-    is-path $parent.child-secure('foo/../bar'), $parent.child('bar'),
+    is-path $parent.child('foo/../bar'), $parent.child('bar'),
         'resolved parent with resolving, non-existent child, with ../';
 
-    fails-like { $parent.child-secure('foo/../../bar') }, X::IO::NotAChild,
+    fails-like { $parent.child('foo/../../bar') }, X::IO::NotAChild,
         'resolved parent fails (given path is not a child, via child + ../)';
 
-    fails-like { $parent.child-secure("../\x[308]") }, X::IO::NotAChild,
+    fails-like { $parent.child("../\x[308]") }, X::IO::NotAChild,
         'resolved parent fails (given path is not a child, via combiners)';
 }
+}
diff --git a/S32-io/null-char.t b/S32-io/null-char.t
@@ -6,7 +6,7 @@ use Test::Util;
 # Tests for ensuring NUL byte is rejected from paths
 constant @nuls = ("\0foobar", "foo\0bar", "foobar\0", "\0foo\0bar\0");
 
-plan 7*@nuls;
+plan 6*@nuls;
 
 {
     temp $*CWD = make-temp-dir;
@@ -17,9 +17,8 @@ plan 7*@nuls;
         throws-like { chdir $nul          }, X::IO::Null, "&chdir $d";
         throws-like { $nul.IO             }, X::IO::Null, ".IO $d";
         throws-like { IO::Path.new: $nul  }, X::IO::Null, "IO::Path.new $d";
+        #?rakudo todo 'wait until 6.d to swap .child to .child-secure'
         throws-like { $*CWD.child: $nul   }, X::IO::Null, ".child $d";
-        throws-like { $*CWD.child-secure: $nul }, X::IO::Null,
-            ".child-secure $d";
     }
 }