1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
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);
my $orig_dir = getcwd();
chdir($sandbox) or die "Cant enter sandbox: $!";
my $cmd = File::Spec->catfile($orig_dir, "vcx");
# Helper functions
sub write_file {
my ($path, $content) = @_;
open my $fh, '>', $path or die $!;
print $fh $content;
close $fh;
}
sub read_file {
my $path = shift;
open my $fh, '<', $path or return "";
my $content = <$fh>;
chomp $content if $content;
close $fh;
return $content;
}
# 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");
};
subtest 'Adding and Committing Files' => sub {
write_file("test.txt", "Hello, world!");
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");
my $rev1 = File::Spec->catdir(REV_DIR, "0000001");
ok(-d $rev1, "Revision 0000001 directory exists");
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 $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");
system("perl $cmd add link_b > /dev/null");
system("perl $cmd commit -m 'Double link' > /dev/null");
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");
is(readlink($staged_link), "link_a", "Symlink-to-symlink targets preserved literally");
};
subtest 'Edge Cases: Content Reversion' => sub {
# Clear the staging area to ensure a "Pure" tree
remove_tree(TMP_DIR);
make_path(TMP_TREE);
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();
|
