~drizzle-trunk/drizzle/development

#!/usr/bin/perl

# -*- cperl -*-

use utf8;

#

# Copyright (C) 2008

# 

# 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; version 2 of the License.

# 

# 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, write to the Free Software

# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA */

#

#

##############################################################################

#

#  drizzle-test-run.pl

#

#  Tool used for executing a suite of .test file

#

#  For now, see the "MySQL Test framework manual" for more information

#  http://dev.mysql.com/doc/mysqltest/en/index.html

#  (as the Drizzle test environment is currently still fairly similar)

#

#  Please keep the test framework tools identical in all versions!

#

##############################################################################

#

# Coding style directions for this perl script

#

#   - To make this Perl script easy to alter even for those that not

#     code Perl that often, keeep the coding style as close as possible to

#     the C/C++ drizzle coding standard.

#

#   - All lists of arguments to send to commands are Perl lists/arrays,

#     not strings we append args to. Within reason, most string

#     concatenation for arguments should be avoided.

#

#   - Functions defined in the main program are not to be prefixed,

#     functions in "library files" are to be prefixed with "dtr_" (for

#     Drizzle-Test-Run). There are some exceptions, code that fits best in

#     the main program, but are put into separate files to avoid

#     clutter, may be without prefix.

#

#   - All stat/opendir/-f/ is to be kept in collect_test_cases(). It

#     will create a struct that the rest of the program can use to get

#     the information. This separates the "find information" from the

#     "do the work" and makes the program more easy to maintain.

#

#   - The rule when it comes to the logic of this program is

#

#       command_line_setup() - is to handle the logic between flags

#       collect_test_cases() - is to do its best to select what tests

#                              to run, dig out options, if needs restart etc.

#       run_testcase()       - is to run a single testcase, and follow the

#                              logic set in both above. No, or rare file

#                              system operations. If a test seems complex,

#                              it should probably not be here.

#

# A nice way to trace the execution of this script while debugging

# is to use the Devel::Trace package found at

# "http://www.plover.com/~mjd/perl/Trace/" and run this script like

# "perl -d:Trace test-run.pl"

#

use lib "lib/";

$Devel::Trace::TRACE= 0;       # Don't trace boring init stuff

#require 5.6.1;

use File::Path;

use File::Basename;

use File::Copy;

use File::Temp qw /tempdir/;

use File::Spec::Functions qw /splitdir catpath catdir

                              updir curdir splitpath rel2abs/;

use Cwd;

use Getopt::Long;

use IO::Socket;

use IO::Socket::INET;

use strict;

use warnings;

select(STDOUT);

$| = 1; # Automatically flush STDOUT

require "dtr_cases.pl";

require "dtr_process.pl";

require "dtr_timer.pl";

require "dtr_io.pl";

require "dtr_gcov.pl";

require "dtr_gprof.pl";

require "dtr_report.pl";

require "dtr_match.pl";

require "dtr_misc.pl";

require "dtr_stress.pl";

require "dtr_unique.pl";

$Devel::Trace::TRACE= 1;

##############################################################################

#

#  Default settings

#

##############################################################################

# Misc global variables

our $drizzle_version_id;

our $glob_suite_path=             undef;

our $glob_drizzle_test_dir=         undef;

our $glob_drizzle_bench_dir=        undef;

our $glob_scriptname=             undef;

our $glob_timers=                 undef;

our @glob_test_mode;

our $glob_builddir;

our $glob_basedir;

our $path_client_bindir;

our $path_timefile;

our $path_snapshot;

our $path_drizzletest_log;

our $path_current_test_log;

our $opt_vardir;                 # A path but set directly on cmd line

our $opt_top_srcdir;

our $opt_top_builddir;

our $path_vardir_trace;          # unix formatted opt_vardir for trace files

our $opt_tmpdir;                 # A path but set directly on cmd line

our $opt_suitepath;

our $opt_testdir;

our $opt_subunit;

our $default_vardir;

our $default_top_srcdir;

our $default_top_builddir;

our $opt_usage;

our $opt_suites;

our $opt_suites_default= "main"; # Default suites to run

our $opt_script_debug= 0;  # Script debugging, enable with --script-debug

our $opt_verbose= 0;  # Verbose output, enable with --verbose

our $opt_repeat_test= 1;

our $exe_master_drizzled;

our $exe_drizzle;

our $exe_drizzleadmin;

our $exe_drizzle_client_test;

our $exe_bug25714;

our $exe_drizzled;

our $exe_drizzledump;

our $exe_drizzleslap;

our $exe_drizzleimport;

our $exe_drizzle_fix_system_tables;

our $exe_drizzletest;

our $exe_slave_drizzled;

our $exe_perror;

our $lib_udf_example;

our $lib_example_plugin;

our $exe_libtool;

our $exe_schemawriter;

our $opt_bench= 0;

our $opt_small_bench= 0;

our @opt_combinations;

our $opt_skip_combination;

our @opt_extra_drizzled_opt;

our $opt_compress;

our $opt_debug;

our $opt_do_test;

our @opt_cases;                  # The test cases names in argv

our $opt_engine;

our $opt_extern= 0;

our $opt_socket;

our $opt_fast;

our $opt_force;

our $opt_reorder= 0;

our $opt_enable_disabled;

our $opt_mem= $ENV{'DTR_MEM'};

our $opt_gcov;

our $opt_gcov_err;

our $opt_gcov_msg;

our $glob_debugger= 0;

our $opt_gdb;

our $opt_dbx;

our $opt_client_gdb;

our $opt_client_dbx;

our $opt_dbx_gdb;

our $opt_ddd;

our $opt_client_ddd;

our $opt_manual_gdb;

our $opt_manual_dbx;

our $opt_manual_ddd;

our $opt_manual_debug;

# Magic number -69.4 results in traditional test ports starting from 9306.

our $opt_dtr_build_thread=-69.4;

our $opt_debugger;

our $opt_client_debugger;

our $opt_gprof;

our $opt_gprof_dir;

our $opt_gprof_master;

our $opt_gprof_slave;

our $master;

our $slave;

our $clusters;

our $opt_master_myport;

our $opt_slave_myport;

our $opt_memc_myport;

our $opt_pbms_myport;

our $opt_rabbitmq_myport;

our $opt_record;

my $opt_report_features;

our $opt_check_testcases;

our $opt_mark_progress;

our $opt_skip_rpl= 1;

our $max_slave_num= 0;

our $max_master_num= 1;

our $use_innodb;

our $opt_skip_test;

our $opt_sleep;

our $opt_testcase_timeout;

our $opt_suite_timeout;

my  $default_testcase_timeout=     15; # 15 min max

my  $default_suite_timeout=       180; # 3 hours max

our $opt_start_and_exit;

our $opt_start_dirty;

our $opt_start_from;

our $opt_strace_client;

our $opt_timer= 1;

our $opt_user;

my $opt_valgrind= 0;

my $opt_valgrind_drizzled= 0;

my $opt_valgrind_drizzletest= 0;

my $opt_valgrind_drizzleslap= 0;

my @default_valgrind_args= ("--show-reachable=yes --malloc-fill=0xDEADBEEF --free-fill=0xDEADBEEF");

my @valgrind_args;

my $opt_valgrind_path;

my $opt_callgrind;

my $opt_massif;

our $opt_stress=               "";

our $opt_stress_suite=     "main";

our $opt_stress_mode=    "random";

our $opt_stress_threads=        5;

our $opt_stress_test_count=     0;

our $opt_stress_loop_count=     0;

our $opt_stress_test_duration=  0;

our $opt_stress_init_file=     "";

our $opt_stress_test_file=     "";

our $opt_warnings;

our $path_sql_dir;

our @data_dir_lst;

our $used_default_engine;

our $debug_compiled_binaries;

our %drizzled_variables;

my $source_dist= 0;

our $opt_max_save_core= 5;

my $num_saved_cores= 0;  # Number of core files saved in vardir/log/ so far.

our $secondary_port_offset= 50;

######################################################################

#

#  Function declarations

#

######################################################################

sub main ();

sub initial_setup ();

sub command_line_setup ();

sub set_dtr_build_thread_ports($);

sub datadir_list_setup ();

sub executable_setup ();

sub environment_setup ();

sub kill_running_servers ();

sub remove_stale_vardir ();

sub setup_vardir ();

sub check_running_as_root();

sub drizzled_wait_started($);

sub run_benchmarks ($);

sub initialize_servers ();

sub drizzle_install_db ();

sub copy_install_db ($$);

sub run_testcase ($);

sub run_testcase_stop_servers ($$$);

sub run_testcase_start_servers ($);

sub run_testcase_check_skip_test($);

sub report_failure_and_restart ($);

sub do_before_start_master ($);

sub do_before_start_slave ($);

sub drizzled_start ($$$);

sub drizzled_arguments ($$$$);

sub stop_all_servers ();

sub run_drizzletest ($);

sub collapse_path ($);

sub usage ($);

######################################################################

#

#  Main program

#

######################################################################

main();

sub main () {

  command_line_setup();

  check_debug_support(\%drizzled_variables);

  executable_setup();

  environment_setup();

  signal_setup();

  if ( $opt_gcov )

  {

    gcov_prepare();

  }

  if ( $opt_gprof )

  {

    gprof_prepare();

  }

  if ( $opt_bench )

  {

    initialize_servers();

    run_benchmarks(shift);      # Shift what? Extra arguments?!

  }

  elsif ( $opt_stress )

  {

    initialize_servers();

    run_stress_test()

  }

  else

  {

    if (!$opt_suites)

    {

        $opt_suites= $opt_suites_default;

        my %extra_suites= ();

        foreach my $dir ( reverse splitdir($glob_basedir) )

        {

            my $extra_suite= $extra_suites{$dir};

            if (defined $extra_suite){

                dtr_report("Found extra suite: $extra_suite");

                $opt_suites= "$extra_suite,$opt_suites";

                last;

            }

        }

    }

    my $tests= collect_test_cases($opt_suites);

    # Turn off NDB and other similar options if no tests use it

    foreach my $test (@$tests)

    {

      next if $test->{skip};

      if (!$opt_extern)

      {

	# Count max number of slaves used by a test case

	if ( $test->{slave_num} > $max_slave_num) {

	  $max_slave_num= $test->{slave_num};

	  dtr_error("Too many slaves") if $max_slave_num > 3;

	}

	# Count max number of masters used by a test case

	if ( $test->{master_num} > $max_master_num) {

	  $max_master_num= $test->{master_num};

	  dtr_error("Too many masters") if $max_master_num > 2;

	  dtr_error("Too few masters") if $max_master_num < 1;

	}

      }

      $use_innodb||= $test->{'innodb_test'};

    }

    initialize_servers();

    if ( $opt_report_features ) {

      run_report_features();

    }

    run_tests($tests);

  }

  dtr_exit(0);

}

##############################################################################

#

#  Default settings

#

##############################################################################

#

# When an option is no longer used by this program, it must be explicitly

# ignored or else it will be passed through to drizzled.  GetOptions will call

# this subroutine once for each such option on the command line.  See

# Getopt::Long documentation.

#

sub warn_about_removed_option {

  my ($option, $value, $hash_value) = @_;

  warn "WARNING: This option is no longer used, and is ignored: --$option\n";

}

sub command_line_setup () {

  # These are defaults for things that are set on the command line

  my $opt_comment;

  # If so requested, we try to avail ourselves of a unique build thread number.

  if ( $ENV{'DTR_BUILD_THREAD'} ) {

    if ( lc($ENV{'DTR_BUILD_THREAD'}) eq 'auto' ) {

      print "Requesting build thread... ";

      $ENV{'DTR_BUILD_THREAD'} = dtr_require_unique_id_and_wait("/tmp/drizzle-test-ports", 200, 299);

      print "got ".$ENV{'DTR_BUILD_THREAD'}."\n";

    }

  }

  if ( $ENV{'DTR_BUILD_THREAD'} )

  {

    set_dtr_build_thread_ports($ENV{'DTR_BUILD_THREAD'});

  }

  # This is needed for test log evaluation in "gen-build-status-page"

  # in all cases where the calling tool does not log the commands

  # directly before it executes them, like "make test-force-pl" in RPM builds.

  print "Logging: $0 ", join(" ", @ARGV), "\n";

  # Read the command line

  # Note: Keep list, and the order, in sync with usage at end of this file

  # Options that are no longer used must still be processed, because all

  # unprocessed options are passed directly to drizzled.  The user will be

  # warned that the option is being ignored.

  #

  # Put the complete option string here.  For example, to remove the --suite

  # option, remove it from GetOptions() below and put 'suite|suites=s' here.

  my @removed_options = (

    'skip-im',  # WL#4085 "Discontinue the instance manager"

  );

  Getopt::Long::Configure("pass_through");

  GetOptions(

             # Control what engine/variation to run

             'compress'                 => \$opt_compress,

             'bench'                    => \$opt_bench,

             'small-bench'              => \$opt_small_bench,

             # Control what test suites or cases to run

             'force'                    => \$opt_force,

             'do-test=s'                => \$opt_do_test,

             'start-from=s'             => \$opt_start_from,

             'suite|suites=s'           => \$opt_suites,

             'skip-rpl'                 => \$opt_skip_rpl,

             'skip-test=s'              => \$opt_skip_test,

             'combination=s'            => \@opt_combinations,

             'skip-combination'         => \$opt_skip_combination,

             # Specify ports

             'master_port=i'            => \$opt_master_myport,

             'slave_port=i'             => \$opt_slave_myport,

             'memc_port=i'              => \$opt_memc_myport,

	     'pbms_port=i'              => \$opt_pbms_myport,

	     'rabbitmq_port=i'              => \$opt_rabbitmq_myport,

	     'dtr-build-thread=i'       => \$opt_dtr_build_thread,

             # Test case authoring

             'record'                   => \$opt_record,

             'check-testcases'          => \$opt_check_testcases,

             'mark-progress'            => \$opt_mark_progress,

             # Extra options used when starting drizzled

             'drizzled=s'                 => \@opt_extra_drizzled_opt,

             'engine=s'                 => \$opt_engine,

             # Run test on running server

             'extern'                   => \$opt_extern,

             # Output format

             'subunit'                  => \$opt_subunit,

             # Debugging

             'gdb'                      => \$opt_gdb,

             'dbx'                      => \$opt_dbx,

             'client-gdb'               => \$opt_client_gdb,

             'client-dbx'               => \$opt_client_dbx,

             'manual-gdb'               => \$opt_manual_gdb,

             'manual-dbx'               => \$opt_manual_dbx,

             'manual-debug'             => \$opt_manual_debug,

             'ddd'                      => \$opt_ddd,

             'client-ddd'               => \$opt_client_ddd,

             'manual-ddd'               => \$opt_manual_ddd,

	     'debugger=s'               => \$opt_debugger,

	     'client-debugger=s'        => \$opt_client_debugger,

             'strace-client'            => \$opt_strace_client,

             'master-binary=s'          => \$exe_master_drizzled,

             'slave-binary=s'           => \$exe_slave_drizzled,

             'max-save-core=i'          => \$opt_max_save_core,

             # Coverage, profiling etc

             'gcov'                     => \$opt_gcov,

             'gprof'                    => \$opt_gprof,

             'valgrind|valgrind-all'    => \$opt_valgrind,

             'valgrind-drizzletest'       => \$opt_valgrind_drizzletest,

             'valgrind-drizzleslap'       => \$opt_valgrind_drizzleslap,

             'valgrind-drizzled'          => \$opt_valgrind_drizzled,

             'valgrind-options=s'       => sub {

	       my ($opt, $value)= @_;

	       # Deprecated option unless it's what we know pushbuild uses

	       if ($value eq "--gen-suppressions=all --show-reachable=yes") {

		 push(@valgrind_args, $_) for (split(' ', $value));

		 return;

	       }

	       die("--valgrind-options=s is deprecated. Use ",

		   "--valgrind-option=s, to be specified several",

		   " times if necessary");

	     },

             'valgrind-option=s'        => \@valgrind_args,

             'valgrind-path=s'          => \$opt_valgrind_path,

	     'callgrind'                => \$opt_callgrind,

	     'massif'                   => \$opt_massif,

             # Stress testing 

             'stress'                   => \$opt_stress,

             'stress-suite=s'           => \$opt_stress_suite,

             'stress-threads=i'         => \$opt_stress_threads,

             'stress-test-file=s'       => \$opt_stress_test_file,

             'stress-init-file=s'       => \$opt_stress_init_file,

             'stress-mode=s'            => \$opt_stress_mode,

             'stress-loop-count=i'      => \$opt_stress_loop_count,

             'stress-test-count=i'      => \$opt_stress_test_count,

             'stress-test-duration=i'   => \$opt_stress_test_duration,

	     # Directories

             'tmpdir=s'                 => \$opt_tmpdir,

             'vardir=s'                 => \$opt_vardir,

             'top-builddir=s'           => \$opt_top_builddir,

             'top-srcdir=s'             => \$opt_top_srcdir,

             'suitepath=s'              => \$opt_suitepath,

             'testdir=s'                => \$opt_testdir,

             'benchdir=s'               => \$glob_drizzle_bench_dir,

             'mem'                      => \$opt_mem,

             # Misc

             'report-features'          => \$opt_report_features,

             'comment=s'                => \$opt_comment,

             'debug'                    => \$opt_debug,

             'fast'                     => \$opt_fast,

             'reorder'                  => \$opt_reorder,

             'enable-disabled'          => \$opt_enable_disabled,

             'script-debug'             => \$opt_script_debug,

             'verbose'                  => \$opt_verbose,

             'sleep=i'                  => \$opt_sleep,

             'socket=s'                 => \$opt_socket,

             'start-dirty'              => \$opt_start_dirty,

             'start-and-exit'           => \$opt_start_and_exit,

             'timer!'                   => \$opt_timer,

             'user=s'                   => \$opt_user,

             'testcase-timeout=i'       => \$opt_testcase_timeout,

             'suite-timeout=i'          => \$opt_suite_timeout,

             'warnings|log-warnings'    => \$opt_warnings,

	     'repeat-test=i'            => \$opt_repeat_test,

             # Options which are no longer used

             (map { $_ => \&warn_about_removed_option } @removed_options),

             'help|h'                   => \$opt_usage,

            ) or usage("Can't read options");

  usage("you cannot specify --gdb and --dbx both!") if 

	($opt_gdb && $opt_dbx) ||

	($opt_manual_gdb && $opt_manual_dbx);

  $glob_scriptname=  basename($0);

  if ($opt_dtr_build_thread != 0)

  {

    set_dtr_build_thread_ports($opt_dtr_build_thread)

  }

  elsif ($ENV{'DTR_BUILD_THREAD'})

  {

    $opt_dtr_build_thread= $ENV{'DTR_BUILD_THREAD'};

  }

  if ( -d "../drizzled" )

  {

    $source_dist=  1;

  }

  # Find the absolute path to the test directory

  if ( ! $opt_testdir )

  {

    $glob_drizzle_test_dir=  cwd();

  } 

  else

  {

    $glob_drizzle_test_dir= $opt_testdir;

  }

  $default_vardir= "$glob_drizzle_test_dir/var";

  $default_top_srcdir= "$glob_drizzle_test_dir/..";

  $default_top_builddir= "$glob_drizzle_test_dir/..";

  if ( ! $opt_suitepath )

  {

    $glob_suite_path= "$glob_drizzle_test_dir/../plugin";

  }

  else

  {

    $glob_suite_path= $opt_suitepath;

  }

  # In most cases, the base directory we find everything relative to,

  # is the parent directory of the "drizzle-test" directory. For source

  # distributions, TAR binary distributions and some other packages.

  $glob_basedir= dirname($glob_drizzle_test_dir);

  # Figure out which tests we are going to run

  my $suitedir= "$glob_drizzle_test_dir/suite";

  if ( -d $suitedir )

  {

      opendir(SUITE_DIR, $suitedir)

          or dtr_error("can't open directory \"$suitedir\": $!");

      while ( my $elem= readdir(SUITE_DIR) )

      {

          next if $elem eq ".";

          next if $elem eq "..";

          next if $elem eq "big"; # Eats up too much disk

          next if $elem eq "large_tests"; # Eats up too much disk

          next if $elem eq "stress"; # Currently fails

          next if $elem eq "broken"; # Old broken test, mainly unsupported featurs

          my $local_dir= "$suitedir/$elem";

          next unless -d $local_dir;

          next unless -d "$local_dir/t"; # We want to make sure it has tests

          next unless -d "$local_dir/r"; # Ditto, results

          $opt_suites_default.= ",$elem";

      }

      closedir(SUITE_DIR);

  }

  usage("") if $opt_usage;

  # In the RPM case, binaries and libraries are installed in the

  # default system locations, instead of having our own private base

  # directory. And we install "/usr/share/drizzle-test". Moving up one

  # more directory relative to "drizzle-test" gives us a usable base

  # directory for RPM installs.

  if ( ! $source_dist and ! -d "$glob_basedir/bin" )

  {

    $glob_basedir= dirname($glob_basedir);

  }

  if ( $opt_testdir and -d $opt_testdir and $opt_vardir and -d $opt_vardir

         and -f "$opt_vardir/../../drizzled/drizzled")

  {

    # probably in a VPATH build

    $glob_builddir= "$opt_vardir/../..";

  }

  else

  {

    $glob_builddir="..";

  }

  # Expect drizzle-bench to be located adjacent to the source tree, by default

  $glob_drizzle_bench_dir= "$glob_basedir/../drizzle-bench"

    unless defined $glob_drizzle_bench_dir;

  $glob_drizzle_bench_dir= undef

    unless -d $glob_drizzle_bench_dir;

  $glob_timers= dtr_init_timers();

  #

  # Find the drizzled executable to be able to find the drizzled version

  # number as early as possible

  #

  # Look for the client binaries directory

  $path_client_bindir= dtr_path_exists("$glob_builddir/client",

                                       "$glob_basedir/client",

				       "$glob_basedir/bin");

  if (!$opt_extern)

  {

    $exe_drizzled=       dtr_exe_exists ("$glob_basedir/drizzled/drizzled",

				       "$path_client_bindir/drizzled",

				       "$glob_basedir/libexec/drizzled",

				       "$glob_basedir/bin/drizzled",

				       "$glob_basedir/sbin/drizzled",

                                       "$glob_builddir/drizzled/drizzled");

    # Use the drizzled found above to find out what features are available

    collect_drizzled_features();

  }

  else

  {

    $drizzled_variables{'port'}= 4427;

  }

  if (!$opt_engine)

  {

    $opt_engine= "innodb";

  }

  if ( $opt_comment )

  {

    print "\n";

    print '#' x 78, "\n";

    print "# $opt_comment\n";

    print '#' x 78, "\n\n";

  }

  foreach my $arg ( @ARGV )

  {

    if ( $arg =~ /^--skip-/ )

    {

      push(@opt_extra_drizzled_opt, $arg);

    }

    elsif ( $arg =~ /^--$/ )

    {

      # It is an effect of setting 'pass_through' in option processing

      # that the lone '--' separating options from arguments survives,

      # simply ignore it.

    }

    elsif ( $arg =~ /^-/ )

    {

      usage("Invalid option \"$arg\"");

    }

    else

    {

      push(@opt_cases, $arg);

    }

  }

  # --------------------------------------------------------------------------

  # Find out default storage engine being used(if any)

  # --------------------------------------------------------------------------

  foreach my $arg ( @opt_extra_drizzled_opt )

  {

    if ( $arg =~ /default-storage-engine=(\S+)/ )

    {

      $used_default_engine= $1;

    }

  }

  dtr_report("Using default engine '$used_default_engine'")