New mmqa command debug compiles a test case and launches the debugger.

Copied from Perforce
 Change: 192290
 ServerID: perforce.ravenbrook.com

mps/test/README

@@ -12,6 +12,7 @@ In a shell in the test directory::
     perl test/qa clib
     perl test/qa run function/5.c
     perl test/qa runset testsets/passing
+    perl test/qa debug argerr/12.c
 
 
 Usage and options
@@ -28,27 +29,21 @@ the variety (for example ``-v hot``) if the cool variety is not the
 one you want to test.
 
 
-Debugging on Unix
------------------
+Debugging
+---------
 
-Each test case is compiled in its turn to the file
-``test/obj/$PLATFORM/tmp_test`` so you can debug it with::
-
-    gdb test/obj/lii6gc/tmp_test
-
-Or ``lldb`` instead of ``gdb``. MMQA sets its own assertion handler,
-so you'll probably want to set a breakpoint on ``mmqa_assert_handler``.
+MMQA sets its own assertion handler, so you'll probably want to set a
+breakpoint on ``mmqa_assert_handler``.
 
 
-Testing on Windows
-------------------
+Windows
+-------
 
-In a Cygwin shell, from the test directory::
+Use a Cygwin shell. Set the ``LANG`` environment variable::
 
-    export LANG=C # avoid locale warnings from Perl.
-    perl test/qa clib
-    perl test/qa run function/5.c
-    perl test/qa runset testsets/passing
+    export LANG=C
+
+to avoid locale warnings from Perl.
 
 The runset command can result in this error::
 
@@ -60,12 +55,3 @@ Experience" service, and switching "Startup type" to "Automatic". See
 the documentation for LNK1168_.
 
 .. _LNK1168: https://msdn.microsoft.com/en-us/library/hhbdtt6d.aspx
-
-At present, the easiest way to debug a test case is to edit
-test/test/script/platform and set::
-
-    $comwrap = "vsjitdebugger \"";
-
-But see job004020_.
-
-.. _job004020: https://www.ravenbrook.com/project/mps/issue/job004020/

mps/test/test/script/commands/debug

@@ -0,0 +1,16 @@
+#!/usr/bin/perl -w
+# $Id$
+#
+# debug a test
+
+&requiredoptions(
+ "MPS_INCLUDE_DIR",
+ "MPS_LINK_OBJ",
+ "VARIETY",
+ "PLATFORM",
+ "LOG_DIR"
+);
+
+foreach $testfile (@ARGV) {
+ &debugtest($testfile);
+}

mps/test/test/script/help/debug

@@ -0,0 +1,11 @@
+debug a test
+% $Id$
+
+Usage: qa debug [<options>] <testfile>
+
+'debug' launches a test in the debugger. The test libraries should
+previously have been compiled with 'clib'; if the harness believes the
+test libraries may not be up-to-date, it will give an error and ask
+you to run 'clib' first. (You can force the harness to run a test with
+potentially out-of-date libraries by specifying the "-danger" option
+to 'debug'. This is not recommended.)

mps/test/test/script/options

@@ -40,7 +40,7 @@ sub platform_detect {
    $platform_os = "xx";
    $platform_ct = "xx";
   }
-  local $processor = `uname -p`;
+  local $processor = `uname -m`;
   chomp($processor);
   if ($processor eq "i386") {
    $platform_ar = "i3";

mps/test/test/script/platform

@@ -43,6 +43,7 @@ sub settings_nt {
  $dirsep = "/";
  $link_obj = "$PLATFORM/$VARIETY/mps.obj";
  $make_command = "nmake /f $PLATFORM.nmk VARIETY=$VARIETY $link_obj";
+ $debug_command = "vsjitdebugger";
  $cc_command = "cl";
  $cc_opts = "/nologo /DWIN32 /D_WINDOWS /D_CRT_SECURE_NO_WARNINGS /W3 /Zi /Oy- /MD";
  $cc_link = "$obj_dir/platform.obj";
@@ -91,10 +92,13 @@ sub settings_unix {
  $cc_link_opts = "-z muldefs";
  if ($PLATFORM =~ /ll$/) {
   $cc_command = "clang";
+  $debug_command = "lldb";
  } elsif ($PLATFORM =~ /gc$/) {
   $cc_command = "gcc";
+  $debug_command = "gdb";
  } else {
   $cc_command = "cc";
+  $debug_command = "gdb";
  }
  $cc_opts = "-ansi -pedantic -Wall -Wstrict-prototypes ".
   "-Winline -Waggregate-return -Wnested-externs -Wcast-qual ".
@@ -145,6 +149,7 @@ sub settings_macosx {
  }
  $link_obj = "xc/$config/libmps.a";
  $make_command = "xcodebuild -project mps.xcodeproj -config $config -target mps";
+ $debug_command = "lldb";
  $cc_command = "clang";
  $cc_link = "$obj_dir/platform.o";
  $cc_link_opts =~ s/-z muldefs//;

mps/test/test/script/runtest

@@ -269,3 +269,35 @@ sub missingTestSymbols {
  return &missingSymbols(&listFileSymbols($testfile));
 }
 
+
+sub debugtest {
+ local ($testfile,) = @_;
+
+ &readheader($testfile, 1);
+
+ unless (vleq($test_header{"harness"}, $HARNESS_VERSION)) {
+  die "This test requires version $test_header{\"harness\"} or later of the MMQA harness.
+(You are using version $HARNESS_VERSION.)\n";
+ }
+
+ for $lang ($test_header{"language"}) {
+  if ($lang =~ /^c$/) {
+   unless ($DANGEROUS eq "on") {
+    $_ = &test_clib();
+    if ($_) {
+     print "Warning: $_\n";
+     die "-- recompile test libraries (\"qa clib\") before debugging tests.\n";
+    }
+   }
+   $linkfiles = $test_header{"link"};
+   $objfile = "$obj_dir/tmp_test";
+   if (&compile_and_link($testfile, $objfile, $linkfiles)) {
+    mysystem("$debug_command $objfile")
+   } else {
+    die "compilation failed:\n$compoutput";
+   }
+  } else {
+   die "Don't know how to debug tests in the $lang language.\n";
+  }
+ }
+}