utils/test_debuginfo.pl

   1 #!/usr/bin/perl
   2 #
   3 # This script tests debugging information generated by a compiler.
   4 # Input arguments
   5 #   - Input source program. Usually this source file is decorated using
   6 #     special comments to communicate debugger commands.
   7 #   - Executable file. This file is generated by the compiler.
   8 #
   9 # This perl script extracts debugger commands from input source program
  10 # comments in a script. A debugger is used to load the executable file
  11 # and run the script generated from source program comments. Finally,
  12 # the debugger output is checked, using FileCheck, to validate
  13 # debugging information.
  14
  15 use File::Basename;
  16
  17 my $testcase_file = $ARGV[0];
  18 my $executable_file = $ARGV[1];
  19
  20 my $input_filename = basename $testcase_file;
  21 my $output_dir = dirname $executable_file;
  22
  23 my $debugger_script_file = "$output_dir/$input_filename.debugger.script";
  24 my $output_file = "$output_dir/$input_filename.gdb.output";
  25
  26 # Extract debugger commands from testcase. They are marked with DEBUGGER:
  27 # at the beginning of a comment line.
  28 open(INPUT, $testcase_file);
  29 open(OUTPUT, ">$debugger_script_file");
  30 while(<INPUT>) {
  31     my($line) = $_;
  32     $i = index($line, "DEBUGGER:");
  33     if ( $i >= 0) {
  34         $l = length("DEBUGGER:");
  35         $s = substr($line, $i + $l);
  36         print OUTPUT  "$s";
  37     }
  38 }
  39 print OUTPUT "\n";
  40 print OUTPUT "quit\n";
  41 close(INPUT);
  42 close(OUTPUT);
  43
  44 # setup debugger and debugger options to run a script.
  45 my $my_debugger = $ENV{'DEBUGGER'};
  46 if (!$my_debugger) {
  47     $my_debugger = "gdb";
  48 }
  49 my $debugger_options = "-q -batch -n -x";
  50
  51 # run debugger and capture output.
  52 system("$my_debugger $debugger_options $debugger_script_file $executable_file > $output_file 2>&1");
  53
  54 # validate output.
  55 system("FileCheck", "-input-file", "$output_file", "$testcase_file");
  56 if ($?>>8 == 1) {
  57     exit 1;
  58 }
  59 else {
  60     exit 0;
  61 }