| #!/usr/bin/perl | 
 | # | 
 | # This script tests debugging information generated by a compiler. | 
 | # Input arguments | 
 | #   - Input source program. Usually this source file is decorated using | 
 | #     special comments to communicate debugger commands. | 
 | #   - Executable file. This file is generated by the compiler. | 
 | # | 
 | # This perl script extracts debugger commands from input source program | 
 | # comments in a script. A debugger is used to load the executable file | 
 | # and run the script generated from source program comments. Finally, | 
 | # the debugger output is checked, using FileCheck, to validate | 
 | # debugging information. | 
 | # | 
 | # On Darwin the default is to use the llgdb.py wrapper script which | 
 | # translates gdb commands into their lldb equivalents. | 
 |  | 
 | use File::Basename; | 
 | use Config; | 
 | use Cwd; | 
 |  | 
 | my $testcase_file = $ARGV[0]; | 
 | my $executable_file = $ARGV[1]; | 
 |  | 
 | my $input_filename = basename $testcase_file; | 
 | my $output_dir = dirname $executable_file; | 
 |  | 
 | my $debugger_script_file = "$output_dir/$input_filename.debugger.script"; | 
 | my $output_file = "$output_dir/$input_filename.gdb.output"; | 
 |  | 
 | my %cmd_map = (); | 
 | # Assume lldb to be the debugger on Darwin. | 
 | my $use_lldb = 0; | 
 | $use_lldb = 1 if ($Config{osname} eq "darwin"); | 
 |  | 
 | # Extract debugger commands from testcase. They are marked with DEBUGGER: | 
 | # at the beginning of a comment line. | 
 | open(INPUT, $testcase_file); | 
 | open(OUTPUT, ">$debugger_script_file"); | 
 | while(<INPUT>) { | 
 |     my($line) = $_; | 
 |     $i = index($line, "DEBUGGER:"); | 
 |     if ( $i >= 0) { | 
 |         $l = length("DEBUGGER:"); | 
 |         $s = substr($line, $i + $l); | 
 |         print OUTPUT  "$s"; | 
 |     } | 
 | } | 
 | print OUTPUT "\n"; | 
 | print OUTPUT "quit\n"; | 
 | close(INPUT); | 
 | close(OUTPUT); | 
 |  | 
 | # setup debugger and debugger options to run a script. | 
 | my $my_debugger = $ENV{'DEBUGGER'}; | 
 | if (!$my_debugger) { | 
 |     if ($use_lldb) { | 
 |         my $path = dirname(Cwd::abs_path($0)); | 
 |         # At least on darwin, LLDB needs te system python. | 
 |         $my_debugger = "/usr/bin/python $path/llgdb.py"; | 
 |     } else { | 
 |         $my_debugger = "gdb"; | 
 |     } | 
 | } | 
 |  | 
 | # quiet / exit after cmdline / no init file / execute script | 
 | my $debugger_options = "-q -batch -n -x"; | 
 |  | 
 | # run debugger and capture output. | 
 | system("$my_debugger $debugger_options $debugger_script_file $executable_file > $output_file 2>&1"); | 
 |  | 
 | # validate output. | 
 | system("FileCheck", "-input-file", "$output_file", "$testcase_file"); | 
 | if ($?>>8 == 1) { | 
 |     print "Debugger output was:\n"; | 
 |     system("cat", "$output_file"); | 
 |     exit 1; | 
 | } | 
 | else { | 
 |     exit 0; | 
 | } |