Merge pull request dland#2 from tommylutz/fix-bug-53178

Fix bug 53178: object treated as named arguments

Author: rpcme

Path.pm

@@ -58,13 +58,23 @@ sub _error {
     }
 }
 
+sub __is_arg {
+    my ($arg) = @_;
+    # If client code blessed an array ref to HASH, this will not work
+    # properly. We could have done $arg->isa() wrapped in eval, but
+    # that would be expensive. This implementation should suffice.
+    # We could have also used Scalar::Util:blessed, but we choose not
+    # to add this dependency
+    return (ref $arg eq 'HASH');
+}
+
 sub make_path {
-    push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
+    push @_, {} unless @_ and __is_arg($_[-1]);
     goto &mkpath;
 }
 
 sub mkpath {
-    my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
+    my $old_style = !(@_ and __is_arg($_[-1]));
 
     my $arg;
     my $paths;
@@ -162,7 +172,7 @@ sub _mkpath {
 }
 
 sub remove_tree {
-    push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
+    push @_, {} unless @_ and __is_arg($_[-1]);
     goto &rmtree;
 }
 
@@ -185,7 +195,7 @@ sub _is_subdir {
 }
 
 sub rmtree {
-    my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
+    my $old_style = !(@_ and __is_arg($_[-1]));
 
     my $arg;
     my $paths;

t/Path-Class.t

@@ -0,0 +1,49 @@
+use strict;
+use warnings;
+use Test::More;
+
+eval "require Path::Class";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+use File::Path qw(remove_tree make_path);
+Path::Class->import;
+
+my $name = 'test';
+my $dir = dir($name);
+
+sub test {
+  my ($dir, $pass_arg) = @_;
+
+  my $args = [ $dir, ($pass_arg ? {} : ()) ];
+  my $desc = sprintf(
+    'dir isa %s, second arg is %s',
+    (ref($dir) || 'string'),
+    ($pass_arg ? '{}' : 'not passed')
+  );
+
+  return ($args, $desc);
+}
+
+for my $mk_dir ($name, dir($name)) {
+  for my $mk_pass_arg (0, 1) {
+
+    for my $rm_dir ($name, dir($name)) {
+      for my $rm_pass_arg (0, 1) {
+        remove_tree($name) if -e $name;
+
+        my ($mk_args, $mk_desc) = test($mk_dir, $mk_pass_arg);
+        make_path(@$mk_args);
+
+        if (ok( -d $dir, "we made $dir ($mk_desc)")) {
+          my ($rm_args, $rm_desc) = test($rm_dir, $rm_pass_arg);
+          remove_tree(@$rm_args);
+          ok( ! -d $dir, "...then we removed $dir ($rm_desc)");
+        } else {
+          fail("...can't remove it if we didn't create it");
+        }
+      }
+    }
+  }
+}
+
+done_testing;