diff options
| -rw-r--r-- | vcx.t | 290 | ||||
| -rw-r--r-- | vcx_patch.t | 104 |
2 files changed, 156 insertions, 238 deletions
@@ -1,153 +1,175 @@ +#!/usr/bin/perl use strict; use warnings; -use Test::More; -use File::Path qw(remove_tree make_path); use File::Spec; -use Cwd; -use File::Glob qw(:bsd_glob); - -use constant ROOT => '.vcx'; -use constant HEAD => ROOT . '/head'; -use constant OBJ_DIR => ROOT . '/obj'; -use constant REV_DIR => ROOT . '/rev'; -use constant TMP_DIR => ROOT . '/index'; -use constant TMP_TREE => TMP_DIR . '/tree'; - -# Setup sandbox -my $sandbox = "sandbox"; -remove_tree($sandbox) if -d $sandbox; -make_path($sandbox); +use File::Path qw(make_path remove_tree); +use Digest::SHA qw(sha1_hex); -my $orig_dir = getcwd(); -chdir($sandbox) or die "Cant enter sandbox: $!"; -my $cmd = File::Spec->catfile($orig_dir, "vcx"); +# Setup testing environment +my $sandbox = File::Spec->rel2abs("sandbox_env"); +my $script_bin = File::Spec->catfile(File::Spec->rel2abs("."), "vcx"); +my $repo_meta = ".vcx"; -# Helper functions -sub write_file { - my ($path, $content) = @_; - open my $fh, '>', $path or die $!; - print $fh $content; - close $fh; +remove_tree($sandbox); +make_path($sandbox); +chdir($sandbox) or die "Cannot chdir to $sandbox: $!"; + +sub run_cmd { + my $cmd = shift; + my $out = `perl $script_bin $cmd 2>&1`; + if ($? != 0) { + die "\nCommand '$cmd' failed with exit code $?:\n$out\n"; + } + return $out; } -sub read_file { - my $path = shift; - open my $fh, '<', $path or return ""; - my $content = <$fh>; - chomp $content if $content; - close $fh; - return $content; +sub get_head_id { + my $head_path = File::Spec->catfile($repo_meta, "head"); + return undef unless -f $head_path; + open(my $fh, '<', $head_path) or return undef; + my $id = <$fh>; + close($fh); + chomp($id //= ""); + $id =~ s/^\s+|\s+$//g; + return $id; } -# Tests - -subtest 'Repository Initialization' => sub { - ok(system("perl $cmd init > /dev/null") == 0, "Init exit code 0"); - ok(-d ROOT, "ROOT directory created"); - ok(-e HEAD, "Head file created"); - ok(-d OBJ_DIR, "OBJ_DIR directory created"); - ok(-d REV_DIR, "REV_DIR directory created"); -}; +print "Starting tests...\n"; +run_cmd("init"); -subtest 'Adding and Committing Files' => sub { - write_file("test.txt", "Hello, world!"); +# --- Subtest 1: All-In Integration --- +print "Subtest 1: Initial commit with symlink...\t"; +{ + open(my $fh, '>', "file1.txt") or die $!; + print $fh "Original content\n" x 10; + close($fh); - ok(system("perl $cmd add test.txt > /dev/null") == 0, "Add file successful"); - ok(-d TMP_TREE, "Staging tree created"); - - ok(system("perl $cmd commit -m 'Initial commit' > /dev/null") == 0, "Commit successful"); + symlink("file1.txt", "link1.txt") or die "Symlink failed: $!"; - my $rev1 = File::Spec->catdir(REV_DIR, "0000001"); - ok(-d $rev1, "Revision 0000001 directory exists"); + run_cmd("commit -am 'initial'"); - my $msg_file = File::Spec->catfile($rev1, "message"); - is(read_file($msg_file), "Initial commit", "Commit message stored correctly"); -}; - -subtest 'Auto-staging with commit -am' => sub { - # Append content - open my $fh, '>>', "test.txt" or die $!; - print $fh "\nMore content"; - close $fh; - - ok(system("perl $cmd commit -am 'Second commit' > /dev/null") == 0, "Commit -am successful"); - - opendir(my $dh, OBJ_DIR) or die $!; - my @objs = grep { /[a-f0-9]{40}/ } readdir($dh); - closedir($dh); - ok(scalar @objs >= 1, "Content blobs found in object store"); -}; - -subtest 'File Moves and Deletions (Tree Integrity)' => sub { - # Create nested structure - make_path("dirA/dirB"); - write_file("dirA/dirB/shuffle.txt", "Same Content"); - system("perl $cmd add dirA/dirB/shuffle.txt > /dev/null"); - system("perl $cmd commit -m 'Shuffle part 1' > /dev/null"); - - # Move file and delete old dir - make_path("dirC"); - rename("dirA/dirB/shuffle.txt", "dirC/shuffle.txt"); - remove_tree("dirA"); - - ok(system("perl $cmd commit -am 'Shuffle part 2' > /dev/null") == 0, "Commit move successful"); - - my $head = read_file(HEAD); - my ($tree_ptr) = bsd_glob(File::Spec->catfile(REV_DIR, $head, "tree-*")); - my $tree_hash = $tree_ptr =~ s/.*tree-//r; - my $actual_tree_path = File::Spec->catdir(OBJ_DIR, $tree_hash); - - ok(-l File::Spec->catfile($actual_tree_path, "dirC/shuffle.txt"), "New path exists in tree"); - ok(!-d File::Spec->catdir($actual_tree_path, "dirA"), "Deleted path removed from tree"); + my $idx_path = File::Spec->catfile($repo_meta, "index"); + open(my $idx, '<', $idx_path) or die "Could not open $idx_path: $!"; + my %index_hashes; + while (<$idx>) { + chomp; + # Updated parser: split on tabs and trim padding from hashes + my ($shash, $chash, $bhash, $m, $s, $path) = split(/\t/, $_, 6); + $shash =~ s/\s+$//; # Remove fixed-width padding + $index_hashes{$path} = $shash; + } + close($idx); + + die "Missing file1" unless $index_hashes{"file1.txt"}; + # Symlink hash is the SHA of the target path string + die "Symlink hash mismatch" unless $index_hashes{"link1.txt"} eq sha1_hex("file1.txt"); +} +print "OK\n"; + +# --- Subtest 2: Large Source, Small Patch (Text Patching) --- +print "Subtest 2: Large source, small patch...\t"; +{ + my $large_p = "large.txt"; + open(my $lf, '>', $large_p) or die $!; + print $lf "Line $_\n" for 1..1000; + close($lf); - my $link_target = readlink(File::Spec->catfile($actual_tree_path, "dirC/shuffle.txt")); - like($link_target, qr/obj\/[a-f0-9]{40}/, "Tree link points to object store"); -}; - -subtest 'Symlink Handling' => sub { - write_file("target.txt", "Final Destination"); - symlink("target.txt", "link_a"); - symlink("link_a", "link_b"); + run_cmd("commit -am 'large file base'"); + + open($lf, '>>', $large_p) or die $!; + print $lf "One small change\n"; + close($lf); + run_cmd("commit -am 'patch commit'"); + + my $head_id = get_head_id(); + my $rev_path = File::Spec->catfile($repo_meta, "rev", $head_id); + open(my $rf, '<', $rev_path) or die "Could not open $rev_path: $!"; + my $has_patch = 0; + while (<$rf>) { $has_patch = 1 if /^patch:[a-f0-9]/; } + close($rf); + die "Expected patch in rev $head_id" unless $has_patch; +} +print "OK\n"; + +# --- Subtest 3: Small Source, Large Patch (Full Store) --- +print "Subtest 3: Small source, large patch...\t"; +{ + my $small_p = "small.txt"; + open(my $sf, '>', $small_p) or die $!; + print $sf "A"; + close($sf); + run_cmd("commit -am 'small file base'"); + + open($sf, '>', $small_p) or die $!; + print $sf "Completely different content" x 200; + close($sf); + run_cmd("commit -am 'full store commit'"); + + my $restored = run_cmd("show HEAD $small_p"); + my $actual = `cat $small_p`; + die "Reconstruction mismatch" unless $restored eq $actual; +} +print "OK\n"; + +# --- Subtest 4: Binary Integrity --- +print "Subtest 4: Binary patch integrity...\t\t"; +{ + my $bin_p = "data.bin"; + my $orig_data = pack("C*", map { int(rand(256)) } 1..2048); + open(my $bf, '>:raw', $bin_p) or die $!; + print $bf $orig_data; + close($bf); + run_cmd("commit -am 'initial bin'"); + + my $old_rev = get_head_id(); - system("perl $cmd add link_b > /dev/null"); - system("perl $cmd commit -m 'Double link' > /dev/null"); + open($bf, '+<:raw', $bin_p) or die $!; + seek($bf, 1024, 0); + print $bf pack("C", 255); + close($bf); + run_cmd("commit -am 'mod bin'"); - my $head = read_file(HEAD); - my ($tree_ptr) = bsd_glob(File::Spec->catfile(REV_DIR, $head, "tree-*")); - my $staged_link = File::Spec->catfile(OBJ_DIR, $tree_ptr =~ s/.*tree-//r, "link_b"); + my $v_old = run_cmd("show $old_rev $bin_p"); + my $v_new = run_cmd("show HEAD $bin_p"); + + die "Old version corrupted" unless $v_old eq $orig_data; + die "Binary restore error" unless length($v_new) == 2048; +} +print "OK\n"; - is(readlink($staged_link), "link_a", "Symlink-to-symlink targets preserved literally"); -}; +# --- Subtest 5: CRUD (Deletion) --- +print "Subtest 5: File deletion...\t\t\t"; +{ + unlink("file1.txt"); + run_cmd("commit -am 'delete file1'"); + + my $head_id = get_head_id(); + my $rev_path = File::Spec->catfile($repo_meta, "rev", $head_id); + my $rev_data = `cat $rev_path`; + my ($tree_h) = $rev_data =~ /^tree:([a-f0-9]+)/m; + + my $t_obj = File::Spec->catfile($repo_meta, "obj", substr($tree_h, 0, 2), substr($tree_h, 2)); + my $tree_content = `cat $t_obj`; + die "File1 still in tree after deletion" if $tree_content =~ /file1\.txt/; +} +print "OK\n"; + +# --- Subtest 6: Dirty Status --- +print "Subtest 6: Dirty state detection...\t\t"; +{ + open(my $fh, '>', "dirty.txt") or die $!; + print $fh "Clean state\n"; + close($fh); + run_cmd("add dirty.txt"); + + open($fh, '>>', "dirty.txt") or die $!; + print $fh "Dirty edit\n"; + close($fh); + + my $status = run_cmd("status"); + die "Failed to detect dirty state" unless $status =~ /\[M\].*dirty\.txt.*\(dirty\)/; +} +print "OK\n"; -subtest 'Edge Cases: Content Reversion' => sub { - # Clear the staging area to ensure a "Pure" tree - remove_tree(TMP_DIR); - make_path(TMP_TREE); +print "\nAll tests passed successfully.\n"; - make_path("revert_test"); - write_file("revert_test/data.txt", "Version A"); - - # Commit State A - system("perl $cmd add revert_test/data.txt > /dev/null"); - system("perl $cmd commit -m 'State A' > /dev/null"); - my $tree_v1 = (bsd_glob(File::Spec->catfile(REV_DIR, read_file(HEAD), "tree-*")))[0]; - - # Commit State B - write_file("revert_test/data.txt", "Version B"); - system("perl $cmd commit -am 'State B' > /dev/null"); - - # Revert to State A - write_file("revert_test/data.txt", "Version A"); - system("perl $cmd commit -am 'Back to State A' > /dev/null"); - my $tree_v3 = (bsd_glob(File::Spec->catfile(REV_DIR, read_file(HEAD), "tree-*")))[0]; - - # Extract hashes and compare - my $hash1 = $tree_v1 =~ s/.*tree-//r; - my $hash3 = $tree_v3 =~ s/.*tree-//r; - - is($hash1, $hash3, "Tree hashes match after index reset and content restoration"); -}; - -# Cleanup -chdir($orig_dir); -done_testing(); diff --git a/vcx_patch.t b/vcx_patch.t deleted file mode 100644 index d2b813f..0000000 --- a/vcx_patch.t +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/perl -use strict; -use warnings; -use Test::More; -use File::Temp qw(tempfile); -use File::Spec; - -# Overrides exit and silences the 'Usage' print during the 'do' call. -BEGIN { - *CORE::GLOBAL::exit = sub { }; -} - -{ - local @ARGV = (); - open my $oldout, ">&STDOUT"; - open STDOUT, ">", File::Spec->devnull(); - eval { do './vcx' }; - open STDOUT, ">&", $oldout; -} - -subtest 'Binary Patching: Shrink & Truncate' => sub { - my ($fh_old, $old_path) = tempfile(); - my ($fh_new, $new_path) = tempfile(); - - # 8KB of 'A' shrinking to 6 bytes - print $fh_old "A" x 8192; close $fh_old; - print $fh_new "SHRINK"; close $fh_new; - - my $patch = main::make_bin_patch($new_path, $old_path); - ok(defined($patch), "Patch generated for shrinking file"); - - main::apply_bin_patch($old_path, $patch); - - is(-s $old_path, 6, "File size correctly truncated to 6 bytes"); - - open my $check, '<:raw', $old_path; - my $content = <$check>; - is($content, "SHRINK", "Content matches perfectly (no stale trailing data)"); - close $check; -}; - -subtest 'Binary Patching: Growth & Extension' => sub { - my ($fh_old, $old_path) = tempfile(); - my ($fh_new, $new_path) = tempfile(); - - print $fh_old "Tiny"; - close $fh_old; - - # Create a 5KB string to cross a block boundary (4096) - my $big_data = "EXTENDED" . ("." x 5000); - print $fh_new $big_data; - close $fh_new; - - my $patch = main::make_bin_patch($new_path, $old_path); - main::apply_bin_patch($old_path, $patch); - - is(-s $old_path, 5008, "File size correctly extended"); - - open my $check, '<:raw', $old_path; - my $result = do { local $/; <$check> }; - is($result, $big_data, "Extended content matches perfectly"); - close $check; -}; - -subtest 'Binary Patching: Sparse Block Edits' => sub { - my ($fh_old, $old_path) = tempfile(); - my ($fh_new, $new_path) = tempfile(); - - # Create three 4KB blocks - my $data = ("X" x 4096) . ("Y" x 4096) . ("Z" x 4096); - print $fh_old $data; close $fh_old; - - # Modify only the middle block ('Y' block) - substr($data, 5000, 10) = "MODIFIED!!"; - print $fh_new $data; close $fh_new; - - my $patch = main::make_bin_patch($new_path, $old_path); - - # Header (8) + Block Header (12) + Block (4096) = ~4116 bytes - ok(length($patch) < 4200, "Patch is efficient (only captured the changed block)"); - - main::apply_bin_patch($old_path, $patch); - - open my $check, '<:raw', $old_path; - my $final = do { local $/; <$check> }; - is(substr($final, 5000, 10), "MODIFIED!!", "Middle block update applied"); - is(substr($final, 0, 10), "XXXXXXXXXX", "First block preserved"); - is(substr($final, -10), "ZZZZZZZZZZ", "Last block preserved"); - close $check; -}; - -subtest 'Binary Patching: No Change Identity' => sub { - my ($fh_old, $old_path) = tempfile(); - my ($fh_new, $new_path) = tempfile(); - - my $data = "Same data" x 50; - print $fh_old $data; close $fh_old; - print $fh_new $data; close $fh_new; - - my $patch = main::make_bin_patch($new_path, $old_path); - is($patch, undef, "No patch generated for identical files"); -}; - -done_testing(); |