You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
148 lines
3.8 KiB
148 lines
3.8 KiB
# -*- cperl -*-
|
|
# Copyright (c) 2008, 2018, Oracle and/or its affiliates. All rights reserved.
|
|
#
|
|
# 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
|
|
|
|
#
|
|
# One test
|
|
#
|
|
package My::Test;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
|
|
use mtr_results;
|
|
|
|
my %result_names = ('MTR_RES_PASSED' => 'pass',
|
|
'MTR_RES_FAILED' => 'fail',
|
|
'MTR_RES_SKIPPED' => 'skipped',);
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = bless { @_, }, $class;
|
|
return $self;
|
|
}
|
|
|
|
# Return a unique key that can be used to
|
|
# identify this test in a hash.
|
|
sub key {
|
|
my ($self) = @_;
|
|
return $self->{key};
|
|
}
|
|
|
|
sub _encode {
|
|
my ($value) = @_;
|
|
$value =~ s/([|\\\x{0a}\x{0d}])/sprintf('\%02X', ord($1))/eg;
|
|
return $value;
|
|
}
|
|
|
|
sub _decode {
|
|
my ($value) = @_;
|
|
$value =~ s/\\([0-9a-fA-F]{2})/chr(hex($1))/ge;
|
|
return $value;
|
|
}
|
|
|
|
sub is_failed {
|
|
my ($self) = @_;
|
|
my $result = $self->{result};
|
|
croak "'is_failed' can't be called until test has been run!"
|
|
unless defined $result;
|
|
|
|
return ($result eq 'MTR_RES_FAILED');
|
|
}
|
|
|
|
sub write_test {
|
|
my ($test, $sock, $header) = @_;
|
|
|
|
if ($::opt_resfile && defined $test->{'result'}) {
|
|
resfile_test_info("result", $result_names{ $test->{'result'} });
|
|
if ($test->{'timeout'}) {
|
|
resfile_test_info("comment", "Timeout");
|
|
} elsif (defined $test->{'comment'}) {
|
|
resfile_test_info("comment", $test->{'comment'});
|
|
}
|
|
resfile_test_info("result", "warning") if defined $test->{'check'};
|
|
resfile_to_test($test);
|
|
}
|
|
|
|
# Give the test a unique key before serializing it
|
|
$test->{key} = "$test" unless defined $test->{key};
|
|
|
|
print $sock $header, "\n";
|
|
while ((my ($key, $value)) = each(%$test)) {
|
|
print $sock $key, "= ";
|
|
if (ref $value eq "ARRAY") {
|
|
print $sock "[", _encode(join(", ", @$value)), "]";
|
|
} else {
|
|
print $sock _encode($value);
|
|
}
|
|
print $sock "\n";
|
|
}
|
|
print $sock "\n";
|
|
}
|
|
|
|
sub read_test {
|
|
my ($sock) = @_;
|
|
my $test = My::Test->new();
|
|
|
|
# Read the ':' separated key value pairs until a single newline
|
|
# on it's own line
|
|
my $line;
|
|
while (defined($line = <$sock>)) {
|
|
# List is terminated by newline on it's own
|
|
if ($line eq "\n") {
|
|
# Correctly terminated reply print "Got newline\n"
|
|
last;
|
|
}
|
|
chomp($line);
|
|
|
|
# Split key/value on the first "="
|
|
my ($key, $value) = split("= ", $line, 2);
|
|
|
|
if ($value =~ /^\[(.*)\]/) {
|
|
my @values = split(", ", _decode($1));
|
|
push(@{ $test->{$key} }, @values);
|
|
} else {
|
|
$test->{$key} = _decode($value);
|
|
}
|
|
}
|
|
resfile_from_test($test) if $::opt_resfile;
|
|
return $test;
|
|
}
|
|
|
|
sub print_test {
|
|
my ($self) = @_;
|
|
|
|
print "[", $self->{name}, "]", "\n";
|
|
while ((my ($key, $value)) = each(%$self)) {
|
|
print " ", $key, "= ";
|
|
if (ref $value eq "ARRAY") {
|
|
print "[", join(", ", @$value), "]";
|
|
} else {
|
|
print $value;
|
|
}
|
|
print "\n";
|
|
}
|
|
print "\n";
|
|
}
|
|
|
|
1;
|
|
|