Stow directory now defaults to STOW_DIR environment variable if set.
[gnu-stow.git] / t / cleanup_invalid_links.t
blob92741cc4847d2fd81741593c654c9dd445a4f813
1 #!/usr/local/bin/perl
4 # Testing cleanup_invalid_links()
7 # load as a library
8 BEGIN { use lib qw(.); require "t/util.pm"; require "stow"; }
10 use Test::More tests => 3;
11 use English qw(-no_match_vars);
13 # local utility
14 sub reset_state {
15 @Tasks = ();
16 @Conflicts = ();
17 %Link_Task_For = ();
18 %Dir_Task_For = ();
19 %Option = ();
20 return;
23 ### setup
24 eval { remove_dir('t/target'); };
25 eval { remove_dir('t/stow'); };
26 make_dir('t/target');
27 make_dir('t/stow');
29 chdir 't/target';
30 $Stow_Path= '../stow';
32 # Note that each of the following tests use a distinct set of files
35 # nothing to clean in a simple tree
37 reset_state();
38 $Option{'verbose'} = 1;
40 make_dir('../stow/pkg1/bin1');
41 make_file('../stow/pkg1/bin1/file1');
42 make_link('bin1','../stow/pkg1/bin1');
44 cleanup_invalid_links('./');
45 is(
46 scalar @Tasks, 0
47 => 'nothing to clean'
51 # cleanup a bad link in a simple tree
53 reset_state();
54 $Option{'verbose'} = 0;
56 make_dir('bin2');
57 make_dir('../stow/pkg2/bin2');
58 make_file('../stow/pkg2/bin2/file2a');
59 make_link('bin2/file2a','../../stow/pkg2/bin2/file2a');
60 make_link('bin2/file2b','../../stow/pkg2/bin2/file2b');
62 cleanup_invalid_links('bin2');
63 ok(
64 scalar(@Conflicts) == 0 &&
65 scalar @Tasks == 1 &&
66 $Link_Task_For{'bin2/file2b'}->{'action'} eq 'remove'
67 => 'cleanup a bad link'
70 #use Data::Dumper;
71 #print Dumper(\@Tasks,\%Link_Task_For,\%Dir_Task_For);
74 # dont cleanup a bad link not owned by stow
76 reset_state();
77 $Option{'verbose'} = 0;
79 make_dir('bin3');
80 make_dir('../stow/pkg3/bin3');
81 make_file('../stow/pkg3/bin3/file3a');
82 make_link('bin3/file3a','../../stow/pkg3/bin3/file3a');
83 make_link('bin3/file3b','../../empty');
85 cleanup_invalid_links('bin3');
86 ok(
87 scalar(@Conflicts) == 0 &&
88 scalar @Tasks == 0
89 => 'dont cleanup a bad link not owned by stow'