From: Max Maischein <corion@corion.net>
Date: Sun, 19 Aug 2007 23:45:57 +0000 (+0200)
Subject: [patch] File::CheckTree - a side effect of making the build whitespace safe(r)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=96dbb1e1dd7f12c7906d41eefbd872a25777d46c;p=p5sagit%2Fp5-mst-13.2.git

[patch] File::CheckTree - a side effect of making the build whitespace safe(r)
Message-Id: <46C8BA15.3080300@corion.net>

(Applied with some tweaks.)

p4raw-id: //depot/perl@31741
---

diff --git a/lib/File/CheckTree.pm b/lib/File/CheckTree.pm
index 72cc52e..29f05d8 100644
--- a/lib/File/CheckTree.pm
+++ b/lib/File/CheckTree.pm
@@ -87,8 +87,17 @@ sub validate {
         # but earlier versions of File::CheckTree did not do this either
 
         # split a line like "/foo -r || die"
-        # so that $file is "/foo", $test is "-rwx || die"
-        ($file, $test) = split(' ', $check, 2);   # special whitespace split
+        # so that $file is "/foo", $test is "-r || die"
+        # (making special allowance for quoted filenames).
+        if ($check =~ m/^\s*"([^"]+)"\s+(.*?)\s*$/ or
+            $check =~ m/^\s*'([^']+)'\s+(.*?)\s*$/ or
+            $check =~ m/^\s*(\S+?)\s+(\S.*?)\s*$/)
+        {
+            ($file, $test) = ($1,$2);
+        }
+        else {
+            die "Malformed line: '$check'";
+        };
 
         # change a $test like "!-ug || die" to "!-Z || die",
         # capturing the bundled tests (e.g. "ug") in $2
@@ -155,12 +164,12 @@ sub validate {
                 eval $this;
 
                 # re-raise an exception caused by a "... || die" test 
-                if ($@) {
+                if (my $err = $@) {
                     # in case of any cd directives, return from whence we came
                     if ($starting_dir ne cwd) {
                         chdir($starting_dir) || die "$starting_dir: $!";
                     }
-                    die $@ if $@;
+                    die $err;
                 }
             }
 
diff --git a/lib/File/CheckTree.t b/lib/File/CheckTree.t
index e4491d4..1874e5a 100755
--- a/lib/File/CheckTree.t
+++ b/lib/File/CheckTree.t
@@ -7,7 +7,7 @@ BEGIN {
 
 use Test;
 
-BEGIN { plan tests => 6 }
+BEGIN { plan tests => 8 }
 
 use strict;
 
@@ -49,10 +49,11 @@ chdir(File::Spec->updir) or die "cannot change to parent of t/ directory: $!";
             # indented comment, followed blank line (w/o whitespace):
 
             README -f
-            $path_to_README -e || warn
+            '$path_to_README' -e || warn
         };
     };
 
+    print STDERR $_ for @warnings;
     if ( !$@ && !@warnings && defined($num_warnings) && $num_warnings == 0 ) {
         ok(1);
     }
@@ -202,3 +203,39 @@ chdir(File::Spec->updir) or die "cannot change to parent of t/ directory: $!";
         ok(0);
     }
 }
+
+#### TEST 7 -- Quoted file names ####
+{
+    my $num_warnings;
+    eval {
+        $num_warnings = validate q{
+            "a file with whitespace" !-ef
+            'a file with whitespace' !-ef
+        };
+    };
+
+    if ( !$@ ) {
+	# No errors mean we compile correctly
+        ok(1);
+    } else {
+        ok(0);
+	print STDERR $@;
+    };
+}
+
+#### TEST 8 -- Malformed query ####
+{
+    my $num_warnings;
+    eval {
+        $num_warnings = validate q{
+            a file with whitespace !-ef
+        };
+    };
+
+    if ( $@ =~ /syntax error/) {
+	# We got a syntax error for a malformed file query
+        ok(1);
+    } else {
+        ok(0);
+    };
+}