Permalink
Browse files

Add subroutine to see if an expression is valid

  • Loading branch information...
1 parent b8d4e4e commit c72d9d4ca513a4ebc5dd8973a9ff332ff12b00bd Rocky Bernstein committed Dec 24, 2012
Showing with 60 additions and 9 deletions.
  1. +8 −7 bin/trepan.pl
  2. +6 −1 lib/Devel/Trepan/DB.pm
  3. +26 −1 lib/Devel/Trepan/Util.pm
  4. +20 −0 t/10test-util.t
View
@@ -16,6 +16,7 @@
use lib $TREPAN_DIR;
use Devel::Trepan::Options;
use Devel::Trepan::Client;
+ use Devel::Trepan::Util;
use Data::Dumper;
EOE
die $EVAL_ERROR if $EVAL_ERROR;
@@ -32,8 +33,7 @@
my @exec_strs_with_e = map {('-e', qq{'$_'})} @exec_strs;
my $cmd;
if (scalar @exec_strs) {
- $cmd = "$EXECUTABLE_NAME -c " . join(' ', @exec_strs_with_e) .
- join(' ', @ARGV) . " 2>&1";
+ $cmd = join(' ', @exec_strs_with_e) . join(' ', @ARGV);
@exec_strs_with_e = map {('-e', qq{$_})} @exec_strs;
} else {
die "You need a Perl program to run or pass an string to eval"
@@ -42,12 +42,13 @@
# Resolve program name if it is not readable
$ARGV[0] = whence_file($ARGV[0]) unless -r $ARGV[0];
# Check that the debugged Perl program is syntactically valid.
- $cmd = "$EXECUTABLE_NAME -c " . join(' ', @ARGV) . " 2>&1";
+ $cmd = join(' ', @ARGV);
+}
+my $syntax_errmsg = Devel::Trepan::Util::invalid_perl_syntax($cmd, 1);
+if ($syntax_errmsg) {
+ print STDERR "$syntax_errmsg\n";
+ exit -1;
}
-my $output = `$cmd`;
-my $rc = $? >>8;
-print "$output\n" if $rc;
-exit $rc if $rc;
$opts->{dollar_0} = $ARGV[0];
$ENV{'TREPANPL_OPTS'} = Data::Dumper::Dumper($opts);
View
@@ -322,7 +322,12 @@ sub DB {
# FIXME: allow more than just scalar contexts.
my $eval_result =
&DB::eval_with_return($disp->arg, $opts, @saved);
- my $mess = sprintf("%d: $eval_result", $disp->number);
+ my $mess;
+ if (defined($eval_result)) {
+ $mess = sprintf("%d: $eval_result", $disp->number);
+ } else {
+ $mess = sprintf("%d: undef", $disp->number);
+ }
$c->output($mess);
}
View
@@ -1,7 +1,9 @@
# -*- coding: utf-8 -*-
# Copyright (C) 2011, 2012 Rocky Bernstein <rocky@cpan.org>
-use strict; use warnings;
+
package Devel::Trepan::Util;
+use strict; use warnings; use English qw( -no_match_vars );
+
use vars qw(@EXPORT @ISA @YN);
@EXPORT = qw( hash_merge safe_repr uniq_abbrev extract_expression
parse_eval_suffix parse_eval_sigil
@@ -115,6 +117,22 @@ sub invalid_filename($)
return undef;
}
+# Return 'undef' arg $cmd_str is ok. If not return the message a Perl -c
+# gives, dropping off the "-e had complation errors" message.
+sub invalid_perl_syntax($;$)
+{
+ my ($cmd_str, $have_e_opt) = @_;
+ my $cmd = sprintf("$EXECUTABLE_NAME -c %s",
+ $have_e_opt ? $cmd_str : "-e '$cmd_str'");
+ my $output = `$cmd 2>&1`;
+ my $rc = $? >>8;
+ return undef if 0 == $rc;
+ # Drop off: -e had compilation errors.
+ my @errmsg = split(/\n/, $output);
+ pop @errmsg;
+ return join("\n", @errmsg);
+}
+
sub parse_eval_suffix($)
{
my $cmd = shift;
@@ -194,6 +212,13 @@ unless (caller) {
printf "bool2YN($resp_str) => '%s'\n", bool2YN($resp);
}
+ for my $expr ('1+', '{cmd=5}') {
+ print invalid_perl_syntax($expr), "\n";
+ }
+ for my $expr ('-e "$x="', '-e "(1,2"') {
+ print invalid_perl_syntax($expr, 1), "\n";
+ }
+
}
1;
View
@@ -111,4 +111,24 @@ for my $pair
is($result, $expect, 'bool2YN of ' . ($resp || 'undef'));
}
+for my $expr ('1+', '{cmd=5}') {
+ ok(Devel::Trepan::Util::invalid_perl_syntax($expr),
+ "invalid perl expression '$expr'");
+
+}
+for my $expr ('-e "$x="', '-e "(1,2"') {
+ ok(Devel::Trepan::Util::invalid_perl_syntax($expr, 1),
+ "invalid perl expression '$expr'");
+}
+
+for my $expr ('-e "\$x=1"', '-e "(1,2)"') {
+ ok(!Devel::Trepan::Util::invalid_perl_syntax($expr, 1),
+ "valid perl expression '$expr'");
+}
+
+for my $expr ('\$x=2', '-e "{a => 1}"') {
+ ok(!Devel::Trepan::Util::invalid_perl_syntax($expr, 1),
+ "valid perl expression '$expr'");
+}
+
done_testing();

0 comments on commit c72d9d4

Please sign in to comment.