[svk-commit] r2424 - in trunk: t/api

nobody at bestpractical.com nobody at bestpractical.com
Sun Jul 8 18:45:45 EDT 2007


Author: clkao
Date: Sun Jul  8 18:45:43 2007
New Revision: 2424

Added:
   trunk/t/api/root.t
Modified:
   trunk/MANIFEST

Log:
Add api tests for SVK::Root.  Updated test api usage and misc cleanup.

Submitted by: samv


Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	(original)
+++ trunk/MANIFEST	Sun Jul  8 18:45:43 2007
@@ -282,6 +282,7 @@
 t/76ignore.t
 t/77floating.t
 t/api/mirror.t
+t/api/root.t
 t/copy-escape.t
 t/copy-replace.t
 t/diff/mixed-checkout.t

Added: trunk/t/api/root.t
==============================================================================
--- (empty file)
+++ trunk/t/api/root.t	Sun Jul  8 18:45:43 2007
@@ -0,0 +1,334 @@
+#!/usr/bin/perl -w
+use strict;
+use SVK::Test;
+plan tests => 39;
+our $output;
+
+
+use Scalar::Util qw(reftype blessed);
+use Digest::MD5 qw(md5_hex);
+use Class::ISA;    # diags only
+use Data::Dumper;  # diags only
+
+
+# setup the test
+my ($xd, $svk) = build_test();
+$svk->mkdir('-m' => 'trunk', '//trunk');
+my $tree = create_basic_tree ($xd, '//trunk');
+my ($copath, $corpath) = get_copath ('root');
+$svk->checkout ('//', $copath);
+
+
+# get a handle on it
+my $depot = $xd->find_depot('');
+my $repos = $depot->repos;
+my $path = SVK::Path->real_new({ depot => $depot,
+				 path => "/trunk",
+				 revision => $repos->fs->youngest_rev });
+
+# fetch the bit we want to test
+my $root = $path->root;
+
+
+# revision basics - committed revisions
+ok($root->is_revision_root, "we're a revision root");
+ok(!$root->is_txn_root, "we're not a transaction root");
+my $youngest_rev = $root->revision_root_revision;
+ok($youngest_rev, "we have a revision ($youngest_rev)");
+
+
+# revision basics - file/dir lookup
+ok($root->check_path("/trunk"), "/trunk checks out OK");
+ok($root->is_dir("/trunk"), "//trunk is a directory");
+ok(!$root->is_file("/trunk"), "/trunk is not a file");
+ok($root->check_path("/trunk/me"), "/trunk/me exists");
+ok(!$root->is_dir("/trunk/me"), "//trunk is not a directory");
+ok($root->is_file("/trunk/me"), "/trunk is a file");
+
+
+ok(!$root->check_path("/trunk/junk"), "/trunk/junk doesn't exist");
+
+
+# reading directories
+my $dir_entries = $root->dir_entries("/trunk");
+is(reftype $dir_entries, "HASH", "dir_entries is a hash");
+is(keys %$dir_entries, 5, "5 files in /trunk");
+my $me = $dir_entries->{me};
+is($me->name, "me", "meesa me");
+is($me->kind, $SVN::Node::file, "meesa file");
+my $A = $dir_entries->{A};
+is($A->name, "A", "found A, correct name");
+is($A->kind, $SVN::Node::dir, "A is a directory");
+
+
+# reading files
+my $expected = "first line in me$/2nd line in me - mod$/";
+is($root->file_length("/trunk/me"), length($expected),
+   "meesa right length");
+is($root->file_md5_checksum("/trunk/me"),
+   md5_hex($expected), "->file_md5_checksum");
+
+
+
+# IO::Handle interface
+my $contents = $root->file_contents("/trunk/me");
+isa_ok($contents, "IO::Handle", "contents are IO::Handle objects");
+
+{
+local $/;
+my $buffer = <$contents>;
+is($buffer, $expected, "can get files out OK");
+
+}
+#show_tree($root, "/");
+
+
+# file and directory properties
+is_deeply($root->node_proplist("/trunk/me"), {}, "meesa no properties");
+is_deeply($root->node_proplist("/trunk/A/be"),
+  { 'svn:keywords' => 'Rev URL Revision FileRev' },
+  "A/be (file) has props");
+is($root->node_prop("/trunk/A/be", 'svn:keywords'),
+   "Rev URL Revision FileRev",
+   "we can fetch a prop");
+my $pl = $root->node_proplist("/trunk/A/Q");
+is_deeply($pl, { 'foo' => 'prop on A/Q' }, "A/Q (dir) has props");
+
+
+# history-related commands; check behaviour of node_created_rev
+is($root->node_created_rev("/trunk/B/S"), $youngest_rev,
+   "node_created_rev(changed node)");
+is($root->node_created_rev("/trunk/B"), $youngest_rev,
+   "node_created_rev(parent of changed node)");
+is($root->node_created_rev("/"), $youngest_rev,
+   "node_created_rev(root node)");
+
+
+# this node was not changed in this revision; it was made by the
+# previous one.
+my $trunk_C_R_rev = $root->node_created_rev("/trunk/C/R");
+isnt($trunk_C_R_rev, $youngest_rev, "node_created_rev(unchanged node)");
+
+
+# we don't check that the revision ids are integers, but we should
+# still be able to compare them if one is a predecessor or successor
+# of the other.
+cmp_ok($trunk_C_R_rev, "<", $youngest_rev, "revisions have order");
+
+
+# hmm will locale ruin our day with this sort()?
+is_deeply([ sort keys %{ $root->paths_changed } ],
+  [qw[ /trunk/A/P /trunk/B/S /trunk/B/fe
+      /trunk/D /trunk/D/de /trunk/me ]],
+  "paths_changed");
+
+
+# svn's history->prev returns useless intermediate locations, so
+# suppress duplicates in this test so we don't have to emulate this
+# model-specific behaviour
+my $history = $root->node_history("/trunk/B/S");
+my @history;
+do {
+    my @location = $history->location;
+    if ( !@history or
+scalar(grep { $history[$#history][$_] ne $location[$_] }
+(0,1)) ) {
+push @history, \@location;
+    }
+} while ( $history = $history->prev(1) );
+
+
+is_deeply(\@history,
+  [ [ '/trunk/B/S', $youngest_rev, ],
+    [ '/trunk/A',   $trunk_C_R_rev ],
+  ],
+  "we can fetch node history");
+
+
+# for git we will probably need to store and parse special
+# copied-from: fields in the commit message.
+my @copied_from = $root->copied_from("/trunk/B/S");
+is_deeply(\@copied_from,
+  # odd, in the other order to the above...
+  [ $trunk_C_R_rev, '/trunk/A' ],
+  "->copied_from");
+
+
+# revision properties.
+my $rp = $root->fs->revision_proplist($youngest_rev);
+is($rp->{'svn:log'}, "test init tree", "revprop - log");
+is($rp->{'svn:author'}, "svk", "revprop - author");
+like($rp->{"svn:date"}, qr/\d+-\d+-\d+T\d+:\d+:\d+\.\d+Z/,
+     'revprop - date (in UTC)');
+
+
+# changing revision properties ... do we need to?  I hope not...
+
+
+# editing commands.
+
+
+# first we make a memory allocation pool.  other back-ends can
+# probably ignore this, or it can be factored into a common interface
+# later.
+my $pool = SVN::Pool->new;
+
+
+# info_on($root->fs, "root->fs");
+
+
+# first, get a 'transaction'
+my $txn = $root->txn_root;
+
+ok(!$txn->is_revision_root, "->txn_root is not a revision root");
+ok($txn->is_txn_root, "->txn_root is a transaction root");
+
+
+# show_tree($txn, "/");
+
+
+$txn->delete("/trunk/A/Q");
+ok(!$txn->check_path("/trunk/A/Q"),
+   "deletes to open txn are effective");
+
+
+#info_on($repos, "repository");
+# info_on($txn->fs, "fs");
+#info_on($_txn, "txn");
+#system("find /tmp/svk* | sed 's/^/# /'");
+$repos->fs_commit_txn($txn->txn); $txn->txn(undef);
+#$txn->close_root;
+#$_txn->commit;
+#$txn->commit;
+#$txn->txn_commit;
+
+
+isnt($repos->fs->youngest_rev, $youngest_rev, "made a new revision");
+# nope, this doesn't happen...
+# ok($txn->is_revision_root, "TXN object got assigned a revision number");
+
+
+# is there a shortcut to this?
+#$root = SVK::Path->real_new({ depot => $depot,
+#      path => "/trunk",
+#      revision => $repos->fs->youngest_rev
+#    })->root;
+
+
+# the following SVK::Root methods (via ::_p_svn_fs_root_t) still need
+# testing.
+
+
+#   copy( from_root, from_path, to_root, to_path )
+#   revision_link (from, to)
+#   make_dir
+#   make_file
+#   change_node_prop
+
+
+# what do these use?  SVN::Editor-style events or a
+# Parse::SVNDiff-type stream?  or something else?
+#   apply_textdelta
+#   apply_text
+
+
+# we didn't test this history function above, because there were no
+# objects which had a copy then a change.
+
+
+#  closest_copy
+
+
+# ignored (in %_p_svn_fs_root_t::):
+#   close_root
+#   methods
+
+
+# other objects we might need to emulate;
+#  FS (_p_svn_fs_t):
+
+
+#   begin_txn           - might be only one per-checkout
+#   open_txn
+#   list_transactions
+
+
+#   revision_root       - should be easy enough...
+#   youngest_rev
+
+
+#   revision_proplist   - probably shove these in the commit message
+#   revision_prop
+#   change_rev_prop     - do we desperately need this?
+
+
+#   get_uuid            - not needed for content-hashed repos...
+#   set_uuid
+
+
+#   get_lock            - not sure what to test here...
+#   get_locks
+#   generate_lock_token
+#   lock
+#   unlock
+
+
+#   get_access          - only for remote repos...
+#   set_access
+
+
+
+
+sub show_tree {
+    my $root = shift;
+    my $start = shift;
+
+
+    my @seen = ($start);
+
+
+    while ( my $path = pop @seen ) {
+my $pl = $root->node_proplist($path);
+my $crev = $root->node_created_rev($path);
+my $p = " ";
+if ( keys %$pl ) {
+    $p = "+";
+}
+if ( $root->is_dir( $path ) ) {
+    diag "$crev d $p $path";
+    push @seen, map { $path eq "/" ? "/$_" : "$path/$_" }
+reverse sort keys %{ $root->dir_entries($path) };
+}
+else {
+    diag "$crev f $p $path";
+}
+    }
+}
+
+
+sub show_isa {
+    my $class = ref $_[0] || $_[0];
+
+
+    diag "$class ISA : ".join(" ", Class::ISA::super_path($class));
+}
+
+
+sub info_on {
+    no strict;
+
+
+    my $what = shift;
+    my $name = shift || "thingy";
+    if ( ref($what) ) {
+diag("$name is: ".Dumper($what));
+if ( blessed($what) ) {
+    diag "methods in ".ref($what).":";
+    diag "  $_" for sort keys(%{ref($what)."::"});
+    show_isa($what);
+}
+    }
+    else {
+diag("$name is: ".Dumper($what));
+    }
+}


More information about the svk-commit mailing list