Adding upstream version 1:115.7.0.upstream/1%115.7.0upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 384 insertions, 0 deletions

diff --git a/js/src/devtools/rootAnalysis/run_complete b/js/src/devtools/rootAnalysis/run_complete
new file mode 100755
index 0000000000..c9355267db
--- /dev/null
+++ b/js/src/devtools/rootAnalysis/run_complete
@@ -0,0 +1,384 @@
+#!/usr/bin/perl
+
+# Sixgill: Static assertion checker for C/C++ programs.
+# Copyright (C) 2009-2010  Stanford University
+# Author: Brian Hackett
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# do a complete run of the system from raw source to reports. this requires
+# various run_monitor processes to be running in the background (maybe on other
+# machines) and watching a shared poll_file for jobs. if the output directory
+# for this script already exists then an incremental analysis will be performed
+# and the reports will only reflect the changes since the earlier run.
+
+use strict;
+use warnings;
+use IO::Handle;
+use File::Basename qw(basename dirname);
+use Getopt::Long;
+use Cwd;
+
+#################################
+# environment specific settings #
+#################################
+
+my $WORKDIR;
+my $SIXGILL_BIN;
+
+# poll file shared with the run_monitor script.
+my $poll_file;
+
+# root directory of the project.
+my $build_dir;
+
+# directory containing gcc wrapper scripts.
+my $wrap_dir;
+
+# optional file with annotations from the web interface.
+my $ann_file = "";
+
+# optional output directory to do a diff against.
+my $old_dir = "";
+
+# run in the foreground
+my $foreground;
+
+my $builder = "make -j4";
+
+my $suppress_logs;
+GetOptions("build-root|b=s" => \$build_dir,
+           "poll-file=s" => \$poll_file,
+           "no-logs!" => \$suppress_logs,
+           "work-dir=s" => \$WORKDIR,
+           "sixgill-binaries|binaries|b=s" => \$SIXGILL_BIN,
+           "wrap-dir=s" => \$wrap_dir,
+           "annotations-file|annotations|a=s" => \$ann_file,
+           "old-dir|old=s" => \$old_dir,
+           "foreground!" => \$foreground,
+           "buildcommand=s" => \$builder,
+           )
+    or die;
+
+if (not -d $build_dir) {
+    mkdir($build_dir);
+}
+if ($old_dir ne "" && not -d $old_dir) {
+    die "Old directory '$old_dir' does not exist\n";
+}
+
+$WORKDIR ||= "sixgill-work";
+mkdir($WORKDIR, 0755) if ! -d $WORKDIR;
+$poll_file ||= "$WORKDIR/poll.file";
+$build_dir ||= "$WORKDIR/js-inbound-xgill";
+
+if (!defined $SIXGILL_BIN) {
+    chomp(my $path = `which xmanager`);
+    if ($path) {
+        use File::Basename qw(dirname);
+        $SIXGILL_BIN = dirname($path);
+    } else {
+        die "Cannot find sixgill binaries. Use the -b option.";
+    }
+}
+
+$wrap_dir ||= "$WORKDIR/xgill-inbound/wrap_gcc";
+$wrap_dir = "$SIXGILL_BIN/../scripts/wrap_gcc" if not (-e "$wrap_dir/basecc");
+die "Bad wrapper directory: $wrap_dir" if not (-e "$wrap_dir/basecc");
+
+# code to clean the project from $build_dir.
+sub clean_project {
+    system("make clean");
+}
+
+# code to build the project from $build_dir.
+sub build_project {
+    return system($builder) >> 8;
+}
+
+our %kill_on_exit;
+END {
+    for my $pid (keys %kill_on_exit) {
+        kill($pid);
+    }
+}
+
+# commands to start the various xgill binaries. timeouts can be specified
+# for the backend analyses here, and a memory limit can be specified for
+# xmanager if desired (and USE_COUNT_ALLOCATOR is defined in util/alloc.h).
+my $xmanager = "$SIXGILL_BIN/xmanager";
+my $xsource = "$SIXGILL_BIN/xsource";
+my $xmemlocal = "$SIXGILL_BIN/xmemlocal -timeout=20";
+my $xinfer = "$SIXGILL_BIN/xinfer -timeout=60";
+my $xcheck = "$SIXGILL_BIN/xcheck -timeout=30";
+
+# prefix directory to strip off source files.
+my $prefix_dir = $build_dir;
+
+##########################
+# general purpose script #
+##########################
+
+# Prevent ccache from being used. I don't think this does any good. The problem
+# I'm struggling with is that if autoconf.mk still has 'ccache gcc' in it, the
+# builds fail in a mysterious way.
+$ENV{CCACHE_COMPILERCHECK} = 'date +%s.%N';
+delete $ENV{CCACHE_PREFIX};
+
+my $usage = "USAGE: run_complete result-dir\n";
+my $result_dir = shift or die $usage;
+
+if (not $foreground) {
+    my $pid = fork();
+    if ($pid != 0) {
+        print "Forked, exiting...\n";
+        exit(0);
+    }
+}
+
+# if the result directory does not already exist, mark for a clean build.
+my $do_clean = 0;
+if (not (-d $result_dir)) {
+    $do_clean = 1;
+    mkdir $result_dir;
+}
+
+if (!$suppress_logs) {
+    my $log_file = "$result_dir/complete.log";
+    open(OUT, ">>", $log_file) or die "append to $log_file: $!";
+    OUT->autoflush(1);  # don't buffer writes to the main log.
+
+    # redirect stdout and stderr to the log.
+    STDOUT->fdopen(\*OUT, "w");
+    STDERR->fdopen(\*OUT, "w");
+}
+
+# pids to wait on before exiting. these are collating worker output.
+my @waitpids;
+
+chdir $result_dir;
+
+# to do a partial run, comment out the commands here you don't want to do.
+
+my $status = run_build();
+
+# end of run commands.
+
+for my $pid (@waitpids) {
+    waitpid($pid, 0);
+    $status ||= $? >> 8;
+}
+
+print "Exiting run_complete with status $status\n";
+exit $status;
+
+# get the IP address which a freshly created manager is listening on.
+sub get_manager_address
+{
+    my $log_file = shift or die;
+
+    # give the manager one second to start, any longer and something's broken.
+    sleep(1);
+
+    my $log_data = `cat $log_file`;
+    my ($port) = $log_data =~ /Listening on ([\.\:0-9]*)/
+      or die "no manager found";
+    print OUT "Connecting to manager on port $port\n" unless $suppress_logs;
+    print "Connecting to manager on port $port.\n";
+    return $1;
+}
+
+sub logging_suffix {
+    my ($show_logs, $log_file) = @_;
+    return $show_logs ? "2>&1 | tee $log_file"
+                      : "> $log_file 2>&1";
+}
+
+sub run_build
+{
+    print "build started: ";
+    print scalar(localtime());
+    print "\n";
+
+    # fork off a process to run the build.
+    defined(my $pid = fork) or die;
+
+    # log file for the manager.
+    my $manager_log_file = "$result_dir/build_manager.log";
+
+    if (!$pid) {
+        # this is the child process, fork another process to run a manager.
+        defined(my $pid = fork) or die;
+        my $logging = logging_suffix($suppress_logs, $manager_log_file);
+        exec("$xmanager -terminate-on-assert $logging") if (!$pid);
+        $kill_on_exit{$pid} = 1;
+
+        if (!$suppress_logs) {
+            # open new streams to redirect stdout and stderr.
+            open(LOGOUT, "> $result_dir/build.log");
+            open(LOGERR, "> $result_dir/build_err.log");
+            STDOUT->fdopen(\*LOGOUT, "w");
+            STDERR->fdopen(\*LOGERR, "w");
+        }
+
+        my $address = get_manager_address($manager_log_file);
+
+        # write the configuration file for the wrapper script.
+        my $config_file = "$WORKDIR/xgill.config";
+        open(CONFIG, ">", $config_file) or die "create $config_file: $!";
+        print CONFIG "$prefix_dir\n";
+        print CONFIG Cwd::abs_path("$result_dir/build_xgill.log")."\n";
+        print CONFIG "$address\n";
+        my @extra = ("-fplugin-arg-xgill-mangle=1");
+        push(@extra, "-fplugin-arg-xgill-annfile=$ann_file")
+            if ($ann_file ne "" && -e $ann_file);
+        print CONFIG join(" ", @extra) . "\n";
+        close(CONFIG);
+
+	# Tell the wrapper where to find the config
+	$ENV{"XGILL_CONFIG"} = Cwd::abs_path($config_file);
+
+        # If overriding $CC, use GCCDIR to tell the wrapper scripts where the
+        # real compiler is. If $CC is not set, then the wrapper script will
+        # search $PATH anyway.
+        if (exists $ENV{CC}) {
+            $ENV{GCCDIR} = dirname($ENV{CC});
+        }
+
+        # Force the wrapper scripts to be run in place of the compiler during
+        # whatever build process we use.
+        $ENV{CC} = "$wrap_dir/" . basename($ENV{CC} // "gcc");
+        $ENV{CXX} = "$wrap_dir/" . basename($ENV{CXX} // "g++");
+
+        # do the build, cleaning if necessary.
+        chdir $build_dir;
+        clean_project() if ($do_clean);
+        my $exit_status = build_project();
+
+        # signal the manager that it's over.
+        system("$xsource -remote=$address -end-manager");
+
+        # wait for the manager to clean up and terminate.
+        print "Waiting for manager to finish (build status $exit_status)...\n";
+        waitpid($pid, 0);
+        my $manager_status = $?;
+        delete $kill_on_exit{$pid};
+
+        # build is finished, the complete run can resume.
+        # return value only useful if --foreground
+        print "Exiting with status " . ($manager_status || $exit_status) . "\n";
+        exit($manager_status || $exit_status);
+    }
+
+    # this is the complete process, wait for the build to finish.
+    waitpid($pid, 0);
+    my $status = $? >> 8;
+    print "build finished (status $status): ";
+    print scalar(localtime());
+    print "\n";
+
+    return $status;
+}
+
+sub run_pass
+{
+    my ($name, $command) = @_;
+    my $log_file = "$result_dir/manager.$name.log";
+
+    # extra commands to pass to the manager.
+    my $manager_extra = "";
+    $manager_extra .= "-modset-wait=10" if ($name eq "xmemlocal");
+
+    # fork off a manager process for the analysis.
+    defined(my $pid = fork) or die;
+    my $logging = logging_suffix($suppress_logs, $log_file);
+    exec("$xmanager $manager_extra $logging") if (!$pid);
+
+    my $address = get_manager_address($log_file);
+
+    # write the poll file for this pass.
+    if (! -d dirname($poll_file)) {
+        system("mkdir", "-p", dirname($poll_file));
+    }
+    open(POLL, "> $poll_file");
+    print POLL "$command\n";
+    print POLL "$result_dir/$name\n";
+    print POLL "$address\n";
+    close(POLL);
+
+    print "$name started: ";
+    print scalar(localtime());
+    print "\n";
+
+    waitpid($pid, 0);
+    unlink($poll_file);
+
+    print "$name finished: ";
+    print scalar(localtime());
+    print "\n";
+
+    # collate the worker's output into a single file. make this asynchronous
+    # so we can wait a bit and make sure we get all worker output.
+    defined($pid = fork) or die;
+
+    if (!$pid) {
+        sleep(20);
+        exec("cat $name.*.log > $name.log");
+    }
+
+    push(@waitpids, $pid);
+}
+
+# the names of all directories containing reports to archive.
+my $indexes;
+
+sub run_index
+{
+    my ($name, $kind) = @_;
+
+    return if (not (-e "report_$kind.xdb"));
+
+    print "$name started: ";
+    print scalar(localtime());
+    print "\n";
+
+    # make an index for the report diff if applicable.
+    if ($old_dir ne "") {
+        system("make_index $kind $old_dir > $name.diff.log");
+        system("mv $kind diff_$kind");
+        $indexes .= " diff_$kind";
+    }
+
+    # make an index for the full set of reports.
+    system("make_index $kind > $name.log");
+    $indexes .= " $kind";
+
+    print "$name finished: ";
+    print scalar(localtime());
+    print "\n";
+}
+
+sub archive_indexes
+{
+    print "archive started: ";
+    print scalar(localtime());
+    print "\n";
+
+    system("tar -czf reports.tgz $indexes");
+    system("rm -rf $indexes");
+
+    print "archive finished: ";
+    print scalar(localtime());
+    print "\n";
+}