|
1 #!/usr/bin/perl |
|
2 |
|
3 use strict; |
|
4 use warnings; |
|
5 |
|
6 my $purge_cmd = "./purge-proe"; |
|
7 |
|
8 my $stem = "a"; |
|
9 my $subdir = "x"; |
|
10 my $proe_first_line = "#UGC:"; |
|
11 my $num_empty = 69; |
|
12 my $num_non_proe = 101; |
|
13 my @nums_before = (0, 1, 2, 7, 13, 17, 23, 42, '0815', 4711); |
|
14 |
|
15 use Test::Simple tests => 23; |
|
16 #use Test::More tests => 23; |
|
17 |
|
18 my $files = { |
|
19 |
|
20 in_workdir => [ map "$stem.$_", @nums_before ], |
|
21 in_subdir => [ map "$subdir/$stem.$_", @nums_before ], |
|
22 empty => "$subdir/$stem.$num_empty", |
|
23 non_proe => "$subdir/$stem.$num_non_proe" |
|
24 |
|
25 }; |
|
26 |
|
27 sub prepare; |
|
28 |
|
29 prepare({ dirs => [$subdir], files => $files, proe_first_line => $proe_first_line }); |
|
30 ok(qx/$purge_cmd/, "Running '$purge_cmd'"); |
|
31 my @iw = @{$files->{in_workdir}}; |
|
32 my @is = @{$files->{in_subdir}}; |
|
33 |
|
34 for (@iw[$#iw-2 .. $#iw], @is[$#is-2 .. $#is], $files->{empty}, $files->{non_proe}) { ok(-f $_, "Checking for presence of file '$_'"); } |
|
35 for (@iw[0 .. $#iw-3], @is[0 .. $#iw-3]) { ok(! -e $_, "Checking for absence of '$_'"); } |
|
36 |
|
37 for (@iw[$#iw-2 .. $#iw], @is[$#is-2 .. $#is], $files->{empty}, $files->{non_proe}, "y/abc") { unlink || warn "Can't unlink '$_': $!" if -f; } |
|
38 rmdir $subdir or warn "Can't rmdir '$subdir': $!"; |
|
39 |
|
40 # $opts = { |
|
41 # dirs => ['dir1', 'dir2', ..], |
|
42 # files => { |
|
43 # in_workdir => ['file1', 'file2', ..], |
|
44 # in_subdir => ['path1', 'path2', ..], |
|
45 # empty => 'path_to_an_empty_file', |
|
46 # non_proe => 'path_to_a_nonempty_nonproe_file' |
|
47 # }, |
|
48 # proe_first_line => 'something that should appear in the first line of a file to match' |
|
49 # } |
|
50 sub prepare { |
|
51 |
|
52 my ($opts) = @_; |
|
53 |
|
54 for (@{$opts->{dirs}}) { mkdir $_ or warn "Can't mkdir '$_': $!"; } |
|
55 |
|
56 for (@{$opts->{files}->{in_workdir}}, @{$opts->{files}->{in_subdir}}) { |
|
57 |
|
58 open F, '>', $_ or warn "Can't open F, '>', '$_': $!"; |
|
59 print F $proe_first_line; |
|
60 close F; |
|
61 |
|
62 } |
|
63 |
|
64 my $empty = $opts->{files}->{empty}; |
|
65 open F, '>', $empty or warn "Can't open F, '>', '$empty': $!"; |
|
66 close F; |
|
67 |
|
68 my $non_proe = $opts->{files}->{non_proe}; |
|
69 open F, '>', $non_proe or warn "Can't open F, '>', '$non_proe': $!"; |
|
70 print F "foo"; |
|
71 close F; |
|
72 |
|
73 } |