Permalink
Browse files

(failing) redirection test

  • Loading branch information...
1 parent da87a8a commit 6df277f4430e0bc9dc4a59f806d663f0f2301349 @moritz committed Jun 26, 2010
Showing with 26 additions and 7 deletions.
  1. +3 −0 README
  2. +4 −2 lib/CGI/Application.pm
  3. +19 −5 t/basic.t
View
3 README
@@ -6,6 +6,9 @@ module are realized as $app.param = $p in the Perl 6 port.
Very much a work in progress. Contributes are very welcome.
+Status:
+ * basic dispatch works
+
License:
I've contacted the authors of Perl 5 CGI::Application to get
View
@@ -10,6 +10,7 @@ has $.error-mode is rw;
# TODO: type-restrict it to any <header none redirect>
has $.header-type is rw = 'header';
+has %.header-props is rw;
has $.current-runmode is rw;
@@ -61,10 +62,11 @@ multi method __get_runmeth($rm) {
multi method __get_body($rm) {
my $method-name = $.__get_runmeth($rm);
- my $body = try { self."$method-name"() };
+ my $body;
+ try { $body = self."$method-name"() };
if $! {
my $error = $!;
- $.call-hook('error', $error);
+# $.call-hook('error', $error);
if $.error-mode {
$body = self."$.error-mode"();
} else {
View
@@ -17,10 +17,8 @@ use CGI::Application;
sub response-like($app, Mu $header, Mu $body, $comment) {
my $output = $app.run;
my @hb = $output.split(rx{\r?\n\r?\n});
-# diag "Header: @hb[0]";
-# diag "Body: @hb[1]";
- ok ?(@hb[0] ~~ $header), "$comment (header)";
- ok ?(@hb[1] ~~ $body), "$comment (body)";
+ ok ?(@hb[0] ~~ $header), "$comment (header)" or diag "Got: @hb[0].perl()";
+ ok ?(@hb[1] ~~ $body), "$comment (body)" or diag "Got: @hb[1].perl()";
}
{
@@ -35,8 +33,8 @@ sub response-like($app, Mu $header, Mu $body, $comment) {
);
}
+use TestApp;
{
- use TestApp;
my $app = TestApp.new();
isa_ok $app, CGI::Application;
@@ -48,6 +46,22 @@ sub response-like($app, Mu $header, Mu $body, $comment) {
);
}
+{
+ dies_ok { TestApp.new(query => [1, 2, 3]) },
+ 'query is restricted to Associative';
+}
+
+{
+ my $app = TestApp.new(query => { test_rm => 'redirect_test' });
+ response-like(
+ $app,
+ rx{^'Status: 302'},
+ rx{^'Hello World: redirect_test'},
+ 'TestApp, redirect_test',
+ );
+
+}
+
done_testing;
# vim: ft=perl6

0 comments on commit 6df277f

Please sign in to comment.