mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-26 05:49:27 +01:00
compiler_vm: updated to show local vars if no output, etc
This commit is contained in:
parent
84f2f979a6
commit
d56aaeebca
@ -13,8 +13,8 @@ use warnings;
|
||||
# These are set automatically by the build/commit script
|
||||
use constant {
|
||||
BUILD_NAME => "PBot",
|
||||
BUILD_REVISION => 351,
|
||||
BUILD_DATE => "2012-01-27",
|
||||
BUILD_REVISION => 352,
|
||||
BUILD_DATE => "2012-01-29",
|
||||
};
|
||||
|
||||
1;
|
||||
|
@ -8,12 +8,12 @@ my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
|
||||
my %languages = (
|
||||
'C' => {
|
||||
'cmdline' => 'gcc $args $file -o prog -ggdb',
|
||||
'args' => '-Wextra -Wall -Wno-unused -std=gnu89',
|
||||
'args' => '-Wextra -Wall -Wno-unused -std=gnu89 -lm',
|
||||
'file' => 'prog.c',
|
||||
},
|
||||
'C++' => {
|
||||
'cmdline' => 'g++ $args $file -o prog -ggdb',
|
||||
'args' => '',
|
||||
'args' => '-lm',
|
||||
'file' => 'prog.cpp',
|
||||
},
|
||||
'C99' => {
|
||||
@ -21,6 +21,11 @@ my %languages = (
|
||||
'args' => '-Wextra -Wall -Wno-unused -pedantic -std=c99 -lm',
|
||||
'file' => 'prog.c',
|
||||
},
|
||||
'C11' => {
|
||||
'cmdline' => 'gcc $args $file -o prog -ggdb',
|
||||
'args' => '-Wextra -Wall -Wno-unused -pedantic -std=c11 -lm',
|
||||
'file' => 'prog.c',
|
||||
},
|
||||
);
|
||||
|
||||
sub runserver {
|
||||
@ -58,6 +63,8 @@ sub runserver {
|
||||
print $output "result:$result\n";
|
||||
print $output "result:end\n";
|
||||
|
||||
system("rm *");
|
||||
|
||||
if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
|
||||
print "input: ";
|
||||
next;
|
||||
@ -75,7 +82,7 @@ sub runserver {
|
||||
($lang, $user_args, $user_input) = split /:/, $options;
|
||||
|
||||
$code = "";
|
||||
$lang = "C99" if not defined $lang;
|
||||
$lang = "C11" if not defined $lang;
|
||||
$user_args = "" if not defined $user_args;
|
||||
$user_input = "" if not defined $user_input;
|
||||
|
||||
@ -139,7 +146,7 @@ sub interpret {
|
||||
}
|
||||
|
||||
my $user_input_quoted = quotemeta $user_input;
|
||||
($ret, $result) = execute(5, "./compiler_watchdog.pl $user_input_quoted");
|
||||
($ret, $result) = execute(60, "compiler_watchdog.pl $user_input_quoted");
|
||||
|
||||
$result =~ s/^\s+//;
|
||||
$result =~ s/\s+$//;
|
||||
|
@ -7,24 +7,98 @@ use IPC::Open2;
|
||||
|
||||
my $stdin_input = join ' ', @ARGV;
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
my $watching = 0;
|
||||
my $got_output = 0;
|
||||
my $local_vars = "";
|
||||
|
||||
sub execute {
|
||||
my ($cmdline) = @_;
|
||||
my ($ret, $result);
|
||||
|
||||
my ($out, $in);
|
||||
open2($out, $in, "$cmdline 2>&1");
|
||||
#print $in "$stdin_input\n";
|
||||
|
||||
while(my $line = <$out>) {
|
||||
chomp $line;
|
||||
#print "got: [$line]\n";
|
||||
print "-- got: [$line]\n" if $debug >= 1;
|
||||
|
||||
my $ignore_response = 0;
|
||||
|
||||
next if not length $line;
|
||||
next if $line =~ m/^\(gdb\) Continuing/;
|
||||
next if $line =~ m/^\(gdb\) \$\d+ = "Ok\."/;
|
||||
next if $line =~ m/^(\(gdb\) )?Breakpoint \d+ at 0x/;
|
||||
next if $line =~ m/^(\(gdb\) )?Starting program/;
|
||||
next if $line =~ m/^\d+: .*? =/;
|
||||
|
||||
if($line =~ m/^Reading symbols from.*done\.$/) {
|
||||
print $in "break gdb\n";
|
||||
#<$out>;
|
||||
|
||||
print $in "list main\n";
|
||||
print $in "print \"Ok.\"\n";
|
||||
while(my $line = <$out>) {
|
||||
chomp $line;
|
||||
print "list got: [$line]\n" if $debug >= 4;
|
||||
if($line =~ m/^(\d+)\s+return 0;/) {
|
||||
print $in "break $1\n";
|
||||
}
|
||||
|
||||
last if $line =~ m/^\(gdb\) \$\d+ = "Ok."/;
|
||||
}
|
||||
|
||||
print $in "run\n";
|
||||
next;
|
||||
}
|
||||
|
||||
if($line =~ m/^Breakpoint \d+, main/) {
|
||||
my $line = <$out>;
|
||||
print "== got: $line\n" if $debug >= 5;
|
||||
if($line =~ m/^\d+\s+return 0;$/) {
|
||||
if($got_output == 0) {
|
||||
print "no output, checking locals\n" if $debug >= 5;
|
||||
print $in "info locals\nprint \"Ok.\"\n";
|
||||
my $result = "";
|
||||
my $vars = "";
|
||||
my $varsep = "";
|
||||
|
||||
while(my $line = <$out>) {
|
||||
chomp $line;
|
||||
print "got: [$line]\n" if $debug >= 5;
|
||||
last if $line =~ m/\(gdb\) \$\d+ = "Ok."/;
|
||||
if($line =~ m/([^=]+)=\s+(.*)/) {
|
||||
$vars .= "$varsep$1= $2";
|
||||
$varsep = "; ";
|
||||
}
|
||||
}
|
||||
|
||||
$result =~ s/^\s+//;
|
||||
$result =~ s/\s+$//;
|
||||
|
||||
$vars =~ s/\(gdb\)\s*//g;
|
||||
$local_vars = "<local variables: $vars>" if length $vars;
|
||||
|
||||
print $in "cont\n";
|
||||
next;
|
||||
} else {
|
||||
print $in "cont\n";
|
||||
next;
|
||||
}
|
||||
} else {
|
||||
print $in "cont\n";
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if($line =~ m/Breakpoint \d+, gdb/) {
|
||||
print $in "up\n";
|
||||
$line = <$out>;
|
||||
print "ignored $line\n" if $debug >= 2;
|
||||
$line = <$out>;
|
||||
print "ignored $line\n" if $debug >= 2;
|
||||
next;
|
||||
}
|
||||
|
||||
@ -36,20 +110,68 @@ sub execute {
|
||||
$line = "1 gdb(\"print $1\");";
|
||||
}
|
||||
|
||||
if($line =~ m/^\d+\s+print\((.*)\)/) {
|
||||
$line = "1 gdb(\"print $1\");";
|
||||
}
|
||||
|
||||
if($line =~ m/^\d+\s+ptype\((.*)\)/) {
|
||||
$line = "1 gdb(\"ptype $1\");";
|
||||
}
|
||||
|
||||
if($line =~ m/^\d+\s+gdb\("(.*)"\);/) {
|
||||
if($line =~ m/^\d+\s+.*gdb\("(.*)"\)/) {
|
||||
my $command = $1;
|
||||
print $in "$command\n";
|
||||
my ($cmd, $args) = split / /, $command, 2;
|
||||
$args = "" if not defined $args;
|
||||
|
||||
#print "got command [$command]\n";
|
||||
|
||||
if($cmd eq "watch") {
|
||||
print $in "display $args\n";
|
||||
#<$out>;
|
||||
$watching++;
|
||||
$ignore_response = 1;
|
||||
}
|
||||
|
||||
print $in "$command\nprint \"Ok.\"\n";
|
||||
my $next_line = <$out>;
|
||||
chomp $next_line;
|
||||
#print "nextline: $next_line\n";
|
||||
|
||||
$next_line =~ s/^\(gdb\)\s*\(gdb\)\s+\$\d+ = "Ok."//;
|
||||
$next_line =~ s/^\(gdb\)\s+\$\d+//;
|
||||
$next_line =~ s/^\(gdb\)\s+type//;
|
||||
print "$args$next_line\n" if $next_line =~ m/=/;
|
||||
|
||||
if(not $ignore_response) {
|
||||
if($next_line =~ m/=/) {
|
||||
$got_output = 1;
|
||||
print "<$args$next_line>\n";
|
||||
} else {
|
||||
print "<$next_line>\n" if length $next_line;
|
||||
$got_output = 1 if length $next_line;
|
||||
}
|
||||
}
|
||||
|
||||
print $in "cont\n";
|
||||
next;
|
||||
}
|
||||
|
||||
if($line =~ m/^Watchpoint \d+: (.*)/) {
|
||||
my $var = $1;
|
||||
|
||||
my $ignore = <$out>;
|
||||
print "ignored $ignore\n" if $debug >= 5;
|
||||
my $old = <$out>;
|
||||
my $new = <$out>;
|
||||
$ignore = <$out>;
|
||||
print "ignored $ignore\n" if $debug >= 5;
|
||||
$ignore = <$out>;
|
||||
print "ignored $ignore\n" if $debug >= 5;
|
||||
|
||||
my ($val1) = $old =~ m/Old value = (.*)/;
|
||||
my ($val2) = $new =~ m/New value = (.*)/;
|
||||
|
||||
$got_output = 1;
|
||||
print "<$var = $val2>\n";
|
||||
print $in "cont\n";
|
||||
next;
|
||||
}
|
||||
@ -66,6 +188,7 @@ sub execute {
|
||||
my ($val1) = $old =~ m/Old value = (.*)/;
|
||||
my ($val2) = $new =~ m/New value = (.*)/;
|
||||
|
||||
$got_output = 1;
|
||||
print "<$var changed: $val1 => $val2>\n";
|
||||
print $in "cont\n";
|
||||
next;
|
||||
@ -73,21 +196,55 @@ sub execute {
|
||||
|
||||
if($line =~ m/^Watchpoint \d+ deleted/) {
|
||||
my $ignore = <$out>;
|
||||
print "ignored $ignore\n" if $debug >= 5;
|
||||
$ignore = <$out>;
|
||||
print "ignored $ignore\n" if $debug >= 5;
|
||||
print $in "cont\n";
|
||||
next;
|
||||
}
|
||||
|
||||
if($line =~ m/^Program exited/) {
|
||||
print " $local_vars\n" if length $local_vars and not $got_output;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ s/\[Inferior .* exited with code (\d+)\]//) {
|
||||
print "$line\n";
|
||||
print "<Exit $1>\n";
|
||||
print " $local_vars\n" if length $local_vars and not $got_output;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ s/\[Inferior .* exited normally\]//) {
|
||||
print "$line\n" if length $line;
|
||||
$got_output = 1 if length $line;
|
||||
print " $local_vars\n" if length $local_vars and not $got_output;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ m/Program received signal SIGTRAP/) {
|
||||
my $line = <$out>;
|
||||
print "ignored $line\n" if $debug >= 5;
|
||||
$line = <$out>;
|
||||
print "ignored $line\n" if $debug >= 5;
|
||||
for(my $i = 0; $i < $watching; $i++) {
|
||||
$line = <$out>;
|
||||
chomp $line;
|
||||
$line =~ s/^\d+:\s//;
|
||||
$got_output = 1;
|
||||
print "<$line>\n";
|
||||
}
|
||||
print $in "cont\n";
|
||||
next;
|
||||
}
|
||||
|
||||
if($line =~ m/Program received signal/) {
|
||||
my $result = "";
|
||||
my $vars = "";
|
||||
my $varsep = "";
|
||||
|
||||
$line =~ s/\.$//;
|
||||
$got_output = 1;
|
||||
print "$line ";
|
||||
|
||||
print $in "up\nup\nup\nup\nup\nup\nup\ninfo locals\nquit\ny\n";
|
||||
@ -122,13 +279,15 @@ sub execute {
|
||||
$result =~ s/\s+$//;
|
||||
|
||||
$vars =~ s/\(gdb\)\s*//g;
|
||||
$vars = " [local variables: $vars]" if length $vars;
|
||||
$vars = " <local variables: $vars>" if length $vars;
|
||||
|
||||
print "$result$vars\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ m/^\(gdb\)/) {
|
||||
if($line =~ s/^\(gdb\)\s*//) {
|
||||
$got_output = 1;
|
||||
print "<$line>\n";
|
||||
next;
|
||||
}
|
||||
|
||||
@ -136,6 +295,7 @@ sub execute {
|
||||
|
||||
next if not length $line;
|
||||
|
||||
$got_output = 1;
|
||||
print "$line\n";
|
||||
}
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user