From 0867fe4dde3eeeb870180f09e98baf794f59da77 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 12 Sep 2016 09:48:55 +0100
Subject: [PATCH 1/6] Branching master to branch/2016-09-12/job004020.

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

From 3f13486e08b6d04b668a827b92de83f52ec2f034 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 12 Sep 2016 11:55:36 +0100
Subject: [PATCH 2/6] Usability improvements for mmqa:

* -i option (MPS_INCLUDE_DIR) now defaults to the code directory relative to the test harness location.
* -p option (PLATFORM) is now a six-character platform code for consistency with the rest of the MPS.
* New -v option (VARIETY) for specifying cool/hot/rash.
* -l option (MPS_LINK_OBJ) now defaults to the appropriate object file for the platform and variety.
* The object file is built automatically.
* If $Id$ of a test file is longer than 70 characters, cut characters out of the middle rather than off the end.
* Eliminate obsolete option -prod (MPS_PRODUCT).
* Support for FreeBSD.

Copied from Perforce
 Change: 192285
 ServerID: perforce.ravenbrook.com
---
 mps/code/comm.gmk                    |  3 +-
 mps/test/README                      | 78 ++++++++++-------------
 mps/test/test/script/clib            | 15 +++++
 mps/test/test/script/commands/clib   |  8 +--
 mps/test/test/script/commands/run    |  3 +-
 mps/test/test/script/commands/runset |  3 +-
 mps/test/test/script/headread        |  3 +
 mps/test/test/script/help/options    | 16 +++--
 mps/test/test/script/init            |  1 -
 mps/test/test/script/options         | 65 +++++++++++---------
 mps/test/test/script/platform        | 92 +++++++++++++++-------------
 11 files changed, 148 insertions(+), 139 deletions(-)

diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index b65ca3d025a..5c181c99790 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -343,10 +343,9 @@ testratio: phony
 #
 # See test/README for documentation on running the MMQA test suite.
 
-MMQA=perl test/qa -i ../code -l ../code/$(PFM)/$(VARIETY)/mps.o
+MMQA=perl test/qa -p $(PFM) -v $(VARIETY)
 
 $(PFM)/$(VARIETY)/testmmqa:
-	$(MAKE) -f $(PFM).gmk VARIETY=$(VARIETY) TARGET=mps.o variety
 	(if [ "$(VARIETY)" = "cool" ]; then cd ../test && $(MMQA) runset testsets/coolonly; fi)
 	(cd ../test && $(MMQA) runset testsets/argerr)
 	(cd ../test && $(MMQA) runset testsets/conerr)
diff --git a/mps/test/README b/mps/test/README
index a0be0814742..825185b043a 100644
--- a/mps/test/README
+++ b/mps/test/README
@@ -1,48 +1,43 @@
 $Id$
 
-This is the Memory Management QA test harness. To use it you need
-perl 5 (or higher). Go "perl qa help" for help, "perl qa options"
-to see what version of the harness you have (or look at the
-file "test/version").
+This is the Memory Management QA test harness. To use it you need Perl
+5 (or higher).
 
 
-Testing on Unix
----------------
+Quick start
+-----------
 
-From the test directory::
+In a shell in the test directory::
 
-    PLATFORM=lii6ll # substitute your platform
-    VARIETY=cool # or hot
-    CODE=../code # code directory of the branch you are testing
-    make -B -C $CODE -f $PLATFORM.gmk VARIETY=$VARIETY $PLATFORM/$VARIETY/mps.o
-    alias qa="perl test/qa -i $CODE -l $CODE/$PLATFORM/$VARIETY/mps.o"
-    qa clib
-    qa run function/5.c
-    qa runset testsets/passing
+    perl test/qa clib
+    perl test/qa run function/5.c
+    perl test/qa runset testsets/passing
+
+
+Usage and options
+-----------------
+
+Run ``perl test/qa help`` for help; run ``perl test/qa options`` to
+see what version of the harness you have (or look at the file
+``test/version``) and which options are available.
+
+The most important options are the ``-p`` option which specifies the
+platform (for example, ``-p lii6ll``) if the auto-detected platform is
+not the one you want to test, and the ``-v`` option which specifies
+the variety (for example ``-v hot``) if the cool variety is not the
+one you want to test.
+
+
+Debugging on Unix
+-----------------
 
 Each test case is compiled in its turn to the file
-``test/obj/$(uname -s)_$(uname -r)_$(uname -p)__unix/tmp_test``
-so you can debug it with::
+``test/obj/$PLATFORM/tmp_test`` so you can debug it with::
 
-    lldb test/obj/$(uname -s)_$(uname -r)_$(uname -p)__unix/tmp_test
+    gdb test/obj/lii6gc/tmp_test
 
-Or ``gdb`` instead of ``lldb``. MMQA sets its own assertion handler,
-so you'll probably want to set a breakpoint on mmqa_assert_handler.
-
-
-Testing on OS X
----------------
-
-From the test directory, build mpslib.a using the Xcode project::
-
-    xcodebuild -project ../code/mps.xcodeproj -target mps
-
-(You can also use "make" from the project root.)  Then::
-
-    perl test/qa -i ../code -l ../code/xc/Debug/libmps.a clib
-    perl test/qa -i ../code -l ../code/xc/Debug/libmps.a run function/232.c
-
-etc.  See "Testing on Unix" above.
+Or ``lldb`` instead of ``gdb``. MMQA sets its own assertion handler,
+so you'll probably want to set a breakpoint on ``mmqa_assert_handler``.
 
 
 Testing on Windows
@@ -50,17 +45,10 @@ Testing on Windows
 
 In a Cygwin shell, from the test directory::
 
-    PLATFORM=w3i6mv # substitute your platform
-    VARIETY=cool # or hot
-    CODE=../code # code directory of the branch you are testing
-    pushd $CODE
-    nmake /f $PLATFORM.nmk VARIETY=$VARIETY $PLATFORM/$VARIETY/mps.obj
-    popd
     export LANG=C # avoid locale warnings from Perl.
-    alias qa="perl test/qa -i $CODE -l $CODE/$PLATFORM/$VARIETY/mps.obj"
-    qa clib
-    qa run function/5.c
-    qa runset testsets/passing
+    perl test/qa clib
+    perl test/qa run function/5.c
+    perl test/qa runset testsets/passing
 
 The runset command can result in this error::
 
diff --git a/mps/test/test/script/clib b/mps/test/test/script/clib
index 6552a20b3b7..102f0a35e0a 100644
--- a/mps/test/test/script/clib
+++ b/mps/test/test/script/clib
@@ -7,6 +7,7 @@
 
 1;
 
+use Cwd;
 use File::Path qw(rmtree);
 
 sub clib {
@@ -15,6 +16,7 @@ sub clib {
  my $tlobj;
 
  &objpurge();
+ &mpslibbuild();
  &scrutinize();
  &logcomment("Compiling test libraries.");
 
@@ -59,6 +61,19 @@ sub objpurge {
  closedir(DIR);
 }
 
+#
+# Build the MPS object file.
+#
+
+sub mpslibbuild {
+ &logcomment("Building MPS library.");
+ local $dir = cwd();
+ chdir($MPS_INCLUDE_DIR);
+ &mysystem($make_command);
+ chdir($dir);
+}
+
+
 #
 # record information about environment so that when running tests
 # we can check the libraries are still applicable
diff --git a/mps/test/test/script/commands/clib b/mps/test/test/script/commands/clib
index db3bda8eb7c..8297b998907 100644
--- a/mps/test/test/script/commands/clib
+++ b/mps/test/test/script/commands/clib
@@ -8,15 +8,9 @@
 &requiredoptions(
  "MPS_INCLUDE_DIR",
  "MPS_LINK_OBJ",
-# "MPS_INTERFACE_VERSION",
+ "VARIETY",
  "PLATFORM"
 );
 
-&linkobjtimes();
-
-&requiredoptions(
- "MPS_PRODUCT"
-);
-
 &clib;
 
diff --git a/mps/test/test/script/commands/run b/mps/test/test/script/commands/run
index 6633a2f16ba..3b2e63df525 100644
--- a/mps/test/test/script/commands/run
+++ b/mps/test/test/script/commands/run
@@ -7,8 +7,7 @@
 &requiredoptions(
  "MPS_INCLUDE_DIR",
  "MPS_LINK_OBJ",
-# "MPS_INTERFACE_VERSION",
- "MPS_PRODUCT",
+ "VARIETY",
  "PLATFORM",
  "LOG_DIR"
 );
diff --git a/mps/test/test/script/commands/runset b/mps/test/test/script/commands/runset
index d0dd02a45a2..21224fc2297 100644
--- a/mps/test/test/script/commands/runset
+++ b/mps/test/test/script/commands/runset
@@ -7,8 +7,7 @@
 &requiredoptions(
  "MPS_INCLUDE_DIR",
  "MPS_LINK_OBJ",
-# "MPS_INTERFACE_VERSION",
- "MPS_PRODUCT",
+ "VARIETY",
  "PLATFORM",
  "LOG_DIR"
 );
diff --git a/mps/test/test/script/headread b/mps/test/test/script/headread
index 99c1d0f1359..16cd3a8b68f 100644
--- a/mps/test/test/script/headread
+++ b/mps/test/test/script/headread
@@ -85,6 +85,9 @@ sub readheader {
  } else {
   $testid = $test_header{"id"};
  }
+ if (length($testid) > 70) {
+  $testid = substr($testid, 0, 33) . "..." . substr($testid, -33);
+ }
  if (! exists $test_header{"harness"}) {
   $test_header{"harness"} = "1.0";
  }
diff --git a/mps/test/test/script/help/options b/mps/test/test/script/help/options
index 35f3bbcc987..f22a1559658 100644
--- a/mps/test/test/script/help/options
+++ b/mps/test/test/script/help/options
@@ -20,19 +20,14 @@ If the option is _cumulative_, however, both will apply.
 What the options mean:
 
 MMQA_MPS_INCLUDE_DIR / -i
- a directory where the MM header files may be found. No default.
+ a directory where the MPS source code may be found. Defaults to the
+ code directory relative to the test script.
 
 MMQA_MPS_LINK_OBJ / -l
  the MM libraries and plinth to link with. Separate multiple files
  with spaces. (Spaces in the paths will make the test harness go
- wrong, unfortunately.) No default.
-
-MMQA_MPS_PRODUCT / -prod
- You won't normally need to (and shouldn't) set this option, which
- will default to "epcore" or "dylan", whichever is appropriate to
- the memory manager specified in MMQA_MPS_LINK_OBJ. If however you
- want to test a memory manager which predates MPS version
- identification, then you must set it manually.
+ wrong, unfortunately.) Defaults to the appropriate file for the
+ platform and variety.
 
 MMQA_LOG_DIR / -g
  the directory in which log files should be saved. Default is
@@ -50,6 +45,9 @@ MMQA_PLATFORM / -p
  running tests. Setting it to a value not appropriate to the
  machine you are using will make the test system go wrong.
 
+MMQA_VARIETY / -v
+ the MPS variety to test. Defaults to cool.
+
 MMQA_PARAMETERS / -a (cumulative)
  parameter settings to use for a test. These override any parameter
  settings specified in the test header. Examples (all equivalent):
diff --git a/mps/test/test/script/init b/mps/test/test/script/init
index a5526d696b7..bdad439193b 100644
--- a/mps/test/test/script/init
+++ b/mps/test/test/script/init
@@ -13,7 +13,6 @@ sub harness_init {
  &set_dirs;
  &platform_settings;
  &identify;
- &auto_settings;
  &platform_settings;
 }
 
diff --git a/mps/test/test/script/options b/mps/test/test/script/options
index 5ef905a09fb..1bf36e1dea6 100644
--- a/mps/test/test/script/options
+++ b/mps/test/test/script/options
@@ -14,43 +14,49 @@
 
 sub platform_detect {
  if (($ENV{"OS"} || "") eq "Windows_NT") {
-  # it's NT, so find out what the processor is
-  #  from a system variable
-  $platform_class = "nt_".$ENV{"PROCESSOR_ARCHITECTURE"};
-  if ($platform_class eq "nt_") {
-   $platform_class = "nt_dunno";
+  $platform_os = "w3";
+  # See https://msdn.microsoft.com/en-us/library/aa384274.aspx
+  if ($ENV{"PROCESSOR_ARCHITECTURE"} eq "x86") {
+   $platform_ar = "i3";
+  } elsif ($ENV{"PROCESSOR_ARCHITECTURE"} eq "AMD64") {
+   $platform_ar = "i6";
+  } else {
+   $platform_ar = "xx";
   }
-  $platform_phylum = "pc";
+  $platform_ct = "mv";
  } else {
-  # it's unix by default
-     local $os = `uname`;
-     local $osrel = `uname -r`;
-     local $processor = `uname -p`;
-     chomp($os); chomp($osrel); chomp($processor);
-     $platform_class = $os."_".$osrel."_".$processor;
-     $platform_class =~ s/ /_/g;
-     $platform_phylum = "unix";
- }
- $qa_defaults{"PLATFORM"} = $platform_class."__".$platform_phylum;
-}
-
-sub auto_settings {
- unless (&getoption("MPS_PRODUCT")) {
-  if (&getoption("MPS_LINK_OBJ")) {
-   &mpslibvers(&getoption("MPS_LINK_OBJ"));
-   unless ($mpslibvers{"product"} eq "unknown") {
-    &setoption("MPS_PRODUCT", $mpslibvers{"product"});
-   }
+  local $os = `uname -s`;
+  chomp($os);
+  if ($os eq "Darwin") {
+   $platform_os = "xc";
+   $platform_ct = "ll";
+  } elsif ($os eq "FreeBSD") {
+   $platform_os = "fr";
+   $platform_ct = "gc";
+  } elsif ($os eq "Linux") {
+   $platform_os = "li";
+   $platform_ct = "gc";
+  } else {
+   $platform_os = "xx";
+   $platform_ct = "xx";
+  }
+  local $processor = `uname -p`;
+  chomp($processor);
+  if ($processor eq "i386") {
+   $platform_ar = "i3";
+  } elsif ($processor eq "x86_64") {
+   $platform_ar = "i6";
+  } else {
+   $platform_ar = "xx";
   }
  }
+ $qa_defaults{"PLATFORM"} = $platform_os . $platform_ar . $platform_ct;
 }
 
-
 %qa_options = (
-# "v", "MPS_INTERFACE_VERSION",
+ "v", "VARIETY",
  "i", "MPS_INCLUDE_DIR",
  "l", "MPS_LINK_OBJ",
- "prod", "MPS_PRODUCT",
  "p", "PLATFORM",
  "data", "DATA_DIR",
  "a", "PARAMETERS",
@@ -73,13 +79,14 @@ sub auto_settings {
 #
 
 %qa_defaults = (
+ "MPS_INCLUDE_DIR", $test_dir . "/../../code",
  "PLATFORM", "[error -- you shouldn't see this]",
+ "VARIETY", "cool",
  "DEBUG_INFO", "off",
  "DANGEROUS", "off",
  "DATA_DIR", "$test_dir/../data",
  "LOG_DIR", "$test_dir/log",
  "PARAMETERS", "",
-# "MPS_INTERFACE_VERSION", "HU",
  "MAIL_RESULTS", "off",
  "MAIL_TO", "mm-qa-test-log",
  "MAIL_SUBJECT", "MMQA-log"
diff --git a/mps/test/test/script/platform b/mps/test/test/script/platform
index 9dba51fdef7..abb4d9e3e6d 100644
--- a/mps/test/test/script/platform
+++ b/mps/test/test/script/platform
@@ -13,43 +13,38 @@
 # Set lots of variables correctly, depending on the platform
 # (which was determined in 'options')
 #
-# Currently, it should work correctly on NT, Solaris, Linux, MacOS X.
+# Currently, it should work correctly on Windows, Linux, MacOS X,
+# FreeBSD.
 #
 
 sub platform_settings {
-    if ($PLATFORM =~ "^nt_") {
-        &settings_nt();
-        if ($PLATFORM =~ "^nt_x86_cap") {
-            &settings_nt_cap();
-        } elsif ($PLATFORM =~ "^nt_x86_coff") {
-            &settings_nt_coff();
-        }
-    } elsif ($PLATFORM =~ "^SunOS") {
-        &settings_unix();
-        if ($PLATFORM =~ "sos8gp") {
-            &settings_gprof();
-        }
-    } elsif ($PLATFORM =~ "^Linux") {
-        &settings_unix();
-        &settings_linux();
-    } elsif ($PLATFORM =~ "^Mac_OS_10" || $PLATFORM =~ "^Darwin_") {
-        &settings_unix();
-        &settings_macosx();
-    } elsif ($PLATFORM =~ "__unix") {
-        &logcomment("I don't know anything specific about $PLATFORM --");
-        &logcomment("using generic unix/gcc settings.");
-        &settings_unix();
-    } else {
-        die "Sorry: I don't know how to use ".$PLATFORM."\n";
-    }
+ if ($PLATFORM =~ "^w3") {
+  &settings_nt();
+  &settings_nt_coff();
+ } elsif ($PLATFORM =~ "^li") {
+  &settings_unix();
+  &settings_linux();
+ } elsif ($PLATFORM =~ "^xc") {
+  &settings_unix();
+  &settings_macosx();
+ } elsif ($PLATFORM =~ "^fr") {
+  &settings_unix();
+  &settings_linux();
+ } else {
+  die "Sorry: I don't know how to use $PLATFORM.\n";
+ }
+ unless (defined $MPS_LINK_OBJ && $MPS_LINK_OBJ ne "") {
+  $MPS_LINK_OBJ = "$MPS_INCLUDE_DIR/$link_obj";
+ }
 }
 
 
 sub settings_nt {
  $dirsep = "/";
+ $link_obj = "$PLATFORM/$VARIETY/mps.obj";
+ $make_command = "nmake /f $PLATFORM.nmk VARIETY=$VARIETY $link_obj";
  $cc_command = "cl";
-# following line used to include /DMMQA_VERS_$MPS_INTERFACE_VERSION
- $cc_opts = "/nologo /DWIN32 /D_WINDOWS /D_CRT_SECURE_NO_WARNINGS /W3 /Zi /Oy- /MD /DMMQA_PROD_$MPS_PRODUCT";
+ $cc_opts = "/nologo /DWIN32 /D_WINDOWS /D_CRT_SECURE_NO_WARNINGS /W3 /Zi /Oy- /MD";
  $cc_link = "$obj_dir/platform.obj";
  $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug";
  $cc_include = "/I$testlib_dir /I$MPS_INCLUDE_DIR /I$obj_dir";
@@ -90,14 +85,21 @@ sub settings_nt_coff {
 
 sub settings_unix {
  $dirsep = "/";
+ $link_obj = "$PLATFORM/$VARIETY/mps.o";
+ $make_command = "make -B -f $PLATFORM.gmk VARIETY=$VARIETY $link_obj";
  $cc_link = "$obj_dir/platform.o -lm";
  $cc_link_opts = "-z muldefs";
- $cc_command = "gcc";
+ if ($PLATFORM =~ /ll$/) {
+  $cc_command = "clang";
+ } elsif ($PLATFORM =~ /gc$/) {
+  $cc_command = "gcc";
+ } else {
+  $cc_command = "cc";
+ }
  $cc_opts = "-ansi -pedantic -Wall -Wstrict-prototypes ".
   "-Winline -Waggregate-return -Wnested-externs -Wcast-qual ".
   "-Wshadow -Wmissing-prototypes -Wcast-align ".
-  "-O -g -ggdb3 ".
-  "-DMMQA_PROD_$MPS_PRODUCT";
+  "-O -g -ggdb3 ";
  $cc_include = "-I$testlib_dir -I$MPS_INCLUDE_DIR -I$obj_dir";
  $cc_def = "-D";
  $cc_defeq = "=";
@@ -130,18 +132,24 @@ sub settings_gprof {
 
 
 sub settings_linux {
- $cc_link = $cc_link . " -lpthread";
+ $cc_link .= " -lpthread";
 }
 
 
 sub settings_macosx {
-    $cc_command = "cc";
-    $cc_link = "$obj_dir/platform.o";
-    $cc_link_opts =~ s/-z muldefs//;
-    $cc_opts =~ s/-Wstrict-prototypes//;
-    $cc_opts .= " -Wno-unused -Wno-missing-prototypes";
-    $stdboth_red = ">&%s";
-    $preprocommand = "$cc_command $cc_preonly";
+ local $config = "Debug";
+ if ($VARIETY eq "hot") {
+  $config = "Release";
+ } elsif ($VARIETY eq "rash") {
+  $config = "Rash";
+ }
+ $link_obj = "xc/$config/libmps.a";
+ $make_command = "xcodebuild -project mps.xcodeproj -config $config -target mps";
+ $cc_command = "clang";
+ $cc_link = "$obj_dir/platform.o";
+ $cc_link_opts =~ s/-z muldefs//;
+ $cc_opts =~ s/-Wstrict-prototypes//;
+ $cc_opts .= " -Wno-unused -Wno-missing-prototypes";
 }
 
 
@@ -191,9 +199,9 @@ sub unix_mailfile {
 
 sub identify {
  %identify = ();
- if ($PLATFORM =~ /^nt/) {
+ if ($PLATFORM =~ /^w3/) {
   &identify_nt;
- } elsif ($PLATFORM =~ /__unix/) {
+ } elsif ($PLATFORM =~ /^(fr|li|xc)/) {
   &identify_unix;
  }
  $identify{"time"} = localtime;
@@ -237,7 +245,7 @@ sub identify_unix {
  if (exists $identify{"user"}) {
   $identify{"user"} =~ s/\s.*//;
  }
- &comvar("c_version", "gcc -v", "version");
+ &comvar("c_version", "$cc_command -v", "version");
  &comvar("OS", "uname", "");
  &comvar("arch", "uname -a", "");
 }

From eba3fdff520e93d8e79a311cbaad62838ce3bca1 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 12 Sep 2016 12:26:40 +0100
Subject: [PATCH 3/6] New mmqa command debug compiles a test case and launches
 the debugger.

Copied from Perforce
 Change: 192290
 ServerID: perforce.ravenbrook.com
---
 mps/test/README                     | 36 +++++++++--------------------
 mps/test/test/script/commands/debug | 16 +++++++++++++
 mps/test/test/script/help/debug     | 11 +++++++++
 mps/test/test/script/options        |  2 +-
 mps/test/test/script/platform       |  5 ++++
 mps/test/test/script/runtest        | 32 +++++++++++++++++++++++++
 6 files changed, 76 insertions(+), 26 deletions(-)
 create mode 100644 mps/test/test/script/commands/debug
 create mode 100644 mps/test/test/script/help/debug

diff --git a/mps/test/README b/mps/test/README
index 825185b043a..5d33ad42bbf 100644
--- a/mps/test/README
+++ b/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/
diff --git a/mps/test/test/script/commands/debug b/mps/test/test/script/commands/debug
new file mode 100644
index 00000000000..0c9bdf6b496
--- /dev/null
+++ b/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);
+}
diff --git a/mps/test/test/script/help/debug b/mps/test/test/script/help/debug
new file mode 100644
index 00000000000..695a4779176
--- /dev/null
+++ b/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.)
diff --git a/mps/test/test/script/options b/mps/test/test/script/options
index 1bf36e1dea6..2966e75baaa 100644
--- a/mps/test/test/script/options
+++ b/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";
diff --git a/mps/test/test/script/platform b/mps/test/test/script/platform
index abb4d9e3e6d..6b5b457d264 100644
--- a/mps/test/test/script/platform
+++ b/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//;
diff --git a/mps/test/test/script/runtest b/mps/test/test/script/runtest
index 308a1a10b2a..192e62d4f5c 100644
--- a/mps/test/test/script/runtest
+++ b/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";
+  }
+ }
+}

From 42dbb3bd5ac8d7fea5e46df3cf474eec75d3ad06 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 12 Sep 2016 12:53:25 +0100
Subject: [PATCH 4/6] Need gmake on freebsd ("make" is bsd make).

Copied from Perforce
 Change: 192297
 ServerID: perforce.ravenbrook.com
---
 mps/test/test/script/platform | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/mps/test/test/script/platform b/mps/test/test/script/platform
index 6b5b457d264..1ab21aae997 100644
--- a/mps/test/test/script/platform
+++ b/mps/test/test/script/platform
@@ -29,7 +29,7 @@ sub platform_settings {
   &settings_macosx();
  } elsif ($PLATFORM =~ "^fr") {
   &settings_unix();
-  &settings_linux();
+  &settings_freebsd();
  } else {
   die "Sorry: I don't know how to use $PLATFORM.\n";
  }
@@ -140,6 +140,12 @@ sub settings_linux {
 }
 
 
+sub settings_freebsd {
+ $make_command = "gmake -B -f $PLATFORM.gmk VARIETY=$VARIETY $link_obj";
+ $cc_link .= " -lpthread";
+}
+
+
 sub settings_macosx {
  local $config = "Debug";
  if ($VARIETY eq "hot") {

From 3398d94ecfe5164b6fdeff050eb298d2800314eb Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 12 Sep 2016 14:39:55 +0100
Subject: [PATCH 5/6] Avoid warnings from gcc 4.2 on freebsd.

Copied from Perforce
 Change: 192310
 ServerID: perforce.ravenbrook.com
---
 mps/test/function/127.c | 4 ++--
 mps/test/function/128.c | 4 ++--
 mps/test/function/134.c | 4 ++--
 mps/test/function/171.c | 4 ++--
 mps/test/function/215.c | 4 ++--
 mps/test/function/223.c | 4 ++--
 mps/test/function/227.c | 4 ++--
 7 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/mps/test/function/127.c b/mps/test/function/127.c
index 7ab03a0f69e..8f089c6f320 100644
--- a/mps/test/function/127.c
+++ b/mps/test/function/127.c
@@ -60,11 +60,11 @@ static void alloc_back(void) {
 
 static void test(void) {
  long int i;
- long int rsize;
+ long int rsize = 0;
 
  int inramp;
 
- mycell *r, *s;
+ mycell *r = NULL, *s;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(),
    (size_t) 1024*1024*ARENALIMIT),
diff --git a/mps/test/function/128.c b/mps/test/function/128.c
index a2c59850ee0..cbf04acb0d7 100644
--- a/mps/test/function/128.c
+++ b/mps/test/function/128.c
@@ -60,11 +60,11 @@ static void alloc_back(void) {
 
 static void test(void) {
  long int i;
- long int rsize;
+ long int rsize = 0;
 
  int inramp;
 
- mycell *r, *s;
+ mycell *r = NULL, *s;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(),
    (size_t) 1024*1024*ARENALIMIT),
diff --git a/mps/test/function/134.c b/mps/test/function/134.c
index bc29777ddf1..8bc25359cb9 100644
--- a/mps/test/function/134.c
+++ b/mps/test/function/134.c
@@ -60,11 +60,11 @@ static void alloc_back(void) {
 
 static void test(void) {
  long int i;
- long int rsize;
+ long int rsize = 0;
 
  int inramp;
 
- mycell *r, *s;
+ mycell *r = NULL, *s;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(),
    (size_t) 1024*1024*ARENALIMIT),
diff --git a/mps/test/function/171.c b/mps/test/function/171.c
index 3e16d32dd6f..f00de3e87be 100644
--- a/mps/test/function/171.c
+++ b/mps/test/function/171.c
@@ -60,11 +60,11 @@ static void alloc_back(void) {
 
 static void test(void) {
  long int i;
- long int rsize;
+ long int rsize = 0;
 
  int inramp;
 
- mycell *r, *s;
+ mycell *r = NULL, *s;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(),
    (size_t) ARENALIMIT),
diff --git a/mps/test/function/215.c b/mps/test/function/215.c
index 48e7148e029..52754ab0a11 100644
--- a/mps/test/function/215.c
+++ b/mps/test/function/215.c
@@ -60,12 +60,12 @@ static void alloc_back(void) {
 
 static void test(void) {
  long int i;
- long int rsize;
+ long int rsize = 0;
  mps_message_t message;
 
  int inramp;
 
- mycell *r, *s;
+ mycell *r = NULL, *s;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(),
    (size_t) 1024*1024*ARENALIMIT),
diff --git a/mps/test/function/223.c b/mps/test/function/223.c
index 75e14915728..ddb88115d0d 100644
--- a/mps/test/function/223.c
+++ b/mps/test/function/223.c
@@ -60,12 +60,12 @@ static void alloc_back(void) {
 
 static void test(void) {
  long int i;
- long int rsize;
+ long int rsize = 0;
  mps_message_t message;
 
  int inramp;
 
- mycell *r, *s;
+ mycell *r = NULL, *s;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(),
    (size_t) 1024*1024*ARENALIMIT),
diff --git a/mps/test/function/227.c b/mps/test/function/227.c
index d149bbc474c..35fe35b3d02 100644
--- a/mps/test/function/227.c
+++ b/mps/test/function/227.c
@@ -58,11 +58,11 @@ static void alloc_back(void) {
 
 static void test(void) {
  long int i;
- long int rsize;
+ long int rsize = 0;
 
  int inramp;
 
- mycell *r1, *r2, *s1, *s2;
+ mycell *r1 = NULL, *r2 = NULL, *s1, *s2;
 
  cdie(mps_arena_create(&arena1, mps_arena_class_vm(),
    (size_t) 1024*1024*ARENALIMIT), "create arena");

From 2c5b947f9d4dea5cf7d42247e827ce31989ba3a3 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 13 Sep 2016 10:19:03 +0100
Subject: [PATCH 6/6] Mmqa test suite now passes on freebsd.

Copied from Perforce
 Change: 192320
 ServerID: perforce.ravenbrook.com
---
 mps/test/argerr/153.c         | 2 +-
 mps/test/test/script/platform | 8 ++++++--
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/mps/test/argerr/153.c b/mps/test/argerr/153.c
index 095a855d1cc..338b9a4e6ef 100644
--- a/mps/test/argerr/153.c
+++ b/mps/test/argerr/153.c
@@ -23,7 +23,7 @@ static void test(void) {
  cdie(mps_pool_create(&pool, arena, mps_class_mv(),
   1024*32, 1024*16, 1024*256), "pool");
 
- cdie(mps_alloc(&q, pool, ((size_t)-1) - 100 * mmqaArenaSIZE), "alloc");
+ cdie(mps_alloc(&q, pool, (size_t)-1 - mmqaArenaSIZE), "alloc");
 
  mps_pool_destroy(pool);
  mps_arena_destroy(arena);
diff --git a/mps/test/test/script/platform b/mps/test/test/script/platform
index 1ab21aae997..75d9f18d3ca 100644
--- a/mps/test/test/script/platform
+++ b/mps/test/test/script/platform
@@ -115,8 +115,12 @@ sub settings_unix {
  $obj_suffix = ".o";
  $try_command = "sh -c ";
  $catcommand = "cat";
- $comwrap = "sh -c \"ulimit -c 0; ";
- $comwrapend = "\"";
+ $comwrap = "sh -c 'ulimit -c 0; ";
+ # The "true" after the test program forces the test program to be run
+ # inside the subshell (with "Segmentation fault" messages written to
+ # the pipe and captured) rather than in the parent shell (with
+ # "Segmentation fault" messages written to the terminal and so lost).
+ $comwrapend = "; true'";
  $stdout_red = ">";
  $stdout_dup = "| tee";
  $stdin_red = "<";