New unit

new files

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

mps/qa/test/script/platform

@@ -0,0 +1,182 @@
+# Settings that depend on the platform,
+# including c compiler, command syntax, &c.
+#
+# And the %identify hash of useful information
+# to record in the test results.
+#
+
+&platform_settings;
+&identify;
+
+#
+# Set lots of variable correctly, depending on the platform
+# (which was determined in 'options')
+#
+# Currently, it should work correctly on NT, Solaris. Posibly
+# Linux too.
+#
+
+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 =~ "^so|^linux") {
+  &settings_unix();
+  if ($PLATFORM =~ "^sos8gp") {
+   &settings_gprof();
+  }
+ } 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";
+ }
+}
+
+sub settings_nt {
+ $dirsep = "\\";
+ $cc_command = "cl";
+ $cc_opts = "/nologo /DWIN32 /D_WINDOWS /W3 /Zi /Oy- /DMMQA_VERS_$INTERFACE_VERSION";
+ $cc_link = "$obj_dir/platform.obj";
+ $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /debugtype:both /pdb:none /debug:full";
+ $cc_include = "/I$testlib_dir /I$MPS_INCLUDE_DIR";
+ $cc_def = "/D";
+ $cc_defeq = "=";
+ $cc_conly = "/c";
+ $cc_obj = "/Fo";
+ $cc_exe = "/Fe";
+ $cc_objandexe = 1;
+ $obj_suffix = ".obj";
+ $try_command = "";
+ $catcommand = "$script_dir/ntx86bin/cat.exe";
+ $comwrap = "\"";
+ $comwrapend = "\"";
+ $stdout_red = ">";
+ $err_red = "2>";
+ $stdout_dup = "| $script_dir/ntx86bin/tee.exe";
+ $stdin_red = "<";
+ $platmailfile = \&nt_mailfile;
+}
+
+sub settings_nt_cap {
+ $cc_opts = "$cc_opts /Gh";
+ $cc_link = "$cc_link CAP.lib";
+ $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /debugtype:coff /debug:mapped,partial";
+}
+
+sub settings_nt_coff {
+ $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /debugtype:coff /debug:full";
+}
+
+sub settings_unix {
+ $dirsep = "/";
+ $cc_link = "$obj_dir/platform.o -lm";
+ $cc_link_opts = "-z muldefs";
+ $cc_command = "gcc";
+ $cc_opts = "-ansi -pedantic -Wall -Wstrict-prototypes ".
+  "-Winline -Waggregate-return -Wnested-externs -Wcast-qual ".
+  "-Wshadow -Wmissing-prototypes -Wcast-align ".
+  "-O -g -ggdb3 -DMMQA_VERS_$INTERFACE_VERSION";
+ $cc_include = "-I$testlib_dir -I$MPS_INCLUDE_DIR";
+ $cc_def = "-D";
+ $cc_defeq = "=";
+ $cc_conly = "-c";
+ $cc_obj = "-o ";
+ $cc_exe = "-o ";
+ $cc_objandexe = 0;
+ $obj_suffix = ".o";
+ $try_command = "sh -c ";
+ $catcommand = "cat";
+ $comwrap = "sh -c \"ulimit -c 0; ";
+ $comwrapend = "\"";
+ $stdout_red = ">";
+ $err_red = "2>";
+ $stdout_dup = "| tee";
+ $stdin_red = "<";
+ $platmailfile = \&unix_mailfile;
+}
+
+sub settings_gprof {
+ $cc_opts = "-pg ".$cc_opts;
+}
+
+#
+# Subroutines to send email (for archiving test results).
+#
+
+sub nt_mailfile {
+ local ($file, $to, $subj, $from) = @_;
+ 
+ if (exists $ENV{"USERNAME"}) {
+  $from = $ENV{"USERNAME"};
+ } else {
+  $from = "mm-qa";
+ }
+ &mysystem(
+  "$script_dir/ntx86bin/blat.exe ".
+  "$file -server mailhost -f $from -t $to -s \"$subj\" -q");
+}
+
+sub unix_mailfile {
+ local ($file, $to, $subj) = @_;
+
+ &mysystem(
+  "{ echo \"To: $to\"; echo \"Subject: $subj\"; cat $file; } | mail -t");
+}
+
+#
+# %identify records useful information to present in the test results
+# &identify sets it up.
+#
+
+sub identify {
+ %identify = ();
+ if ($PLATFORM =~ /^nt/) {
+  &identify_nt;
+ } elsif ($PLATFORM =~ /^unix/) {
+  &identify_unix;
+ }
+ $identify{"time"} = localtime;
+ $identify{"harness_version"} = $HARNESS_VERSION;
+}
+
+sub envvar {
+ if (exists $ENV{$_[1]}) {
+  $identify{$_[0]} = $ENV{$_[1]};
+ }
+}
+
+sub comvar {
+ my ($var, $com, $pat) = @_;
+ if (open(COM, $com)) {
+  while (<COM>) {
+   chop;
+   if ($pat eq "" || /$pat/) {
+    $identify{$_[0]} = $_;
+    last;
+   }
+  }
+  close(COM);
+ }
+}
+
+sub identify_nt {
+ &envvar("machine", "COMPUTERNAME");
+ &envvar("user", "USERNAME");
+ &envvar("OS", "OS");
+ &envvar("arch", "PROCESSOR_ARCHITECTURE");
+ &comvar("c_version", "cl /? 2>&1 |", "");
+}
+
+sub identify_unix {
+ &comvar("machine", "uname -n", "");
+ &comvar("user", "whoami", "");
+ &comvar("c_version", "gcc -v 2>&1 |", "version");
+ &comvar("OS", "uname", "");
+ &comvar("arch", "arch", "");
+}

mps/qa/test/script/useful

@@ -0,0 +1,47 @@
+# $HopeName$
+# Various subroutines that the MMQA harness finds useful.
+#
+
+1;
+
+sub debug {
+ local ($text) = @_;
+ if ($DEBUG_INFO eq "on") {
+  print $text."\n";
+ }
+}
+
+sub mysystem {
+ local ($command) = @_;
+ $command =~ s/(\S)\//$1$dirsep/g;
+ &debug("SYSTEM >>$command<<");
+ system($command);
+}
+
+sub mailfile {
+ local ($file, $subj) = @_;
+
+ if ($MAIL_RESULTS eq "on") {
+  &$platmailfile($file, $MAIL_TO, $subj);
+ }
+}
+
+#
+# comparison of harness version numbers
+#
+
+sub vleq {
+ local ($a, $b, @a, @b) = @_;
+ @a = split /\./, $a;
+ @b = split /\./, $b;
+ while (defined $a[0] && defined $b[0]) {
+  if ($a[0] == $b[0]) {
+   shift @a; shift @b;
+  } else {
+   return ($a[0] < $b[0]);
+  }
+ }
+ if (! defined $a[0]) { $a[0] = -1 }
+ if (! defined $b[0]) { $b[0] = -1 }
+ return ($a[0] <= $b[0]);
+}