[svk-commit] r2269 - in trunk: . lib/SVK lib/SVK/Editor lib/SVK/Mirror/Backend t t/mirror

nobody at bestpractical.com nobody at bestpractical.com
Sun Dec 24 12:16:42 EST 2006


Author: clkao
Date: Sun Dec 24 12:16:40 2006
New Revision: 2269

Modified:
   trunk/   (props changed)
   trunk/CHANGES
   trunk/lib/SVK/Config.pm
   trunk/lib/SVK/Editor/Diff.pm
   trunk/lib/SVK/Mirror/Backend/SVNRa.pm
   trunk/lib/SVK/Mirror/Backend/SVNSync.pm
   trunk/lib/SVK/Path/Checkout.pm
   trunk/lib/SVK/Test.pm
   trunk/lib/SVK/Version.pm
   trunk/t/07smerge-copy-co.t
   trunk/t/11checkout.t
   trunk/t/19cleanup.t
   trunk/t/22status-conflict.t
   trunk/t/24diff.t
   trunk/t/33prop.t
   trunk/t/75hook.t
   trunk/t/77floating.t
   trunk/t/mirror/sync-failed-hook.t
   trunk/t/mirror/sync-replaced.t

Log:
Merge win32 test fixes to trunk.


Modified: trunk/CHANGES
==============================================================================
--- trunk/CHANGES	(original)
+++ trunk/CHANGES	Sun Dec 24 12:16:40 2006
@@ -1,4 +1,4 @@
-[Changes for 2.0.0 - ? ???, 2006]
+[Changes for 2.0.0 - 24 Dec, 2006]
 
   Dependency
     * Require Subversion 1.3.0

Modified: trunk/lib/SVK/Config.pm
==============================================================================
--- trunk/lib/SVK/Config.pm	(original)
+++ trunk/lib/SVK/Config.pm	Sun Dec 24 12:16:40 2006
@@ -89,10 +89,10 @@
 
 sub svnconfig {
     my $class = shift;
-    return undef if $ENV{SVKNOSVNCONFIG};
-
     return $class->_svnconfig if $class->_svnconfig;
 
+    return undef if $ENV{SVKNOSVNCONFIG};
+
     SVN::Core::config_ensure(undef);
     return $class->_svnconfig( SVN::Core::config_get_config(undef, $pool) );
 }

Modified: trunk/lib/SVK/Editor/Diff.pm
==============================================================================
--- trunk/lib/SVK/Editor/Diff.pm	(original)
+++ trunk/lib/SVK/Editor/Diff.pm	Sun Dec 24 12:16:40 2006
@@ -92,7 +92,7 @@
     my ($self, $from_path) = @_;
 
     my $repospath_start = "file://" . $self->{base_target}->repospath;
-    $from_path =~ s/^$repospath_start//;
+    $from_path =~ s/^\Q$repospath_start//;
 
     return $from_path;
 }

Modified: trunk/lib/SVK/Mirror/Backend/SVNRa.pm
==============================================================================
--- trunk/lib/SVK/Mirror/Backend/SVNRa.pm	(original)
+++ trunk/lib/SVK/Mirror/Backend/SVNRa.pm	Sun Dec 24 12:16:40 2006
@@ -58,6 +58,7 @@
 use SVK::Editor;
 use SVK::Mirror::Backend::SVNRaPipe;
 use SVK::Editor::MapRev;
+use SVK::Util 'IS_WIN32';
 
 use Class::Autouse qw(SVK::Editor::SubTree SVK::Editor::CopyHandler);
 
@@ -89,6 +90,14 @@
 
 =cut
 
+sub new {
+    my ( $class, $args ) = @_;
+    unless ( defined $args->{use_pipeline} ) {
+        $args->{use_pipeline} = IS_WIN32 ? 0 : 1;
+    }
+    return $class->SUPER::new($args);
+}
+
 sub _do_load_fromrev {
     my $self = shift;
     my $fs = $self->mirror->repos->fs;
@@ -104,7 +113,7 @@
 
 sub load {
     my ($class, $mirror) = @_;
-    my $self = $class->SUPER::new( { mirror => $mirror, use_pipeline => 1 } );
+    my $self = $class->new( { mirror => $mirror } );
     my $t = $mirror->get_svkpath;
     die loc( "%1 is not a mirrored path.\n", $t->depotpath )
         unless $t->root->check_path( $mirror->path );
@@ -135,7 +144,7 @@
 sub create {
     my ($class, $mirror, $backend, $args, $txn, $editor) = @_;
 
-    my $self = $class->SUPER::new({ mirror => $mirror, use_pipeline => 1 });
+    my $self = $class->new({ mirror => $mirror });
 
     my $ra = $self->_new_ra;
 

Modified: trunk/lib/SVK/Mirror/Backend/SVNSync.pm
==============================================================================
--- trunk/lib/SVK/Mirror/Backend/SVNSync.pm	(original)
+++ trunk/lib/SVK/Mirror/Backend/SVNSync.pm	Sun Dec 24 12:16:40 2006
@@ -60,7 +60,7 @@
 
 sub load {
     my ( $class, $mirror ) = @_;
-    my $self = $class->SUPER::new( { mirror => $mirror, use_pipeline => 1 } );
+    my $self = $class->new( { mirror => $mirror } );
     my $fs = $mirror->depot->repos->fs;
     $mirror->url( $fs->revision_prop( 0,         'svn:svnsync:from-url' ) );
     $mirror->server_uuid( $fs->revision_prop( 0, 'svn:svnsync:from-uuid' ) );

Modified: trunk/lib/SVK/Path/Checkout.pm
==============================================================================
--- trunk/lib/SVK/Path/Checkout.pm	(original)
+++ trunk/lib/SVK/Path/Checkout.pm	Sun Dec 24 12:16:40 2006
@@ -106,8 +106,10 @@
     my (undef, $coroot) = $self->xd->{checkout}->get($copath, 1);
     Carp::cluck $copath.YAML::Syck::Dump($self->xd->{checkout}) unless $coroot;
     my @paths = $self->xd->{checkout}->find($coroot, {revision => qr'.*'});
-    my $tmp = $copath;
-    $tmp =~ s/^\Q$coroot//;
+
+    my $tmp = $self->_to_pclass($copath)->relative($coroot)->as_foreign('Unix')->absolute('/');
+    $tmp = '' if $tmp eq '/';
+
     my $coroot_path = $self->path;
     $coroot_path =~ s/\Q$tmp\E$// or return $self->source->root;
     $coroot_path = '/' unless length $coroot_path;

Modified: trunk/lib/SVK/Test.pm
==============================================================================
--- trunk/lib/SVK/Test.pm	(original)
+++ trunk/lib/SVK/Test.pm	Sun Dec 24 12:16:40 2006
@@ -71,7 +71,7 @@
 		 not_l uri set_editor replace_file glob_mime_samples
 		 create_mime_samples chmod_probably_useless
 
-		 catdir HAS_SVN_MIRROR IS_WIN32
+		 catdir HAS_SVN_MIRROR IS_WIN32 install_perl_hook
 
 		 rmtree mkpath @TOCLEAN $output $answer $show_prompt);
 
@@ -608,6 +608,22 @@
     return $^O eq 'MSWin32' || Cwd::cwd() =~ m!^/afs/!;
 }
 
+sub install_perl_hook {
+    my ($repospath, $hook, $content) = @_;
+    $hook = "$repospath/hooks/$hook".(IS_WIN32 ? '.bat' : '');
+    open my $fh, '>', $hook or die $!;
+    if (IS_WIN32) {
+        print $fh "\@rem = '--*-Perl-*--\n";
+        print $fh '@echo off'."\n$^X".' -x -S %0 %*'."\n";
+        print $fh 'if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul'."\n";
+	print $fh "goto endofperl\n\@rem ';\n";
+    }
+    print $fh "#!$^X\n" . $content;
+    print $fh "\n__END__\n:endofperl\n" if IS_WIN32;
+    chmod(0755, $hook);
+    return $hook;
+}
+
 END {
     return unless $$ == $pid;
     unlink $_ for @unlink;

Modified: trunk/lib/SVK/Version.pm
==============================================================================
--- trunk/lib/SVK/Version.pm	(original)
+++ trunk/lib/SVK/Version.pm	Sun Dec 24 12:16:40 2006
@@ -50,7 +50,7 @@
 # END BPS TAGGED BLOCK }}}
 package SVK;
 
-our $VERSION = '1.99_05';
+our $VERSION = '1.99_90';
 
 =head1 NAME
 

Modified: trunk/t/07smerge-copy-co.t
==============================================================================
--- trunk/t/07smerge-copy-co.t	(original)
+++ trunk/t/07smerge-copy-co.t	Sun Dec 24 12:16:40 2006
@@ -5,7 +5,6 @@
 use Cwd;
 use SVK::Test;
 
-
 my ($xd, $svk) = build_test();
 our $output;
 my ($copath, $corpath) = get_copath ('smerge-copy-co');
@@ -22,11 +21,12 @@
 	   ['Auto-merging (3, 5) /trunk to /local (base /trunk:3).',
 	    'A + A-cp',
 	    qr'New merge ticket: .*:/trunk:5']);
-
+TODO: {
+local $TODO = 'defult layers should be applied to editor::xd files added with history' if IS_WIN32;
 is_output ($svk, 'st', [],
 	   ['A + A-cp',
 	    ' M  .']);
-
+}
 is_output ($svk, 'ci', [-m => 'commit the smerge from checkout'],
 	   ['Committed revision 6.']);
 

Modified: trunk/t/11checkout.t
==============================================================================
--- trunk/t/11checkout.t	(original)
+++ trunk/t/11checkout.t	Sun Dec 24 12:16:40 2006
@@ -341,7 +341,7 @@
 
 chdir($corpath);
 rename("$corpath/co-root-deep/there", "$corpath/tmp");
-unlink("$corpath/co-root-deep");
+rmtree ["$corpath/co-root-deep"] or die $!;
 rename("$corpath/tmp", "$corpath/co-root-deep");
 
 is_output ($svk, 'checkout', ['--relocate', __("$corpath/co-root-deep/there"), __("$corpath/co-root-deep")], [

Modified: trunk/t/19cleanup.t
==============================================================================
--- trunk/t/19cleanup.t	(original)
+++ trunk/t/19cleanup.t	Sun Dec 24 12:16:40 2006
@@ -2,6 +2,7 @@
 use Test::More tests => 15;
 use strict;
 use SVK::Test;
+use SVK::Util 'IS_WIN32';
 require Storable;
 
 my ($xd, $svk) = build_test();
@@ -15,7 +16,10 @@
 $xd->{giantlock} = __("$repospath/svk.giant");
 
 $xd->giant_lock;
+SKIP: {
+skip 'lock prevents file being read on win32', 1 if IS_WIN32;
 is_file_content ($xd->{giantlock}, $$, 'giant locked');
+}
 ok ($xd->{giantlock_handle}, 'giant locked');
 $xd->store;
 ok ($xd->{updated}, 'marked as updated');

Modified: trunk/t/22status-conflict.t
==============================================================================
--- trunk/t/22status-conflict.t	(original)
+++ trunk/t/22status-conflict.t	Sun Dec 24 12:16:40 2006
@@ -29,7 +29,7 @@
 
 is_output($svk, 'st', [],
 	  ['C   A',
-	   'C   A/something']);
+	   __('C   A/something')]);
 
 is_output($svk, 'up', [],
 	  ['Syncing //(/) in '.__($corpath).' to 1.',

Modified: trunk/t/24diff.t
==============================================================================
--- trunk/t/24diff.t	(original)
+++ trunk/t/24diff.t	Sun Dec 24 12:16:40 2006
@@ -374,10 +374,12 @@
 $svk->cp ('-m', 'blah', '//B', '//A/B-cp');
 $svk->cp ('//A', 'C');
 append_file ("C/foo", "copied and modified on C\n");
+TODO: {
+local $TODO = 'path sep issues on win32' if IS_WIN32;
 is_output($svk, 'diff', ['C'],
-	  [__("=== C\t(new directory; copied from /A\@5)"),
+	  [__("=== C\t(new directory; copied from ").'/A at 5)',
 	    '==================================================================',
-           __("=== C/foo\t(copied from /A/foo\@5)"),
+           __("=== C/foo\t(copied from ").'/A/foo at 5)',
 	   '==================================================================',
 	   __("--- C/foo\t(revision 4)"),
 	   __("+++ C/foo\t(local)"),
@@ -479,7 +481,7 @@
 	    '+newline',
 	    '+fnord',
 	    '+copied and modified on C']);
-
+}
 $svk->revert ('-R', '.');
 $svk->resolved ('-R', '.');
 $svk->update;

Modified: trunk/t/33prop.t
==============================================================================
--- trunk/t/33prop.t	(original)
+++ trunk/t/33prop.t	Sun Dec 24 12:16:40 2006
@@ -59,7 +59,7 @@
 is_output ($svk, 'pg', ['myprop', "$copath/A"],
 	   ['myvalue']);
 is_output ($svk, 'pg', [-R => 'myprop', "$copath"],
-	   ['t/checkout/prop/A - myvalue']);
+	   [__('t/checkout/prop/A - myvalue')]);
 
 $svk->commit ('-m', 'commit', $copath);
 

Modified: trunk/t/75hook.t
==============================================================================
--- trunk/t/75hook.t	(original)
+++ trunk/t/75hook.t	Sun Dec 24 12:16:40 2006
@@ -17,11 +17,7 @@
 
 # install pre-commit hook
 
-my $hook = "$srepospath/hooks/pre-commit".($^O eq 'MSWin32' ? '.bat' : '');
-open FH, '>', $hook or die "$hook: $!";
-print FH ($^O eq 'MSWin32' ? '@echo off' : "#!$^X") . "\nwarn \"foo\\n\";\nexit 1\n";
-close FH;
-chmod (0755, $hook);
+my $hook = install_perl_hook($srepospath, 'pre-commit', "warn \"foo\\n\";\nexit 1\n");
 
 my ($repospath, undef, $repos) = $xd->find_repos ('//', 1);
 
@@ -41,5 +37,4 @@
 	    qr"A repository hook failed: 'pre-commit' hook failed .* error output.*:",
 	    'foo', ''
 	   ]);
-
 1;

Modified: trunk/t/77floating.t
==============================================================================
--- trunk/t/77floating.t	(original)
+++ trunk/t/77floating.t	Sun Dec 24 12:16:40 2006
@@ -35,9 +35,8 @@
 my $loaded = LoadFile("$copath/.svk/config");
 ok(ref($loaded->{checkout}) eq "Data::Hierarchy::Relative",
    'stored config is relative');
-my $checkout = $loaded->{checkout}->to_absolute('/nowhere');
-ok(exists $checkout->get("/nowhere/A/foo")->{revision}, 'relative lookup');
-
+my $checkout = $loaded->{checkout}->to_absolute(Path::Class::Dir->new('/nowhere'));
+ok(exists $checkout->get(Path::Class::Dir->new("/nowhere/A/foo"))->{revision}, 'relative lookup');
 my ($copath2, $corpath2) = get_copath ('floating2');
 rename ($corpath, $corpath2);
 ($xd, $svk) = build_floating_test($corpath2);

Modified: trunk/t/mirror/sync-failed-hook.t
==============================================================================
--- trunk/t/mirror/sync-failed-hook.t	(original)
+++ trunk/t/mirror/sync-failed-hook.t	Sun Dec 24 12:16:40 2006
@@ -29,16 +29,13 @@
 is_output($svk, 'sync', ['//m'],
 	  ["Syncing $uri"]);
 
+my $hook;
 {
-    open my $fh, '>', "$repospath/hooks/pre-commit" or die $!;
     local $/;
-    my $buf = <DATA>;
-    $buf =~ s|PERL|$^X|;
-    print $fh $buf;
+    $hook = install_perl_hook($repospath, 'pre-commit', <DATA>);
 }
-chmod 0755, "$repospath/hooks/pre-commit";
-
-skip "Can't run hooks", 1 unless -x "$repospath/hooks/pre-commit";
+SKIP: {
+skip "Can't run hooks", 1 unless -x $hook;
 
 $svk->mkdir('-m', 'A/X', '/test/A/X');
 is_output($svk, 'sync', ['//m'],
@@ -46,8 +43,7 @@
 	   'Retrieving log information from 2 to 2',
 	   qr"A repository hook failed: 'pre-commit' hook failed .* error output.*:",
 	   'hate']);
-
+}
 __DATA__
-#!PERL
 print STDERR "hate";
-exit -1;
+exit 1;

Modified: trunk/t/mirror/sync-replaced.t
==============================================================================
--- trunk/t/mirror/sync-replaced.t	(original)
+++ trunk/t/mirror/sync-replaced.t	Sun Dec 24 12:16:40 2006
@@ -51,7 +51,7 @@
 $svk->cat('/test/A/Q/qu');
 my $expected = $output;
 
-is_output($svk, 'cat', ['//m/A/Q/qu'], [split(/\n/,$expected)], 'content is the same');
+is_output($svk, 'cat', ['//m/A/Q/qu'], [split(/\r?\n/,$expected)], 'content is the same');
 
 $svk->cp(-m => 'b cp', '/test/B' => '/test/B.cp');
 $svk->up($copath);


More information about the svk-commit mailing list