diff --git a/mps/qa/test/script/platform b/mps/qa/test/script/platform new file mode 100644 index 00000000000..0f832998d43 --- /dev/null +++ b/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 () { + 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", ""); +} diff --git a/mps/qa/test/script/useful b/mps/qa/test/script/useful new file mode 100644 index 00000000000..f20d100d0b5 --- /dev/null +++ b/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]); +}