test
changeset 0 fcdba28f4b06
child 6 531e14cda4fa
equal deleted inserted replaced
-1:000000000000 0:fcdba28f4b06
       
     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 }