Bug#733680: I prepared a fix for it.

[Shlomi Fish]

Hi all,

thanks for the investigation - I was wondering why the Spork tests failed. In
any case, I prepared a fix for it at:

https://github.com/ingydotnet/io-all-pm/pull/21

I'm attaching a diff for it.

Just for reference:

<<<<<<<<<<<<<<<<<<<<<<<<<
shlomif@telaviv1:~/IO-All-0.39$ ls -l ; perl -Ilib -MIO::All -e
'io->file("foobar2")->assert->print("foo")' ; ls -l
total 76
-rw-r--r-- 1 shlomif shlomif  3879 Dec 12  2008 Changes
drwxr-xr-x 3 shlomif shlomif  4096 Dec 12  2008 inc
drwxr-xr-x 3 shlomif shlomif  4096 Dec 12  2008 lib
-rw-r--r-- 1 shlomif shlomif   149 Dec 12  2008 Makefile.PL
-rw-r--r-- 1 shlomif shlomif  1298 Feb  3  2008 MANIFEST
-rw-r--r-- 1 shlomif shlomif   378 Dec 12  2008 META.yml
-rw-r--r-- 1 shlomif shlomif 48721 Dec 12  2008 README
drwxr-xr-x 3 shlomif shlomif  4096 Dec 12  2008 t
Useless use of \E at lib/IO/All.pm line 72.
Useless use of \E at lib/IO/All.pm line 80.
Useless use of \E at lib/IO/All.pm line 81.
Can't open file 'foobar2' for output:
Is a directory at -e line 1.
total 80
-rw-r--r-- 1 shlomif shlomif  3879 Dec 12  2008 Changes
drwxr-xr-x 2 shlomif shlomif  4096 Jan  4 12:10 foobar2
drwxr-xr-x 3 shlomif shlomif  4096 Dec 12  2008 inc
drwxr-xr-x 3 shlomif shlomif  4096 Dec 12  2008 lib
-rw-r--r-- 1 shlomif shlomif   149 Dec 12  2008 Makefile.PL
-rw-r--r-- 1 shlomif shlomif  1298 Feb  3  2008 MANIFEST
-rw-r--r-- 1 shlomif shlomif   378 Dec 12  2008 META.yml
-rw-r--r-- 1 shlomif shlomif 48721 Dec 12  2008 README
drwxr-xr-x 3 shlomif shlomif  4096 Dec 12  2008 t
shlomif@telaviv1:~/IO-All-0.39$ 
>>>>>>>>>>>>>>>>>>>>>>>>>

It also happens with perl-5.10.1.

To me it seems like a regression in glibc or the kernel.

Best regards,

        Shlomi Fish

-- 
-----------------------------------------------------------------
Shlomi Fish       http://www.shlomifish.org/
What Makes Software Apps High Quality -  http://shlom.in/sw-quality

In Soviet Russia, superstition believes in you. — Sawyer X

Please reply to list if it's a mailing list post - http://shlom.in/reply .

diff --git a/lib/IO/All.pm b/lib/IO/All.pm
index 6200cbd..b38c6ca 100755
--- a/lib/IO/All.pm
+++ b/lib/IO/All.pm
@@ -771,13 +771,14 @@ sub throw {
 sub assert_dirpath {
     my $self = shift;
     my $dir_name = shift;
-    return $dir_name if -d $dir_name or
-      CORE::mkdir($self->pathname, $self->perms || 0755) or
+    return $dir_name if ((! CORE::length($dir_name)) or
+      -d $dir_name or
+      CORE::mkdir($dir_name, $self->perms || 0755) or
       do {
           require File::Path;
           File::Path::mkpath($dir_name);
       } or
-      $self->throw("Can't make $dir_name");
+      $self->throw("Can't make $dir_name"));
 }
 
 sub assert_open {
diff --git a/t/assert.t b/t/assert.t
index 287afba..b57f669 100644
--- a/t/assert.t
+++ b/t/assert.t
@@ -1,16 +1,37 @@
 use lib 't', 'lib';
 use strict;
 use warnings;
-use Test::More tests => 4;
+use Test::More tests => 8;
 use IO::All;
 use IO_All_Test;
 
+use Cwd qw(getcwd);
+
 ok(not -e o_dir() . '/newpath/hello.txt');
 ok(not -e o_dir() . '/newpath');
+{
 my $io = io(o_dir() . '/newpath/hello.txt')->assert;
 ok(not -e o_dir() . '/newpath');
 "Hello\n" > $io;
 ok(-f o_dir() . '/newpath/hello.txt');
+}
+
+{
+    my $orig_path = getcwd();
+
+    chdir(o_dir() . '/newpath');
+    # Bug http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=733680
+    "Hello" > io->file('foobar')->assert;
+
+    ok( -f 'foobar');
+    is( scalar (-s 'foobar'), 5);
+
+    "12345678" > io->file('./1_8')->assert;
+
+    ok( -f '1_8', "Dot-slash-assert.");
+    is( scalar (-s '1_8'), 8, "Size is 8.");
 
+    chdir($orig_path);
+}
 
 del_output_dir();