tests and test gen script

git-svn-id: http://dev.catalyst.perl.org/repos/bast/local-lib/1.000/trunk@3686 bd8105ee-0ff8-0310-8827-fb3f25b6796d

diff --git a/lib/local/lib.pm b/lib/local/lib.pm
index 26f60ec..cf58417 100644 (file)
--- a/lib/local/lib.pm
+++ b/lib/local/lib.pm
@@ -38,13 +38,13 @@ sub pipeline {
   }
 }
 
-=for test
+=for test pipeline
 
 package local::lib;
 
 { package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
 my $foo = bless({}, 'Foo');                                                 
-ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
+Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
 
 =cut
 
@@ -223,7 +223,7 @@ sub build_environment_vars_for {
 
 File::Path::rmtree('t/var/splat');
 
-$c->resolve_relative_path('t/var/splat');
+$c->ensure_dir_structure_for('t/var/splat');
 
 ok(-d 't/var/splat');
 

diff --git a/maint/gen-tests.pl b/maint/gen-tests.pl
new file mode 100755 (executable)
index 0000000..62044e7
--- /dev/null
+++ b/maint/gen-tests.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use IO::All;
+
+my $mode;
+
+my %tests;
+
+my ($test, $segment, $text);
+
+sub mode::outer {
+  shift;
+  if (shift =~ /^=for test (\S+)(?:\s+(\S+))?/) {
+    $mode = 'inner';
+    ($test, $segment) = ($1, $2);
+    $segment ||= '';
+    $text = '';
+  }
+}
+
+sub mode::inner {
+  shift;
+  if ($_[0] =~ /^=/) {
+    $mode = 'outer';
+    push(@{$tests{$test}{$segment}||=[]}, $text);
+  } else {
+    $text .= $_[0];
+  }
+}
+
+
+my @lines = io('lib/local/lib.pm')->getlines;
+
+$mode = 'outer';
+
+foreach my $line (@lines) {
+  #warn "$mode: $line";
+  mode->$mode($line);
+}
+
+foreach my $test (keys %tests) {
+  my $data = $tests{$test};
+  my $text = join("\n", q{
+use strict;
+use warnings;
+use Test::More 'no_plan';
+use local::lib ();
+}, @{$data->{setup}||[]},
+  map { "{\n$_}\n"; } @{$data->{''}||[]}
+  );
+  $text > io("t/${test}.t");
+}

diff --git a/t/classmethod.t b/t/classmethod.t
new file mode 100644 (file)
index 0000000..19868b5
--- /dev/null
+++ b/t/classmethod.t
@@ -0,0 +1,35 @@
+
+use strict;
+use warnings;
+use Test::More 'no_plan';
+use local::lib ();
+
+
+my $c = 'local::lib';
+
+
+{
+
+is($c->resolve_empty_path, '~/perl5');
+is($c->resolve_empty_path('foo'), 'foo');
+
+}
+
+{
+
+local *File::Spec::rel2abs = sub { shift; 'FOO'.shift; };
+is($c->resolve_relative_path('bar'),'FOObar');
+
+}
+
+{
+
+File::Path::rmtree('t/var/splat');
+
+$c->ensure_dir_structure_for('t/var/splat');
+
+ok(-d 't/var/splat');
+
+ok(-f 't/var/splat/.modulebuildrc');
+
+}

diff --git a/t/pipeline.t b/t/pipeline.t
new file mode 100644 (file)
index 0000000..f1994ad
--- /dev/null
+++ b/t/pipeline.t
@@ -0,0 +1,15 @@
+
+use strict;
+use warnings;
+use Test::More 'no_plan';
+use local::lib ();
+
+{
+
+package local::lib;
+
+{ package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
+my $foo = bless({}, 'Foo');                                                 
+Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
+
+}

diff --git a/t/var/splat/.modulebuildrc b/t/var/splat/.modulebuildrc
new file mode 100644 (file)
index 0000000..0201061
--- /dev/null
+++ b/t/var/splat/.modulebuildrc
@@ -0,0 +1 @@
+--install_base  t/var/splat