Current Path : /home/usr.opt/mysql57/mysql-test/lib/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : /home/usr.opt/mysql57/mysql-test/lib/mtr_misc.pl |
# -*- cperl -*- # Copyright (c) 2004, 2021, Oracle and/or its affiliates. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License, version 2.0, # as published by the Free Software Foundation. # # This program is also distributed with certain software (including # but not limited to OpenSSL) that is licensed under separate terms, # as designated in a particular file or component or in included license # documentation. The authors of MySQL hereby grant you an additional # permission to link the program and your derivative works with the # separately licensed software that they have included with MySQL. # # 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, version 2.0, 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 # This is a library file used by the Perl version of mysql-test-run, # and is part of the translation of the Bourne shell script with the # same name. use strict; use My::Platform; sub mtr_init_args ($); sub mtr_add_arg ($$@); sub mtr_args2str($@); sub mtr_path_exists(@); sub mtr_script_exists(@); sub mtr_file_exists(@); sub mtr_exe_exists(@); sub mtr_exe_maybe_exists(@); sub mtr_compress_file($); sub mtr_milli_sleep($); sub start_timer($); sub has_expired($); sub init_timers(); sub mark_time_used($); sub mark_time_idle(); sub add_total_times($); sub print_times_used($$); sub print_total_times($); our $opt_report_times; ############################################################################## # # Args # ############################################################################## sub mtr_init_args ($) { my $args = shift; $$args = []; # Empty list } sub mtr_add_arg ($$@) { my $args= shift; my $format= shift; my @fargs = @_; # Quote args if args contain space $format= "\"$format\"" if (IS_WINDOWS and grep(/\s/, @fargs)); push(@$args, sprintf($format, @fargs)); } sub mtr_args2str($@) { my $exe= shift or die; return join(" ", native_path($exe), @_); } ############################################################################## # # NOTE! More specific paths should be given before less specific. # For example /client/debug should be listed before /client # sub mtr_path_exists (@) { foreach my $path ( @_ ) { return $path if -e $path; } if ( @_ == 1 ) { mtr_error("Could not find $_[0]"); } else { mtr_error("Could not find any of " . join(" ", @_)); } } # # NOTE! More specific paths should be given before less specific. # For example /client/debug should be listed before /client # sub mtr_script_exists (@) { foreach my $path ( @_ ) { if(IS_WINDOWS) { return $path if -f $path; } else { return $path if -x $path; } } if ( @_ == 1 ) { mtr_error("Could not find $_[0]"); } else { mtr_error("Could not find any of " . join(" ", @_)); } } # # NOTE! More specific paths should be given before less specific. # For example /client/debug should be listed before /client # sub mtr_file_exists (@) { foreach my $path ( @_ ) { return $path if -e $path; } return ""; } # # NOTE! More specific paths should be given before less specific. # For example /client/debug should be listed before /client # sub mtr_exe_maybe_exists (@) { my @path= @_; map {$_.= ".exe"} @path if IS_WINDOWS; foreach my $path ( @path ) { if(IS_WINDOWS) { return $path if -f $path; } else { return $path if -x $path; } } return ""; } # # NOTE! More specific paths should be given before less specific. # sub mtr_pl_maybe_exists (@) { my @path= @_; map {$_.= ".pl"} @path if IS_WINDOWS; foreach my $path ( @path ) { if(IS_WINDOWS) { return $path if -f $path; } else { return $path if -x $path; } } return ""; } # # NOTE! More specific paths should be given before less specific. # For example /client/debug should be listed before /client # sub mtr_exe_exists (@) { my @path= @_; if (my $path= mtr_exe_maybe_exists(@path)) { return $path; } # Could not find exe, show error if ( @path == 1 ) { mtr_error("Could not find $path[0]"); } else { mtr_error("Could not find any of " . join(" ", @path)); } } # # Try to compress file using tools that might be available. # If zip/gzip is not available, just silently ignore. # sub mtr_compress_file ($) { my ($filename)= @_; mtr_error ("File to compress not found: $filename") unless -f $filename; my $did_compress= 0; if (IS_WINDOWS) { # Capture stderr my $ziperr= `zip $filename.zip $filename 2>&1`; if ($?) { print "$ziperr\n" if $ziperr !~ /recognized as an internal or external/; } else { unlink($filename); $did_compress=1; } } else { my $gzres= system("gzip $filename"); $did_compress= ! $gzres; if ($gzres && $gzres != -1) { mtr_error ("Error: have gzip but it fails to compress core file"); } } mtr_print("Compressed file $filename") if $did_compress; } sub mtr_milli_sleep ($) { die "usage: mtr_milli_sleep(milliseconds)" unless @_ == 1; my ($millis)= @_; select(undef, undef, undef, ($millis/1000)); } # Simple functions to start and check timers (have to be actively polled) # Timer can be "killed" by setting it to 0 sub start_timer ($) { return time + $_[0]; } sub has_expired ($) { return $_[0] && time gt $_[0]; } # Below code is for time usage reporting use Time::HiRes qw(gettimeofday); my %time_used= ( 'collect' => 0, 'restart' => 0, 'check' => 0, 'ch-warn' => 0, 'test' => 0, 'init' => 0, 'admin' => 0, ); my %time_text= ( 'collect' => "Collecting test cases", 'restart' => "Server stop/start", 'check' => "Check-testcase", 'ch-warn' => "Check for warnings", 'test' => "Test execution", 'init' => "Initialization/cleanup", 'admin' => "Test administration", ); # Counts number of reports from workers my $time_totals= 0; my $last_timer_set; sub init_timers() { $last_timer_set= gettimeofday(); } sub mark_time_used($) { my ($name)= @_; return unless $opt_report_times; die "Unknown timer $name" unless exists $time_used{$name}; my $curr_time= gettimeofday(); $time_used{$name}+= int (($curr_time - $last_timer_set) * 1000 + .5); $last_timer_set= $curr_time; } sub mark_time_idle() { $last_timer_set= gettimeofday() if $opt_report_times; } sub add_total_times($) { my ($dummy, $num, @line)= split (" ", $_[0]); $time_totals++; foreach my $elem (@line) { my ($name, $spent)= split (":", $elem); $time_used{$name}+= $spent; } } sub print_times_used($$) { my ($server, $num)= @_; return unless $opt_report_times; my $output= "SPENT $num"; foreach my $name (keys %time_used) { my $spent= $time_used{$name}; $output.= " $name:$spent"; } print $server $output . "\n"; } sub print_total_times($) { # Don't print if we haven't received all worker data return if $time_totals != $_[0]; foreach my $name (keys %time_used) { my $spent= $time_used{$name}/1000; my $text= $time_text{$name}; print ("Spent $spent seconds on $text\n"); } } 1;