[Bast-commits] r3686 - in local-lib/1.000/trunk: . lib/local maint t t/var t/var/splat

matthewt at dev.catalyst.perl.org matthewt at dev.catalyst.perl.org
Sun Aug 19 22:02:00 GMT 2007


Author: matthewt
Date: 2007-08-19 22:01:59 +0100 (Sun, 19 Aug 2007)
New Revision: 3686

Added:
   local-lib/1.000/trunk/maint/
   local-lib/1.000/trunk/maint/gen-tests.pl
   local-lib/1.000/trunk/t/
   local-lib/1.000/trunk/t/classmethod.t
   local-lib/1.000/trunk/t/pipeline.t
   local-lib/1.000/trunk/t/var/
   local-lib/1.000/trunk/t/var/splat/
   local-lib/1.000/trunk/t/var/splat/.modulebuildrc
Modified:
   local-lib/1.000/trunk/lib/local/lib.pm
Log:
tests and test gen script

Modified: local-lib/1.000/trunk/lib/local/lib.pm
===================================================================
--- local-lib/1.000/trunk/lib/local/lib.pm	2007-08-17 15:51:52 UTC (rev 3685)
+++ local-lib/1.000/trunk/lib/local/lib.pm	2007-08-19 21:01:59 UTC (rev 3686)
@@ -38,13 +38,13 @@
   }
 }
 
-=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 @@
 
 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');
 

Added: local-lib/1.000/trunk/maint/gen-tests.pl
===================================================================
--- local-lib/1.000/trunk/maint/gen-tests.pl	                        (rev 0)
+++ local-lib/1.000/trunk/maint/gen-tests.pl	2007-08-19 21:01:59 UTC (rev 3686)
@@ -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");
+}


Property changes on: local-lib/1.000/trunk/maint/gen-tests.pl
___________________________________________________________________
Name: svn:executable
   + *
Name: svn:mime-type
   + text/script

Added: local-lib/1.000/trunk/t/classmethod.t
===================================================================
--- local-lib/1.000/trunk/t/classmethod.t	                        (rev 0)
+++ local-lib/1.000/trunk/t/classmethod.t	2007-08-19 21:01:59 UTC (rev 3686)
@@ -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');
+
+}

Added: local-lib/1.000/trunk/t/pipeline.t
===================================================================
--- local-lib/1.000/trunk/t/pipeline.t	                        (rev 0)
+++ local-lib/1.000/trunk/t/pipeline.t	2007-08-19 21:01:59 UTC (rev 3686)
@@ -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);
+
+}

Added: local-lib/1.000/trunk/t/var/splat/.modulebuildrc
===================================================================
--- local-lib/1.000/trunk/t/var/splat/.modulebuildrc	                        (rev 0)
+++ local-lib/1.000/trunk/t/var/splat/.modulebuildrc	2007-08-19 21:01:59 UTC (rev 3686)
@@ -0,0 +1 @@
+--install_base  t/var/splat




More information about the Bast-commits mailing list