src/test/regress/gpexclude.pl - hawq - Git at Google

 #!/usr/bin/env perl
 #
 # Licensed to the Apache Software Foundation (ASF) under one
 # or more contributor license agreements.  See the NOTICE file
 # distributed with this work for additional information
 # regarding copyright ownership.  The ASF licenses this file
 # to you under the Apache License, Version 2.0 (the
 # "License"); you may not use this file except in compliance
 # with the License.  You may obtain a copy of the License at
 #
 #   http://www.apache.org/licenses/LICENSE-2.0
 #
 # Unless required by applicable law or agreed to in writing,
 # software distributed under the License is distributed on an
 # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
 # KIND, either express or implied.  See the License for the
 # specific language governing permissions and limitations
 # under the License.
 #
 #
 # Licensed to the Apache Software Foundation (ASF) under one
 # or more contributor license agreements.  See the NOTICE file
 # distributed with this work for additional information
 # regarding copyright ownership.  The ASF licenses this file
 # to you under the Apache License, Version 2.0 (the
 # "License"); you may not use this file except in compliance
 # with the License.  You may obtain a copy of the License at
 #
 #   http://www.apache.org/licenses/LICENSE-2.0
 #
 # Unless required by applicable law or agreed to in writing,
 # software distributed under the License is distributed on an
 # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
 # KIND, either express or implied.  See the License for the
 # specific language governing permissions and limitations
 # under the License.
 #
 use Pod::Usage;
 use Getopt::Long;
 use Data::Dumper;
 use strict;
 use warnings;

 =head1 NAME

 B<gpexclude.pl> - gpexclude

 =head1 SYNOPSIS

 B<gpexclude.pl> [options]

 Options:

     -help            brief help message
     -man             full documentation
     -connect         psql connect parameters
     -testname        test name
     -exclude_file    file containing exclusion rules
     -verbose         be very chatty
     -quiet           be very quiet

 =head1 OPTIONS

 =over 8

 =item B<-help>

     Print a brief help message and exits.

 =item B<-man>

     Prints the manual page and exits.

 =item B<-connect>

     psql connect string, e.g:

     -connect '-p 11000 -d template1'

     If the connect string is not defined gpexclude calls gpstringsubs
     which uses PGPORT and template1.  If the PGPORT is undefined then
     the port number defaults to 11000.

 =item B<-testname>

     Name of the test

 =item B<-exclude_file>

     File containing exclusion rules

 =item B<-verbose>

     Print rule matching and evaluation status to stdout.  Useful for
     debugging.

 =item B<-quiet>

     Return successfully even if the exclude file is not specified or
     does not exist.  This setting is useful for automated testing,
     since the assumption is that if the test schedule does not have an
     associated set of exclusions, then all the tests in the schedule
     are legal.


 =back

 =head1 DESCRIPTION

 gpexclude.pl takes as arguments the name of a test and a file of
 exclusion rules, and it returns 0 (TRUE) if the test should be
 executed, else it returns 1 (FALSE).  pg_regress invokes gpexclude.pl
 (supplying the test name and <schedule_name>.EXCLUDE) in order to
 determine if it should run or ignore that test.  gpexclude.pl calls
 gpstringsubs.pl to construct a hash of platform and configuration
 information.  It evaluates rules in the exclude file that reference
 this hash and returns FALSE if the test rule does not succeed.

 =head2 EXCLUDE file format

 pg_regress invokes gpexclude.pl with the assumption that each schedule
 has an associated exclude file with a ".EXCLUDE" suffix.  For example,
 for known_good_schedule, the exclude file is known_good_schedule.EXCLUDE.

 The exclude file can contain single-line comments, where the first
 non-blank character of the line is a pound sign (#).  If the line is
 not blank or a comment, it must be a rule, which has the following
 format:

 <test name regex> ::: <expression>

 That is, the first portion of the rule is a regular expression for a
 test name in perl regex format (see "man perlre").  gpexclude.pl
 automatically wraps the supplied expression with "^" and "$" to match
 the beginning and of the line, so a simple regex like "foo" only
 matches a test with the exact name of "foo".  If you want to use the
 "foo" as a prefix match, you must specify "foo.*".  If you want a rule
 that matches every test name specify ".*".  A test name can match
 multiple rules as long as the expression evaluates to TRUE.
 gpexclude.pl returns FALSE for the first rule that fails.

 The regex and expression are separated by three colons (:::), mainly
 to avoid the problem that a single colon is often a component of a
 perl regex.  Leading and trailing whitespace is ignored.

 The expression must be a perl boolean expression which evaluates to
 TRUE or FALSE.  This expression can reference the "$gpx" hash, which
 is defined at the start of gpexclude.pl with various platform and
 configuration values.  For example, to enforce that the test
 "sql_mojo" only runs on configurations with 5 segments, you can define
 a rule:

   sql_mojo ::: $gpx->{number_of_segs} == 5

 If the expression is TRUE, gpexclude will continue

 =head1 AUTHORS

 Apache HAWQ

 Address bug reports and comments to: dev@hawq.apache.org

 =cut

 my $glob_id = "";
 my $glob_h1;
 my $glob_tname;
 my $glob_exclude;
 my $glob_verbose;

 sub stringsubs
 {
     use IO::File;
     use File::Temp;

     my ($conn_str, $verbose) = @_;

     my ($tmpnam, $tmpfh);

     for (;;) {
         $tmpnam = tmpnam();
         sysopen($tmpfh, $tmpnam, O_RDWR | O_CREAT | O_EXCL) && last;
     }

     # write to a temporary file

     close $tmpfh;

     my $gpx = {};

     open ($tmpfh, "> $tmpnam") or die "Could not open file $tmpnam for writing : $! \n";

     my $bigstr = <<'BIG_END';
 $gpx->{hostname} = "@hostname@";
 $gpx->{generic_processor} = "@gpuname_p@";
 $gpx->{isainfo} = "@gpisainfo@";
 $gpx->{osname} = "@perl_osname@";
 $gpx->{number_of_segs} = "@number_of_segs@";
 BIG_END

     print $tmpfh $bigstr;

     close $tmpfh;

     my $gpstringsubs = "gpstringsubs.pl";

     {

         my $plname = $0;

         my @foo = File::Spec->rel2abs(File::Spec->splitpath($plname));

         if (scalar(@foo))
         {
             pop @foo;

             $gpstringsubs =
                 File::Spec->rel2abs(
                                     File::Spec->catfile(
                                                         @foo,
                                                         "gpstringsubs.pl"
                                                         ));
         }
     }

     system "$gpstringsubs $conn_str $tmpnam";

     open ($tmpfh, "< $tmpnam") or die "Could not open file $tmpnam for reading : $! \n";

     {
         # undefine input record separator (\n")
         # and slurp entire file into variable
         local $/;
         undef $/;

         my $whole_file = <$tmpfh>;

         eval "$whole_file";

         if ($@)
         {
             die "failed to evaluate file $tmpnam";
         }
     }

     if ($verbose)
     {
         print "gpx hash values are:\n";
         print Data::Dumper->Dump([$gpx]), "\n";
     }


     close $tmpfh;

     unlink $tmpnam;

     return $gpx;
 }

 BEGIN {
     my $man  = 0;
     my $help = 0;
     my $conn;
     my $tname;
     my $exclude;
     my $verbose;
     my $quiet;

     GetOptions(
                'help|?' => \$help, man => \$man,
                "connect=s" => \$conn,
                "testname=s" => \$tname,
                "exclude_file=s" => \$exclude,
                "verbose" => \$verbose,
                "quiet" => \$quiet
                )
         or pod2usage(2);


     pod2usage(-msg => $glob_id, -exitstatus => 1) if $help;
     pod2usage(-msg => $glob_id, -exitstatus => 0, -verbose => 2) if $man;

     if ($quiet)
     {
         # quiet mode just exits if no exclude file
         exit(0)
             unless (defined($exclude) && length($exclude) && (-f $exclude));
     }


     unless ((defined($tname) && length($tname)) &&
             (defined($exclude) && length($exclude)))
     {
         my $got_tname = (defined($tname) && length($tname));
         my $got_exclu = (defined($exclude) && length($exclude));


         if ($got_tname)
         {
             $glob_id = "Missing required --exclude_file option"
         }
         else
         {
             if ($got_exclu)
             {
                 $glob_id = "Missing required --testname option"
             }
             else
             {
                 $glob_id = "Missing required --exclude_file and --testname options"
             }
         }

         pod2usage(-msg => $glob_id, -exitstatus => 2);
     }

     my $conn_str = "";

     $conn_str = "-c \'$conn\'"
         if (defined($conn) && length($conn));

     $glob_verbose = $verbose;

     $glob_h1 = stringsubs($conn_str, $verbose);

     $glob_exclude = $exclude;
     $glob_tname = $tname;

 }


 if (1)
 {
     my $fh;
     my $infile   = $glob_exclude;
     my $testname = $glob_tname;

     # hash of platform/os/configuration values
     my $gpx = $glob_h1;

     open ($fh, "< $infile ")
         or die "Could not open file $infile for reading : $! \n";

     print "reading from file $infile\n"
         if ($glob_verbose);

     my $linecount = 0;

     while (<$fh>) # big while
     {
         my $ini = $_;

 #        print $ini;

         $linecount++;

         next
             if (($ini =~ m/^\s*\#/) || # ignore comments
                 ($ini =~ m/^\s*$/));   # or blanks

         chomp $ini;

         my @foo = split(/\:\:\:/, $ini, 2);

         die "invalid format for file $infile, line $linecount: $ini"
             unless (2 == scalar(@foo));

         # trim leading and trailing spaces
         $foo[0] =~ s/^\s+//gm;
         $foo[1] =~ s/^\s+//gm;
         $foo[0] =~ s/\s+$//gm;
         $foo[1] =~ s/\s+$//gm;

         my $regex1 = '^(' . $foo[0] . ')$';

         if ($testname =~ m/$regex1/)
         {
             print "line $linecount: $testname matches $foo[0]\n"
                 if ($glob_verbose);

             my $stat;

             my $stat_str = '$stat = (' . $foo[1] . ')';

             eval "$stat_str";
             if ($@)
             {
                 die "invalid condition in file $infile at line $linecount:\n$stat_str";
             }

 #            print $ini;

             if ($stat)
             {
                 print "\tTRUE:  ($foo[1])\n"
                     if ($glob_verbose);
             }
             else
             {
                 print "\tFALSE: ($foo[1])\n"
                     if ($glob_verbose);

                 exit(1);
             }

         }

     } # end big while

     exit(0);

 }

 exit(0);
	#!/usr/bin/env perl
	#
	# Licensed to the Apache Software Foundation (ASF) under one
	# or more contributor license agreements. See the NOTICE file
	# distributed with this work for additional information
	# regarding copyright ownership. The ASF licenses this file
	# to you under the Apache License, Version 2.0 (the
	# "License"); you may not use this file except in compliance
	# with the License. You may obtain a copy of the License at
	#
	# http://www.apache.org/licenses/LICENSE-2.0
	#
	# Unless required by applicable law or agreed to in writing,
	# software distributed under the License is distributed on an
	# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
	# KIND, either express or implied. See the License for the
	# specific language governing permissions and limitations
	# under the License.
	#
	#
	# Licensed to the Apache Software Foundation (ASF) under one
	# or more contributor license agreements. See the NOTICE file
	# distributed with this work for additional information
	# regarding copyright ownership. The ASF licenses this file
	# to you under the Apache License, Version 2.0 (the
	# "License"); you may not use this file except in compliance
	# with the License. You may obtain a copy of the License at
	#
	# http://www.apache.org/licenses/LICENSE-2.0
	#
	# Unless required by applicable law or agreed to in writing,
	# software distributed under the License is distributed on an
	# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
	# KIND, either express or implied. See the License for the
	# specific language governing permissions and limitations
	# under the License.
	#
	use Pod::Usage;
	use Getopt::Long;
	use Data::Dumper;
	use strict;
	use warnings;

	=head1 NAME

	B<gpexclude.pl> - gpexclude

	=head1 SYNOPSIS

	B<gpexclude.pl> [options]

	Options:

	-help brief help message
	-man full documentation
	-connect psql connect parameters
	-testname test name
	-exclude_file file containing exclusion rules
	-verbose be very chatty
	-quiet be very quiet

	=head1 OPTIONS

	=over 8

	=item B<-help>

	Print a brief help message and exits.

	=item B<-man>

	Prints the manual page and exits.

	=item B<-connect>

	psql connect string, e.g:

	-connect '-p 11000 -d template1'

	If the connect string is not defined gpexclude calls gpstringsubs
	which uses PGPORT and template1. If the PGPORT is undefined then
	the port number defaults to 11000.

	=item B<-testname>

	Name of the test

	=item B<-exclude_file>

	File containing exclusion rules

	=item B<-verbose>

	Print rule matching and evaluation status to stdout. Useful for
	debugging.

	=item B<-quiet>

	Return successfully even if the exclude file is not specified or
	does not exist. This setting is useful for automated testing,
	since the assumption is that if the test schedule does not have an
	associated set of exclusions, then all the tests in the schedule
	are legal.


	=back

	=head1 DESCRIPTION

	gpexclude.pl takes as arguments the name of a test and a file of
	exclusion rules, and it returns 0 (TRUE) if the test should be
	executed, else it returns 1 (FALSE). pg_regress invokes gpexclude.pl
	(supplying the test name and <schedule_name>.EXCLUDE) in order to
	determine if it should run or ignore that test. gpexclude.pl calls
	gpstringsubs.pl to construct a hash of platform and configuration
	information. It evaluates rules in the exclude file that reference
	this hash and returns FALSE if the test rule does not succeed.

	=head2 EXCLUDE file format

	pg_regress invokes gpexclude.pl with the assumption that each schedule
	has an associated exclude file with a ".EXCLUDE" suffix. For example,
	for known_good_schedule, the exclude file is known_good_schedule.EXCLUDE.

	The exclude file can contain single-line comments, where the first
	non-blank character of the line is a pound sign (#). If the line is
	not blank or a comment, it must be a rule, which has the following
	format:

	<test name regex> ::: <expression>

	That is, the first portion of the rule is a regular expression for a
	test name in perl regex format (see "man perlre"). gpexclude.pl
	automatically wraps the supplied expression with "^" and "$" to match
	the beginning and of the line, so a simple regex like "foo" only
	matches a test with the exact name of "foo". If you want to use the
	"foo" as a prefix match, you must specify "foo.*". If you want a rule
	that matches every test name specify ".*". A test name can match
	multiple rules as long as the expression evaluates to TRUE.
	gpexclude.pl returns FALSE for the first rule that fails.

	The regex and expression are separated by three colons (:::), mainly
	to avoid the problem that a single colon is often a component of a
	perl regex. Leading and trailing whitespace is ignored.

	The expression must be a perl boolean expression which evaluates to
	TRUE or FALSE. This expression can reference the "$gpx" hash, which
	is defined at the start of gpexclude.pl with various platform and
	configuration values. For example, to enforce that the test
	"sql_mojo" only runs on configurations with 5 segments, you can define
	a rule:

	sql_mojo ::: $gpx->{number_of_segs} == 5

	If the expression is TRUE, gpexclude will continue

	=head1 AUTHORS

	Apache HAWQ

	Address bug reports and comments to: dev@hawq.apache.org

	=cut

	my $glob_id = "";
	my $glob_h1;
	my $glob_tname;
	my $glob_exclude;
	my $glob_verbose;

	sub stringsubs
	{
	use IO::File;
	use File::Temp;

	my ($conn_str, $verbose) = @_;

	my ($tmpnam, $tmpfh);

	for (;;) {
	$tmpnam = tmpnam();
	sysopen($tmpfh, $tmpnam, O_RDWR \| O_CREAT \| O_EXCL) && last;
	}

	# write to a temporary file

	close $tmpfh;

	my $gpx = {};

	open ($tmpfh, "> $tmpnam") or die "Could not open file $tmpnam for writing : $! \n";

	my $bigstr = <<'BIG_END';
	$gpx->{hostname} = "@hostname@";
	$gpx->{generic_processor} = "@gpuname_p@";
	$gpx->{isainfo} = "@gpisainfo@";
	$gpx->{osname} = "@perl_osname@";
	$gpx->{number_of_segs} = "@number_of_segs@";
	BIG_END

	print $tmpfh $bigstr;

	close $tmpfh;

	my $gpstringsubs = "gpstringsubs.pl";

	{

	my $plname = $0;

	my @foo = File::Spec->rel2abs(File::Spec->splitpath($plname));

	if (scalar(@foo))
	{
	pop @foo;

	$gpstringsubs =
	File::Spec->rel2abs(
	File::Spec->catfile(
	@foo,
	"gpstringsubs.pl"
	));
	}
	}

	system "$gpstringsubs $conn_str $tmpnam";

	open ($tmpfh, "< $tmpnam") or die "Could not open file $tmpnam for reading : $! \n";

	{
	# undefine input record separator (\n")
	# and slurp entire file into variable
	local $/;
	undef $/;

	my $whole_file = <$tmpfh>;

	eval "$whole_file";

	if ($@)
	{
	die "failed to evaluate file $tmpnam";
	}
	}

	if ($verbose)
	{
	print "gpx hash values are:\n";
	print Data::Dumper->Dump([$gpx]), "\n";
	}


	close $tmpfh;

	unlink $tmpnam;

	return $gpx;
	}

	BEGIN {
	my $man = 0;
	my $help = 0;
	my $conn;
	my $tname;
	my $exclude;
	my $verbose;
	my $quiet;

	GetOptions(
	'help\|?' => \$help, man => \$man,
	"connect=s" => \$conn,
	"testname=s" => \$tname,
	"exclude_file=s" => \$exclude,
	"verbose" => \$verbose,
	"quiet" => \$quiet
	)
	or pod2usage(2);


	pod2usage(-msg => $glob_id, -exitstatus => 1) if $help;
	pod2usage(-msg => $glob_id, -exitstatus => 0, -verbose => 2) if $man;

	if ($quiet)
	{
	# quiet mode just exits if no exclude file
	exit(0)
	unless (defined($exclude) && length($exclude) && (-f $exclude));
	}



	unless ((defined($tname) && length($tname)) &&
	(defined($exclude) && length($exclude)))
	{
	my $got_tname = (defined($tname) && length($tname));
	my $got_exclu = (defined($exclude) && length($exclude));


	if ($got_tname)
	{
	$glob_id = "Missing required --exclude_file option"
	}
	else
	{
	if ($got_exclu)
	{
	$glob_id = "Missing required --testname option"
	}
	else
	{
	$glob_id = "Missing required --exclude_file and --testname options"
	}
	}

	pod2usage(-msg => $glob_id, -exitstatus => 2);
	}

	my $conn_str = "";

	$conn_str = "-c \'$conn\'"
	if (defined($conn) && length($conn));

	$glob_verbose = $verbose;

	$glob_h1 = stringsubs($conn_str, $verbose);

	$glob_exclude = $exclude;
	$glob_tname = $tname;

	}


	if (1)
	{
	my $fh;
	my $infile = $glob_exclude;
	my $testname = $glob_tname;

	# hash of platform/os/configuration values
	my $gpx = $glob_h1;

	open ($fh, "< $infile ")
	or die "Could not open file $infile for reading : $! \n";

	print "reading from file $infile\n"
	if ($glob_verbose);

	my $linecount = 0;

	while (<$fh>) # big while
	{
	my $ini = $_;

	# print $ini;

	$linecount++;

	next
	if (($ini =~ m/^\s*\#/) \|\| # ignore comments
	($ini =~ m/^\s*$/)); # or blanks

	chomp $ini;

	my @foo = split(/\:\:\:/, $ini, 2);

	die "invalid format for file $infile, line $linecount: $ini"
	unless (2 == scalar(@foo));

	# trim leading and trailing spaces
	$foo[0] =~ s/^\s+//gm;
	$foo[1] =~ s/^\s+//gm;
	$foo[0] =~ s/\s+$//gm;
	$foo[1] =~ s/\s+$//gm;

	my $regex1 = '^(' . $foo[0] . ')$';

	if ($testname =~ m/$regex1/)
	{
	print "line $linecount: $testname matches $foo[0]\n"
	if ($glob_verbose);

	my $stat;

	my $stat_str = '$stat = (' . $foo[1] . ')';

	eval "$stat_str";
	if ($@)
	{
	die "invalid condition in file $infile at line $linecount:\n$stat_str";
	}

	# print $ini;

	if ($stat)
	{
	print "\tTRUE: ($foo[1])\n"
	if ($glob_verbose);
	}
	else
	{
	print "\tFALSE: ($foo[1])\n"
	if ($glob_verbose);

	exit(1);
	}

	}

	} # end big while

	exit(0);

	}

	exit(0);