Better error checking, and make try not too reserved

lib/TryCatch.pm

@@ -88,38 +88,34 @@ sub _parse_try {
 
   my $ctx = Devel::Declare::Context::Simple->new->init(@_);
 
-  if (my $len = Devel::Declare::toke_scan_ident( $ctx->offset )) {
-    $ctx->inc_offset($len);
-    $ctx->skipspace;
+  $ctx->skip_declarator;
+  $ctx->skipspace;
 
-    my $linestr = $ctx->get_linestr;
-    croak "block required after try"
-      unless substr($linestr, $ctx->offset, 1) eq '{';
+  my $linestr = $ctx->get_linestr;
 
-    substr($linestr, $ctx->offset+1,0) = q# BEGIN { TryCatch::postlude() }#;
-    substr($linestr, $ctx->offset,0) = q#(sub #;
-    $ctx->set_linestr($linestr);
+  return if substr($linestr, $ctx->offset, 2) eq '=>';
 
-    if (! $CHECK_OP_DEPTH++) {
-      $CHECK_OP_HOOK = TryCatch::XS::install_return_op_check();
-    }
+  croak "block required after try"
+    unless substr($linestr, $ctx->offset, 1) eq '{';
 
-  }
-
-}
+  substr($linestr, $ctx->offset+1,0) = q# BEGIN { TryCatch::postlude() }#;
+  substr($linestr, $ctx->offset,0) = q#(sub #;
+  $ctx->set_linestr($linestr);
 
-sub prelude {
-  my ($ctx, $linestr) = @_;
+  if (! $CHECK_OP_DEPTH++) {
+    $CHECK_OP_HOOK = TryCatch::XS::install_return_op_check();
+  }
 
-  substr($linestr, $ctx->offset+1, 0, 
-         "BEGIN { TryCatch::postlude }; local *_{ARRAY}");
+
 }
 
 sub postlude {
   on_scope_end { block_postlude() }
 }
 
 # Called after the block from try {} or catch {}
+# Look ahead and determine what action to take based on wether or note we
+# see a 'catch' token after the block
 sub block_postlude {
 
   my $ctx = Devel::Declare::Context::Simple->new->init(
@@ -140,6 +136,7 @@ sub block_postlude {
   if (--$CHECK_OP_DEPTH == 0) {
     TryCatch::XS::uninstall_return_op_check($CHECK_OP_HOOK);
   }
+
   if ($toke eq 'catch') {
 
     $ctx->skipspace;
@@ -159,6 +156,7 @@ sub _parse_catch {
   my $pack = shift;
   my $ctx = Devel::Declare::Context::Simple->new->init(@_);
 
+  # Only parse catch when we've been told to (set in block_postlude)
   return unless $TryCatch::PARSE_CATCH_NEXT;
   $TryCatch::PARSE_CATCH_NEXT = 0;
 
@@ -172,7 +170,7 @@ sub _parse_catch {
 
   my $len = length "->catch";
   my $sub = substr($linestr, $ctx->offset, $len);
-  die "_parse_catch expects to find '->catch' in linestr, found: "  
+  croak "Internal Error: _parse_catch expects to find '->catch' in linestr, found: "  
     . substr($linestr, $ctx->offset, $len)
     unless $sub eq '->catch';
 
@@ -196,7 +194,7 @@ sub _parse_catch {
 
     my $left = $sig->remaining_input;
 
-    die "can't handle un-named vars yet" unless $param->can('variable_name');
+    croak "TryCatch can't handle un-named vars in catch signature" unless $param->can('variable_name');
 
     my $name = $param->variable_name;
     $var_code .= "my $name = \$@;";

t/invalid.t

@@ -1,78 +1,115 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More tests => 8;
 use Test::Exception;
+use TryCatch;
 
-BEGIN { use_ok "TryCatch" or BAIL_OUT("Cannot load TryCatch") };
-#use TryCatch;
+test_for_error(
+  qr/^block required after try at .*? line 4$/, 
+  "no block after try",
+  <<'EOC' );
+use TryCatch;
 
-eval <<'EOC';
-  use TryCatch;
+sub foo { }
+try \&foo
+EOC
 
-  sub foo { }
-  try \&foo
 
-EOC
+test_for_error(
+  qr/^block required after catch at \(eval \d+\) line 6$/,
+  "no block after catch",
+  <<'EOC');
+use TryCatch;
 
-like $@, 
-     qr!^block required after try at \(eval \d+\) line \d+$!,
-     "no block after try";
-#warn "q{$@}";
+try { 1 }
+catch 
+EOC
 
-undef $@;
-eval <<'EOC';
-  use TryCatch;
 
-  try { 1; }
-  catch 
+test_for_error(
+   qr/^Parameter expected near '\^' in '\^Err \$e' at \(eval \d+\) line 4$/,
+   "invalid catch signature",
+  <<'EOC');
+use TryCatch;
 
+try { }
+catch (^Err $e) {}
 EOC
 
-like $@, 
-     qr!^block required after catch at \(eval \d+\) line \d+$!,
-     "no block after catch";
-#warn "q{$@}";
 
-undef $@;
-eval <<'EOC';
-  use TryCatch;
+TODO: { 
+local $TODO = "Make this error better";
 
-  try { }
-  catch (^Err $e) {}
+test_for_error(
+  qr!^'\)' required after catch signature at \(eval \d+\) line 4!,
+  "invalid catch signature (missing parenthesis)",
+  <<'EOC');
+use TryCatch;
+
+try { }
+catch ( {}
 
 EOC
 
-like $@, 
-     qr!^Parameter expected near '\^' in '\^Err \$e' at\E \(eval \d+\) line \d+$!,
-     "invalid catch signature";
-#warn "q{$@}";
+}
+
 
-undef $@;
-eval <<'EOC';
-  use TryCatch;
+test_for_error(
+  qr/^Can't locate object method "bar" via package "catch" .*?at \(eval \d+\) line 3\b/,
+  "bareword between try and catch",
+  <<'EOC');
+use TryCatch;
 
-  try { }
-  catch ( {}
+try { } bar
+catch {}
 
 EOC
 
-TODO: { 
-local $TODO = "Make this error better";
-like $@, 
-     qr!^'\)' required after catch signature at \(eval \d+\) line \d+!,
-     "invalid catch signature (missing parenthesis)";
-}
+test_for_error(
+  qr/^Bareword "catch" not allowed while "strict subs" in use at \(eval \d+\) line 3\b/,
+  "catch is not special", 
+  <<'EOC');
+use TryCatch;
+
+catch;
+EOC
 
+compile_ok("try is not too reserved", <<'EOC');
+use TryCatch;
 
-eval <<'EOC';
-  use TryCatch;
+try => 1;
+EOC
 
-  try { } bar
-  catch {}
+compile_ok(
+  "catch is not special", 
+  <<'EOC');
+use TryCatch;
 
+catch => 3;
 EOC
 
-like $@, 
-     qr!^Can't locate object method "bar" via package "catch" .*?at \(eval \d+\) line \d+\.?$!,
-     "bareword between try and catch";
+sub test_for_error {
+  my ($re, $msg, $code) = @_;
+  try {
+    eval $code;
+    die $@ if $@;
+    fail($msg);
+  }
+  catch ($e) {
+    like($e, $re, $msg);
+  }
+}
+
+sub compile_ok {
+  my ($msg, $code) = @_;
+  try {
+    eval $code;
+    die $@ if $@;
+    pass($msg);
+  }
+  catch ($e) {
+    diag($e);
+    fail($msg);
+  }
+}