test
changeset 0 fcdba28f4b06
child 6 531e14cda4fa
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test	Mon May 17 13:47:47 2010 +0200
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my $purge_cmd = "./purge-proe";
+
+my $stem = "a";
+my $subdir = "x";
+my $proe_first_line = "#UGC:";
+my $num_empty = 69;
+my $num_non_proe = 101;
+my @nums_before = (0, 1, 2, 7, 13, 17, 23, 42, '0815', 4711);
+
+use Test::Simple tests => 23;
+#use Test::More tests => 23;
+
+my $files = {
+
+  in_workdir => [ map "$stem.$_", @nums_before ],
+  in_subdir => [ map "$subdir/$stem.$_", @nums_before ],
+  empty => "$subdir/$stem.$num_empty",
+  non_proe => "$subdir/$stem.$num_non_proe"
+
+};
+
+sub prepare;
+
+prepare({ dirs => [$subdir], files => $files, proe_first_line => $proe_first_line });
+ok(qx/$purge_cmd/, "Running '$purge_cmd'");
+my @iw = @{$files->{in_workdir}};
+my @is = @{$files->{in_subdir}};
+
+for (@iw[$#iw-2 .. $#iw], @is[$#is-2 .. $#is], $files->{empty}, $files->{non_proe}) { ok(-f $_, "Checking for presence of file '$_'"); }
+for (@iw[0 .. $#iw-3], @is[0 .. $#iw-3]) { ok(! -e $_, "Checking for absence of '$_'"); }
+
+for (@iw[$#iw-2 .. $#iw], @is[$#is-2 .. $#is], $files->{empty}, $files->{non_proe}, "y/abc") { unlink || warn "Can't unlink '$_': $!" if -f; }
+rmdir $subdir or warn "Can't rmdir '$subdir': $!";
+
+# $opts = { 
+#   dirs => ['dir1', 'dir2', ..],
+#   files => {
+#     in_workdir => ['file1', 'file2', ..],
+#     in_subdir => ['path1', 'path2', ..],
+#     empty => 'path_to_an_empty_file',
+#     non_proe => 'path_to_a_nonempty_nonproe_file'
+#   },
+#   proe_first_line => 'something that should appear in the first line of a file to match'
+# }
+sub prepare {
+
+  my ($opts) = @_;
+
+  for (@{$opts->{dirs}}) { mkdir $_ or warn "Can't mkdir '$_': $!"; }
+
+  for (@{$opts->{files}->{in_workdir}}, @{$opts->{files}->{in_subdir}}) {
+
+    open F, '>', $_ or warn "Can't open F, '>', '$_': $!";
+    print F $proe_first_line;
+    close F;
+  
+  }
+
+  my $empty = $opts->{files}->{empty};
+  open F, '>', $empty or warn "Can't open F, '>', '$empty': $!";
+  close F;
+
+  my $non_proe = $opts->{files}->{non_proe};
+  open F, '>', $non_proe or warn "Can't open F, '>', '$non_proe': $!";
+  print F "foo";
+  close F;
+
+}