[Catalyst-commits] r11929 - Catalyst-Runtime/5.80/branches/better_scripts/t/aggregate

t0m at dev.catalyst.perl.org t0m at dev.catalyst.perl.org
Fri Nov 20 01:01:48 GMT 2009


Author: t0m
Date: 2009-11-20 01:01:47 +0000 (Fri, 20 Nov 2009)
New Revision: 11929

Added:
   Catalyst-Runtime/5.80/branches/better_scripts/t/aggregate/unit_core_script_test.t
Log:
Fugly test for myapp_test.pl. If someone fancies rewriting the IO redirection to be less gross then I loveyoulongtime

Added: Catalyst-Runtime/5.80/branches/better_scripts/t/aggregate/unit_core_script_test.t
===================================================================
--- Catalyst-Runtime/5.80/branches/better_scripts/t/aggregate/unit_core_script_test.t	                        (rev 0)
+++ Catalyst-Runtime/5.80/branches/better_scripts/t/aggregate/unit_core_script_test.t	2009-11-20 01:01:47 UTC (rev 11929)
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+
+use Test::More;
+use Test::Exception;
+
+use Catalyst::Script::Test;
+use File::Temp qw/tempfile/;
+use IO::Handle;
+
+my ($fh, $fn) = tempfile();
+
+binmode( $fh );
+binmode( STDOUT );
+
+{
+    local @ARGV = ('/');
+    my $i;
+    lives_ok {
+        $i = Catalyst::Script::Test->new_with_options(application_name => 'TestApp');
+    } "new_with_options";
+    ok $i;
+    my $saved;
+    open( $saved, '<&'. STDIN->fileno )
+          or croak("Can't dup stdin: $!");
+    open( STDOUT, '>&='. $fh->fileno )
+        or croak("Can't open stdout: $!");
+    eval { $i->run };
+    ok !$@, 'Ran ok';
+
+    STDOUT->flush
+        or croak("Can't flush stdout: $!");
+
+    open( STDOUT, '>&'. fileno($saved) )
+        or croak("Can't restore stdout: $!");
+}
+
+my $data = do { my $fh; open($fh, '<', $fn) or die $!; local $/; <$fh>; };
+$fh = undef;
+unlink $fn if -r $fn;
+
+is $data, "root index\n", 'correct content printed';
+
+done_testing;
+




More information about the Catalyst-commits mailing list