#!/tmp/perl5 -w

# h2xs test suite
#  mar 2, 96

use strict;
use vars qw( $opt_n $opt_e $opt_f );
use Getopt::Std 'getopts';
use Cwd 'getcwd';
use File::Path 'rmtree';
use Carp 'croak';
use Config '%Config';

my @MMargs = qw(
	PERL_SRC=~/xlib/Perl5
	INST_ARCHLIB=~/usr/lib/perl5
	INST_LIB=~/usr/lib/perl5
	INST_EXE=~/bin
	INST_MAN3DIR=~/usr/lib/perl5/pod
	INST_MAN1DIR=~/usr/lib/perl5/pod
	INSTALLDIRS=perl
) if( ($ENV{LOGNAME} eq 'roehrich') && ($Config{osname} eq 'solaris'));


getopts( 'ne:f:' );
# -n		Forces global NOMAKE (Makefile.PL and make are not run).
# -e <num>	Runs only the specified test.
# -f <num>	Run specified test, and any that follow it.


my $perl;
($perl = $Config{startperl}) =~ s/^#!//;
my $args = join( " ", @MMargs );
my $PLcmd = "$perl Makefile.PL $args";
my $topwd = getcwd();
my @all;

my @XS = (
#       {'OPTS' => '',
#        'NAME' => '',
#	'TOP'  => '',
#	'MODULE' => '',
#	'PM_POS_SEARCH' => [],
#	'PM_NEG_SEARCH' => [],
#	'XS_POS_SEARCH' => [],
#	'XS_NEG_SEARCH' => [],
#	'PL_POS_SEARCH' => [],
#	'PL_NEG_SEARCH' => [],
#	},

       # 0: Normal XS extension, no autoloading at all.
       {'OPTS' => '-An',
        'NAME' => 'Foo',
	'TOP'  => 'Foo',
	'MODULE' => 'Foo',
	'PM_POS_SEARCH' => ['after =cut',
			 'stub of documentation',
			 '^require Exporter',
			 '^require DynaLoader',
			 '^package Foo;',
			 '^bootstrap Foo \$VERSION;',
			 'ISA = .*?DynaLoader',
			 'ISA = .*?Exporter',
			 ],
	'PM_NEG_SEARCH' => ['^require AutoLoader;',
			 '^use vars .*?\$AUTOLOAD',
			 '^use Carp;',
			 'ISA = .*?AutoLoader',
			 'sub AUTOLOAD',
			 ],
	'XS_POS_SEARCH' => [
			 '^MODULE = Foo\s+PACKAGE = Foo\n',
			 ],
	'XS_NEG_SEARCH' => [
			 '^constant',
			 ],
	'PL_POS_SEARCH' => [
			 q{VERSION_FROM.*?'Foo.pm},
			 'LIBS.*?=>',
			 ],
	'PL_NEG_SEARCH' => [
			 '\$Verbose',
			 ],
       },

       # 1: Same as (0), but nested.
       {'OPTS' => '-An',
        'NAME' => 'Foo::Bar::Baz::Burp',
	'TOP'  => 'Foo',
	'MODULE' => 'Burp',
	'PM_POS_SEARCH' => ['after =cut',
			 'stub of documentation',
			 '^require Exporter',
			 '^require DynaLoader',
			 '^package Foo::Bar::Baz::Burp;',
			 '^bootstrap Foo::Bar::Baz::Burp \$VERSION;',
			 'ISA = .*?DynaLoader',
			 'ISA = .*?Exporter',
			 ],
	'PM_NEG_SEARCH' => ['^require AutoLoader;',
			 '^use Carp;',
			 'ISA = .*?AutoLoader',
			 '^use vars .*?\$AUTOLOAD',
			 'sub AUTOLOAD',
			 ],
	'XS_POS_SEARCH' => [
			 '^MODULE = Foo::Bar::Baz::Burp\s+PACKAGE = Foo::Bar::Baz::Burp\n',
			 ],
	'XS_NEG_SEARCH' => [
			 '^constant',
			 ],
	'PL_POS_SEARCH' => [
			 q{VERSION_FROM.*?'Burp.pm},
			 'LIBS.*?=>',
			 ],
	'PL_NEG_SEARCH' => [
			 '\$Verbose',
			 ],
	'NOMAKE' => 1,
       },

       # 2: Same as (0), but without a POD.
       {'OPTS' => '-APn',
        'NAME' => 'Foo',
	'TOP'  => 'Foo',
	'MODULE' => 'Foo',
	'PM_POS_SEARCH' => ['after __END__',
			 '^require Exporter',
			 '^require DynaLoader',
			 '^package Foo;',
			 '^bootstrap Foo \$VERSION;',
			 'ISA = .*?DynaLoader',
			 'ISA = .*?Exporter',
			 ],
	'PM_NEG_SEARCH' => ['^require AutoLoader;',
			 'ISA = .*?AutoLoader',
			 '^use Carp;',
			 '^use vars .*?\$AUTOLOAD',
			 'sub AUTOLOAD',
			 'stub of documentation',
			 ],
	'XS_POS_SEARCH' => [
			 '^MODULE = Foo\s+PACKAGE = Foo\n',
			 ],
	'XS_NEG_SEARCH' => [
			 '^constant',
			 ],
	'PL_POS_SEARCH' => [
			 q{VERSION_FROM.*?'Foo.pm},
			 'LIBS.*?=>',
			 ],
	'PL_NEG_SEARCH' => [
			 '\$Verbose',
			 ],
       },

       # 3: Same as (0), but with -X
       {'OPTS' => '-AXn',
        'NAME' => 'Foo',
	'TOP'  => 'Foo',
	'MODULE' => 'Foo',
	'PM_POS_SEARCH' => ['after =cut',
			 'stub of documentation',
			 '^require AutoLoader;',
			 '^require Exporter',
			 '^package Foo;',
			 'ISA = .*?AutoLoader',
			 'ISA = .*?Exporter',
			 ],
	'PM_NEG_SEARCH' => ['^require DynaLoader',
			 'ISA = .*?DynaLoader',
			 '^bootstrap Foo',
			 '^use Carp;',
			 '^use vars .*?\$AUTOLOAD',
			 'sub AUTOLOAD',
			 ],
	'XSEMPTY' => 1,
	'PL_POS_SEARCH' => [
			 q{VERSION_FROM.*?'Foo.pm},
			 ],
	'PL_NEG_SEARCH' => [
			 '\$Verbose',
			 'LIBS.*?=>',
			 ],
	'NOMAKE' => 1,
       },

       # 4: Same as (0), but without -A
       {'OPTS' => '-n',
        'NAME' => 'Foo',
	'TOP'  => 'Foo',
	'MODULE' => 'Foo',
	'PM_POS_SEARCH' => ['after =cut',
			 'stub of documentation',
			 '^require AutoLoader;',
			 '^require Exporter',
			 '^require DynaLoader',
			 '^package Foo;',
			 'ISA = .*?Exporter',
			 'ISA = .*?DynaLoader',
			 '^bootstrap Foo \$VERSION;',
			 '^use vars .*?\$AUTOLOAD',
			 '^use Carp;',
			 'sub AUTOLOAD',
			 ],
	'PM_NEG_SEARCH' => ['ISA = .*?AutoLoader',
			 ],
	'XS_POS_SEARCH' => [
			 '^MODULE = Foo\s+PACKAGE = Foo\n',
			 '^constant',
			 ],
	'XS_NEG_SEARCH' => [
			 ],
	'PL_POS_SEARCH' => [
			 q{VERSION_FROM.*?'Foo.pm},
			 'LIBS.*?=>',
			 ],
	'PL_NEG_SEARCH' => [
			 '\$Verbose',
			 ],
       },

       # 5: Same as (4), but with -X
       {'OPTS' => '-Xn',
        'NAME' => 'Foo',
	'TOP'  => 'Foo',
	'MODULE' => 'Foo',
	'PM_POS_SEARCH' => ['after =cut',
			 'stub of documentation',
			 '^require AutoLoader;',
			 '^require Exporter',
			 '^package Foo;',
			 'ISA = .*?Exporter',
			 'ISA = .*?AutoLoader',
			 ],
	'PM_NEG_SEARCH' => [
			 '^require DynaLoader',
			 'ISA = .*?DynaLoader',
			 '^use Carp;',
			 '^use vars .*?\$AUTOLOAD',
			 'sub AUTOLOAD',
			 '^bootstrap Foo \$VERSION;',
			 ],
	'XSEMPTY' => 1,
	'PL_POS_SEARCH' => [
			 q{VERSION_FROM.*?'Foo.pm},
			 ],
	'PL_NEG_SEARCH' => [
			 '\$Verbose',
			 'LIBS.*?=>',
			 ],
	'NOMAKE' => 1,
       },

       # 6: Same as (0), but with -c rather than -A
       {'OPTS' => '-cn',
        'NAME' => 'Foo',
	'TOP'  => 'Foo',
	'MODULE' => 'Foo',
	'PM_POS_SEARCH' => ['after =cut',
			 'stub of documentation',
			 '^require Exporter',
			 '^require AutoLoader;',
			 '^require DynaLoader',
			 '^package Foo;',
			 '^bootstrap Foo \$VERSION;',
			 'ISA = .*?DynaLoader',
			 'ISA = .*?Exporter',
			 'ISA = .*?AutoLoader',
			 ],
	'PM_NEG_SEARCH' => [
			 '^use vars .*?\$AUTOLOAD',
			 '^use Carp;',
			 'sub AUTOLOAD',
			 ],
	'XS_POS_SEARCH' => [
			 '^MODULE = Foo\s+PACKAGE = Foo\n',
			 ],
	'XS_NEG_SEARCH' => [
			 '^constant',
			 ],
	'PL_POS_SEARCH' => [
			 q{VERSION_FROM.*?'Foo.pm},
			 'LIBS.*?=>',
			 ],
	'PL_NEG_SEARCH' => [
			 '\$Verbose',
			 ],
       },

       # 7: sys/socket.h
       {'OPTS' => '',
        'NAME' => 'sys/socket.h',
	'TOP'  => 'Socket',
	'DIR'  => 'Socket',
	'MODULE' => 'Socket',
	'PM_POS_SEARCH' => ['after =cut',
			 'stub of documentation',
			 '^require AutoLoader;',
			 '^require Exporter',
			 '^require DynaLoader',
			 '^package Socket;',
			 'ISA = .*?Exporter',
			 'ISA = .*?DynaLoader',
			 '^bootstrap Socket \$VERSION;',
			 '^use vars .*?\$AUTOLOAD',
			 '^use Carp;',
			 'sub AUTOLOAD',
			 ],
	'PM_NEG_SEARCH' => ['ISA = .*?AutoLoader',
			 ],
	'XS_POS_SEARCH' => [
			 '^MODULE = Socket\s+PACKAGE = Socket\n',
			 '^constant',
			 ],
	'XS_NEG_SEARCH' => [
			 ],
	'PL_POS_SEARCH' => [
			 q{VERSION_FROM.*?'Socket.pm},
			 'LIBS.*?=>',
			 ],
	'PL_NEG_SEARCH' => [
			 '\$Verbose',
			 ],
       },

);

if( defined $opt_e ){
	@all = $XS[$opt_e];
}
elsif( defined $opt_f ){
	@all = @XS[$opt_f..$#XS];
}
else{
	@all = @XS;
}


sub main {
	my $attribs;

	foreach $attribs (@all){
		runtest( $attribs );
	}
}
&main;

sub runtest {
	my $attribs = shift;
	my( $dir, $pm, $xs, $pl );

	print "TEST:  $attribs->{OPTS} $attribs->{NAME}\n";
	if( exists $attribs->{DIR} ){
		$dir = $attribs->{DIR};
	}
	else {
		($dir = $attribs->{NAME}) =~ s,::,/,g;
	}
	myrun( "h2xs $attribs->{OPTS} $attribs->{NAME}" );
	chdir( $dir ) || die "Error building extension $attribs->{NAME}";
	$pm = slurpmodule( "$attribs->{MODULE}.pm" );
	pos_searches( $pm, $attribs->{PM_POS_SEARCH}, $attribs );
	neg_searches( $pm, $attribs->{PM_NEG_SEARCH}, $attribs );
	if( exists $attribs->{XSEMPTY} ){
		print "XSEMPTY\n";
		if( -f "$attribs->{MODULE}.xs" ){
			die "XS file exists, but shouldn't";
		}
	}
	else{
		$xs = slurpmodule( "$attribs->{MODULE}.xs" );
		pos_searches( $xs, $attribs->{XS_POS_SEARCH}, $attribs );
		neg_searches( $xs, $attribs->{XS_NEG_SEARCH}, $attribs );
	}
	$pl = slurpmodule( "Makefile.PL" );
	pos_searches( $pl, $attribs->{PL_POS_SEARCH}, $attribs );
	neg_searches( $pl, $attribs->{PL_NEG_SEARCH}, $attribs );
	unless( $opt_n || exists $attribs->{NOMAKE} ){
		myrun( $PLcmd );
		myrun( 'make' );
		myrun( 'make test' );
		myrun( 'make realclean' );
		unlink( 'perl' ) if -f 'perl';
	}
	chdir( $topwd );
	rmtree( $attribs->{TOP} );
}



sub pos_searches {
	my $lines = shift;
	my $pos = shift;
	my $attribs = shift;
	my $pat;

	print "POS Checking file: $lines->[0]\n";
	foreach $pat ( @$pos ){
		print qq{  POS search for: "$pat"\n};
		search( $lines, $pat ) ||
			croak( qq{$lines->[0]: wanted "$pat" but didn't find it.\n});
	}
}

sub neg_searches {
	my $lines = shift;
	my $neg = shift;
	my $attribs = shift;
	my $pat;

	print "NEG Checking file: $lines->[0]\n";
	foreach $pat ( @$neg ){
		print qq{  NEG search for: "$pat"\n};
		search( $lines, $pat ) &&
			croak( qq{$lines->[0]: found "$pat" but didn't want it.\n});
	}
}


sub myrun {
	my $cmd = shift;

	system $cmd;
	if( ($? / 256) > 0 ){
		die "failed with status ", ($? / 256), "";
	}
}

sub slurpmodule {
	my $module = shift;
	my @PM;
	local *main::D;
	open( main::D, "<$module" ) || croak( "Unable to open $module\n" );
	@PM = <main::D>;
	close main::D;
	[$module, \@PM];
}

sub search {
	my $l = shift;
	my $lines = $l->[1];
	my $pat = shift;

	foreach(@$lines){
		if( /$pat/ ){
			return 1;
		}
	}
	return 0;
}