[perl5.git] / ext / Devel / PPPort / t / ppphtest.t

################################################################################
#
#            !!!!!   Do NOT edit this file directly!   !!!!!
#
#            Edit mktests.PL and/or parts/inc/ppphtest instead.
#
################################################################################

BEGIN {
  if ($ENV{'PERL_CORE'}) {
    chdir 't' if -d 't';
    @INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
    require Config; import Config;
    use vars '%Config';
    if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
      print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
      exit 0;
    }
  }
  else {
    unshift @INC, 't';
  }

  eval "use Test";
  if ($@) {
    require 'testutil.pl';
    print "1..134\n";
  }
  else {
    plan(tests => 134);
  }
}

use Devel::PPPort;
use strict;
$^W = 1;

use File::Path qw/rmtree mkpath/;
use Config;

my $tmp = 'ppptmp';
my $inc = '';
my $perl = find_perl();

rmtree($tmp) if -d $tmp;
mkpath($tmp) or die "mkpath $tmp: $!\n";
chdir($tmp) or die "chdir $tmp: $!\n";

if ($ENV{'PERL_CORE'}) {
  if (-d '../../lib') {
    $inc = $^O eq 'VMS' ? '-"I../../lib"' : '-I../../lib';
    unshift @INC, '../../lib';
  }
}
if ($perl =~ m!^\./!) {
  $perl = ".$perl";
}

END {
  chdir('..') if !-d $tmp && -d "../$tmp";
  rmtree($tmp) if -d $tmp;
}

ok(&Devel::PPPort::WriteFile("ppport.h"));

sub ppport
{
  my @args = @_;
  print "# *** running $perl $inc ppport.h @args ***\n";
  my $out = join '', `$perl $inc ppport.h @args`;
  my $copy = $out;
  $copy =~ s/^/# | /mg;
  print "$copy\n";
  return $out;
}

sub matches
{
  my($str, $re, $mod) = @_;
  my @n;
  eval "\@n = \$str =~ /$re/g$mod;";
  if ($@) {
    my $err = $@;
    $err =~ s/^/# *** /mg;
    print "# *** ERROR ***\n$err\n";
  }
  return $@ ? -42 : scalar @n;
}

sub eq_files
{
  my($f1, $f2) = @_;
  return 0 unless -e $f1 && -e $f2;
  local *F;
  for ($f1, $f2) {
    print "# File: $_\n";
    unless (open F, $_) {
      print "# couldn't open $_: $!\n";
      return 0;
    }
    $_ = do { local $/; <F> };
    close F;
    my $copy = $_;
    $copy =~ s/^/# | /mg;
    print "$copy\n";
  }
  return $f1 eq $f2;
}

my @tests;

for (split /\s*={70,}\s*/, do { local $/; <DATA> }) {
  s/^\s+//; s/\s+$//;
  my($c, %f);
  ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/;
  push @tests, { code => $c, files => \%f };
}

my $t;
for $t (@tests) {
  my $f;
  for $f (keys %{$t->{files}}) {
    my @f = split /\//, $f;
    if (@f > 1) {
      pop @f;
      my $path = join '/', @f;
      mkpath($path) or die "mkpath('$path'): $!\n";
    }
    my $txt = $t->{files}{$f};
    local *F;
    open F, ">$f" or die "open $f: $!\n";
    print F "$txt\n";
    close F;
    $txt =~ s/^/# | /mg;
    print "# *** writing $f ***\n$txt\n";
  }

  eval $t->{code};
  if ($@) {
    my $err = $@;
    $err =~ s/^/# *** /mg;
    print "# *** ERROR ***\n$err\n";
  }
  ok($@, '');

  for (keys %{$t->{files}}) {
    unlink $_ or die "unlink('$_'): $!\n";
  }
}

sub find_perl
{
  my $perl = $^X;
  
  return $perl if $^O eq 'VMS';
  
  my $exe = $Config{'_exe'} || '';
  
  if ($perl =~ /^perl\Q$exe\E$/i) {
    $perl = "perl$exe";
    eval "require File::Spec";
    if ($@) {
      $perl = "./$perl";
    } else {
      $perl = File::Spec->catfile(File::Spec->curdir(), $perl);
    }
  }
  
  if ($perl !~ /\Q$exe\E$/i) {
    $perl .= $exe;
  }
  
  warn "find_perl: cannot find $perl from $^X" unless -f $perl;
  
  return $perl;
}

__DATA__

my $o = ppport(qw(--help));
ok($o =~ /^Usage:.*ppport\.h/m);
ok($o =~ /--help/m);

$o = ppport(qw(--nochanges));
ok($o =~ /^scanning.*test\.xs/mi);
ok($o =~ /analyzing.*test\.xs/mi);
ok(matches($o, '^scanning', 'mi'), 1);
ok(matches($o, 'analyzing', 'mi'), 1);
ok($o =~ /Uses Perl_newSViv instead of newSViv/);

$o = ppport(qw(--quiet --nochanges));
ok($o =~ /^\s*$/);

---------------------------- test.xs ------------------------------------------

Perl_newSViv();

===============================================================================

# check if C and C++ comments are filtered correctly

my $o = ppport(qw(--copy=a));
ok($o =~ /^scanning.*MyExt\.xs/mi);
ok($o =~ /analyzing.*MyExt\.xs/mi);
ok(matches($o, '^scanning', 'mi'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
ok($o =~ /Uses 1 C\+\+ style comment/m);
ok(eq_files('MyExt.xsa', 'MyExt.ra'));

# check if C++ are left untouched with --cplusplus

$o = ppport(qw(--copy=b --cplusplus));
ok($o =~ /^scanning.*MyExt\.xs/mi);
ok($o =~ /analyzing.*MyExt\.xs/mi);
ok(matches($o, '^scanning', 'mi'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
ok($o !~ /Uses \d+ C\+\+ style comment/m);
ok(eq_files('MyExt.xsb', 'MyExt.rb'));

unlink qw(MyExt.xsa MyExt.xsb);

---------------------------- MyExt.xs -----------------------------------------
  
newSVuv();
    // newSVpv();
  XPUSHs(foo);
/* grok_bin(); */

---------------------------- MyExt.ra -----------------------------------------
  
#include "ppport.h"
newSVuv();
    /* newSVpv(); */
  XPUSHs(foo);
/* grok_bin(); */

---------------------------- MyExt.rb -----------------------------------------
  
#include "ppport.h"
newSVuv();
    // newSVpv();
  XPUSHs(foo);
/* grok_bin(); */

===============================================================================

my $o = ppport(qw(--nochanges file1.xs));
ok($o =~ /^scanning.*file1\.xs/mi);
ok($o =~ /analyzing.*file1\.xs/mi);
ok($o !~ /^scanning.*file2\.xs/mi);
ok($o =~ /^Uses newCONSTSUB/m);
ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_nolen/m);
ok($o =~ /hint for newCONSTSUB/m);
ok($o !~ /hint for sv_2pv_nolen/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --nohints file1.xs));
ok($o =~ /^scanning.*file1\.xs/mi);
ok($o =~ /analyzing.*file1\.xs/mi);
ok($o !~ /^scanning.*file2\.xs/mi);
ok($o =~ /^Uses newCONSTSUB/m);
ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_nolen/m);
ok($o !~ /hint for newCONSTSUB/m);
ok($o !~ /hint for sv_2pv_nolen/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --nohints --nodiag file1.xs));
ok($o =~ /^scanning.*file1\.xs/mi);
ok($o =~ /analyzing.*file1\.xs/mi);
ok($o !~ /^scanning.*file2\.xs/mi);
ok($o !~ /^Uses newCONSTSUB/m);
ok($o !~ /^Uses SvPV_nolen/m);
ok($o !~ /hint for newCONSTSUB/m);
ok($o !~ /hint for sv_2pv_nolen/m);
ok($o =~ /^Looks good/m);

$o = ppport(qw(--nochanges --quiet file1.xs));
ok($o =~ /^\s*$/);

$o = ppport(qw(--nochanges file2.xs));
ok($o =~ /^scanning.*file2\.xs/mi);
ok($o =~ /analyzing.*file2\.xs/mi);
ok($o !~ /^scanning.*file1\.xs/mi);
ok($o =~ /^Uses mXPUSHp/m);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Looks good/m);
ok($o =~ /^1 potentially required change detected/m);

$o = ppport(qw(--nochanges --nohints file2.xs));
ok($o =~ /^scanning.*file2\.xs/mi);
ok($o =~ /analyzing.*file2\.xs/mi);
ok($o !~ /^scanning.*file1\.xs/mi);
ok($o =~ /^Uses mXPUSHp/m);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Looks good/m);
ok($o =~ /^1 potentially required change detected/m);

$o = ppport(qw(--nochanges --nohints --nodiag file2.xs));
ok($o =~ /^scanning.*file2\.xs/mi);
ok($o =~ /analyzing.*file2\.xs/mi);
ok($o !~ /^scanning.*file1\.xs/mi);
ok($o !~ /^Uses mXPUSHp/m);
ok($o !~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Looks good/m);
ok($o =~ /^1 potentially required change detected/m);

$o = ppport(qw(--nochanges --quiet file2.xs));
ok($o =~ /^\s*$/);

---------------------------- file1.xs -----------------------------------------

#define NEED_newCONSTSUB
#define NEED_sv_2pv_nolen
#include "ppport.h"

newCONSTSUB();
SvPV_nolen();

---------------------------- file2.xs -----------------------------------------

mXPUSHp(foo);

===============================================================================

my $o = ppport(qw(--nochanges));
ok($o =~ /^scanning.*FooBar\.xs/mi);
ok($o =~ /analyzing.*FooBar\.xs/mi);
ok(matches($o, '^scanning', 'mi'), 1);
ok($o !~ /^Looks good/m);
ok($o =~ /^Uses grok_bin/m);

---------------------------- FooBar.xs ----------------------------------------

newSViv();
XPUSHs(foo);
grok_bin();

===============================================================================

my $o = ppport(qw(--nochanges));
ok($o =~ /^scanning.*First\.xs/mi);
ok($o =~ /analyzing.*First\.xs/mi);
ok($o =~ /^scanning.*second\.h/mi);
ok($o =~ /analyzing.*second\.h/mi);
ok($o =~ /^scanning.*sub.*third\.c/mi);
ok($o =~ /analyzing.*sub.*third\.c/mi);
ok($o !~ /^scanning.*foobar/mi);
ok(matches($o, '^scanning', 'mi'), 3);

---------------------------- First.xs -----------------------------------------

one

---------------------------- foobar.xyz ---------------------------------------

two

---------------------------- second.h -----------------------------------------

three

---------------------------- sub/third.c --------------------------------------

four

===============================================================================

my $o = ppport(qw(--nochanges));
ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i);

---------------------------- test.xs ------------------------------------------

#define NEED_foobar

===============================================================================

# And now some complex "real-world" example

my $o = ppport(qw(--copy=f));
for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) {
  ok($o =~ /^scanning.*\Q$_\E/mi);
  ok($o =~ /analyzing.*\Q$_\E/i);
}
ok(matches($o, '^scanning', 'mi'), 6);

ok(matches($o, '^Writing copy of', 'mi'), 5);
ok(!-e "mod5.cf");

for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
  ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi);
  ok(-e "${_}f");
  ok(eq_files("${_}f", "${_}r"));
  unlink "${_}f";
}

---------------------------- main.xs ------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_newCONSTSUB
#define NEED_grok_hex_GLOBAL
#include "ppport.h"

newCONSTSUB();
grok_hex();
Perl_grok_bin(aTHX_ foo, bar);

/* some comment */

perl_eval_pv();
grok_bin();
Perl_grok_bin(bar, sv_no);

---------------------------- mod1.c -------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_grok_bin_GLOBAL
#define NEED_newCONSTSUB
#include "ppport.h"

newCONSTSUB();
grok_bin();
{
  Perl_croak ("foo");
  Perl_sv_catpvf();  /* I know it's wrong ;-) */
}

---------------------------- mod2.c -------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_eval_pv
#include "ppport.h"

newSViv();

/*
   eval_pv();
*/

---------------------------- mod3.c -------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

grok_oct();
eval_pv();

---------------------------- mod4.c -------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

START_MY_CXT;

---------------------------- mod5.c -------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"
call_pv();

---------------------------- main.xsr -----------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_eval_pv_GLOBAL
#define NEED_grok_hex
#define NEED_newCONSTSUB_GLOBAL
#include "ppport.h"

newCONSTSUB();
grok_hex();
grok_bin(foo, bar);

/* some comment */

eval_pv();
grok_bin();
grok_bin(bar, PL_sv_no);

---------------------------- mod1.cr ------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_grok_bin_GLOBAL
#include "ppport.h"

newCONSTSUB();
grok_bin();
{
  Perl_croak (aTHX_ "foo");
  Perl_sv_catpvf(aTHX);  /* I know it's wrong ;-) */
}

---------------------------- mod2.cr ------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"


newSViv();

/*
   eval_pv();
*/

---------------------------- mod3.cr ------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define NEED_grok_oct
#include "ppport.h"

grok_oct();
eval_pv();

---------------------------- mod4.cr ------------------------------------------

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"

START_MY_CXT;

===============================================================================

my $o = ppport(qw(--nochanges));
ok($o =~ /Uses grok_hex/m);
ok($o !~ /Looks good/m);

$o = ppport(qw(--nochanges --compat-version=5.8.0));
ok($o !~ /Uses grok_hex/m);
ok($o =~ /Looks good/m);

---------------------------- FooBar.xs ----------------------------------------

grok_hex();

===============================================================================

my $o = ppport(qw(--nochanges));
ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);

$o = ppport(qw(--nochanges --compat-version=5.6.0));
ok($o !~ /Uses SvPVutf8_force/m);

---------------------------- FooBar.xs ----------------------------------------

SvPVutf8_force();

===============================================================================

my $o = ppport(qw(--nochanges));
ok($o !~ /potentially required change/);
ok(matches($o, '^Looks good', 'mi'), 2);

---------------------------- FooBar.xs ----------------------------------------

#define NEED_grok_numeric_radix
#define NEED_grok_number
#include "ppport.h"

GROK_NUMERIC_RADIX();
grok_number();

---------------------------- foo.c --------------------------------------------

#include "ppport.h"

call_pv();
Commit	Line	Data
adfe19db MHM	1	################################################################################
	2	#
	3	# !!!!! Do NOT edit this file directly! !!!!!
	4	#
	5	# Edit mktests.PL and/or parts/inc/ppphtest instead.
	6	#
	7	################################################################################
	8
	9	BEGIN {
	10	if ($ENV{'PERL_CORE'}) {
	11	chdir 't' if -d 't';
	12	@INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
	13	require Config; import Config;
	14	use vars '%Config';
a745474a	15	if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
adfe19db MHM	16	print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
	17	exit 0;
	18	}
	19	}
	20	else {
	21	unshift @INC, 't';
	22	}
	23
	24	eval "use Test";
	25	if ($@) {
	26	require 'testutil.pl';
96ad942f	27	print "1..134\n";
adfe19db MHM	28	}
adfe19db MHM	29	else {
96ad942f	30	plan(tests => 134);
adfe19db MHM	31	}
	32	}
	33
	34	use Devel::PPPort;
	35	use strict;
	36	$^W = 1;
	37
	38	use File::Path qw/rmtree mkpath/;
96ad942f	39	use Config;
adfe19db MHM	40
adfe19db MHM	41	my $tmp = 'ppptmp';
96ad942f MHM	42	my $inc = '';
96ad942f MHM	43	my $perl = find_perl();
adfe19db MHM	44
	45	rmtree($tmp) if -d $tmp;
	46	mkpath($tmp) or die "mkpath $tmp: $!\n";
	47	chdir($tmp) or die "chdir $tmp: $!\n";
	48
adfe19db	49	if ($ENV{'PERL_CORE'}) {
87499469	50	if (-d '../../lib') {
d8d9a455	51	$inc = $^O eq 'VMS' ? '-"I../../lib"' : '-I../../lib';
87499469 MHM	52	unshift @INC, '../../lib';
87499469 MHM	53	}
adfe19db	54	}
96ad942f MHM	55	if ($perl =~ m!^\./!) {
	56	$perl = ".$perl";
	57	}
adfe19db MHM	58
adfe19db MHM	59	END {
cd266515 MHM	60	chdir('..') if !-d $tmp && -d "../$tmp";
cd266515 MHM	61	rmtree($tmp) if -d $tmp;
adfe19db MHM	62	}
	63
	64	ok(&Devel::PPPort::WriteFile("ppport.h"));
	65
	66	sub ppport
	67	{
	68	my @args = @_;
96ad942f MHM	69	print "# * running $perl $inc ppport.h @args *\n";
96ad942f MHM	70	my $out = join '', `$perl $inc ppport.h @args`;
adfe19db MHM	71	my $copy = $out;
	72	$copy =~ s/^/# \| /mg;
	73	print "$copy\n";
	74	return $out;
	75	}
	76
	77	sub matches
	78	{
	79	my($str, $re, $mod) = @_;
	80	my @n;
	81	eval "\@n = \$str =~ /$re/g$mod;";
	82	if ($@) {
	83	my $err = $@;
	84	$err =~ s/^/# *** /mg;
	85	print "# * ERROR *\n$err\n";
	86	}
	87	return $@ ? -42 : scalar @n;
	88	}
	89
	90	sub eq_files
	91	{
	92	my($f1, $f2) = @_;
	93	return 0 unless -e $f1 && -e $f2;
	94	local *F;
	95	for ($f1, $f2) {
	96	print "# File: $_\n";
	97	unless (open F, $_) {
	98	print "# couldn't open $_: $!\n";
	99	return 0;
	100	}
	101	$_ = do { local $/; <F> };
	102	close F;
	103	my $copy = $_;
	104	$copy =~ s/^/# \| /mg;
	105	print "$copy\n";
	106	}
	107	return $f1 eq $f2;
	108	}
	109
	110	my @tests;
	111
	112	for (split /\s={70,}\s/, do { local $/; <DATA> }) {
	113	s/^\s+//; s/\s+$//;
	114	my($c, %f);
	115	($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s-{20,}\s+\S+\s+-{20,}\s/;
	116	push @tests, { code => $c, files => \%f };
	117	}
	118
	119	my $t;
	120	for $t (@tests) {
	121	my $f;
	122	for $f (keys %{$t->{files}}) {
	123	my @f = split /\//, $f;
	124	if (@f > 1) {
	125	pop @f;
	126	my $path = join '/', @f;
	127	mkpath($path) or die "mkpath('$path'): $!\n";
	128	}
	129	my $txt = $t->{files}{$f};
	130	local *F;
	131	open F, ">$f" or die "open $f: $!\n";
	132	print F "$txt\n";
	133	close F;
	134	$txt =~ s/^/# \| /mg;
135	print "# * writing $f *\n$txt\n";
136	}
137
138	eval $t->{code};
139	if ($@) {
140	my $err = $@;
141	$err =~ s/^/# *** /mg;
142	print "# * ERROR *\n$err\n";
143	}
144	ok($@, '');
145
146	for (keys %{$t->{files}}) {
147	unlink $_ or die "unlink('$_'): $!\n";
148	}
149	}
150
96ad942f MHM	151	sub find_perl
	152	{
	153	my $perl = $^X;
	154
	155	return $perl if $^O eq 'VMS';
	156
	157	my $exe = $Config{'_exe'} \|\| '';
	158
	159	if ($perl =~ /^perl\Q$exe\E$/i) {
	160	$perl = "perl$exe";
	161	eval "require File::Spec";
	162	if ($@) {
	163	$perl = "./$perl";
	164	} else {
	165	$perl = File::Spec->catfile(File::Spec->curdir(), $perl);
	166	}
	167	}
	168
	169	if ($perl !~ /\Q$exe\E$/i) {
	170	$perl .= $exe;
	171	}
	172
	173	warn "find_perl: cannot find $perl from $^X" unless -f $perl;
	174
	175	return $perl;
	176	}
	177
adfe19db MHM	178	__DATA__
	179
	180	my $o = ppport(qw(--help));
	181	ok($o =~ /^Usage:.*ppport\.h/m);
	182	ok($o =~ /--help/m);
	183
	184	$o = ppport(qw(--nochanges));
	185	ok($o =~ /^scanning.*test\.xs/mi);
	186	ok($o =~ /analyzing.*test\.xs/mi);
	187	ok(matches($o, '^scanning', 'mi'), 1);
	188	ok(matches($o, 'analyzing', 'mi'), 1);
	189	ok($o =~ /Uses Perl_newSViv instead of newSViv/);
	190
	191	$o = ppport(qw(--quiet --nochanges));
	192	ok($o =~ /^\s*$/);
	193
	194	---------------------------- test.xs ------------------------------------------
	195
	196	Perl_newSViv();
	197
	198	===============================================================================
	199
	200	# check if C and C++ comments are filtered correctly
	201
	202	my $o = ppport(qw(--copy=a));
	203	ok($o =~ /^scanning.*MyExt\.xs/mi);
	204	ok($o =~ /analyzing.*MyExt\.xs/mi);
	205	ok(matches($o, '^scanning', 'mi'), 1);
	206	ok($o =~ /^Needs to include.*ppport\.h/m);
	207	ok($o !~ /^Uses grok_bin/m);
	208	ok($o !~ /^Uses newSVpv/m);
	209	ok($o =~ /Uses 1 C\+\+ style comment/m);
	210	ok(eq_files('MyExt.xsa', 'MyExt.ra'));
	211
	212	# check if C++ are left untouched with --cplusplus
	213
	214	$o = ppport(qw(--copy=b --cplusplus));
	215	ok($o =~ /^scanning.*MyExt\.xs/mi);
	216	ok($o =~ /analyzing.*MyExt\.xs/mi);
	217	ok(matches($o, '^scanning', 'mi'), 1);
	218	ok($o =~ /^Needs to include.*ppport\.h/m);
	219	ok($o !~ /^Uses grok_bin/m);
	220	ok($o !~ /^Uses newSVpv/m);
	221	ok($o !~ /Uses \d+ C\+\+ style comment/m);
	222	ok(eq_files('MyExt.xsb', 'MyExt.rb'));
	223
	224	unlink qw(MyExt.xsa MyExt.xsb);
	225
	226	---------------------------- MyExt.xs -----------------------------------------
	227
	228	newSVuv();
	229	// newSVpv();
	230	XPUSHs(foo);
	231	/* grok_bin(); */
	232
	233	---------------------------- MyExt.ra -----------------------------------------
	234
	235	#include "ppport.h"
	236	newSVuv();
	237	/* newSVpv(); */
	238	XPUSHs(foo);
	239	/* grok_bin(); */
	240
	241	---------------------------- MyExt.rb -----------------------------------------
242
243	#include "ppport.h"
244	newSVuv();
245	// newSVpv();
246	XPUSHs(foo);
247	/* grok_bin(); */
248
249	===============================================================================
250
251	my $o = ppport(qw(--nochanges file1.xs));
252	ok($o =~ /^scanning.*file1\.xs/mi);
253	ok($o =~ /analyzing.*file1\.xs/mi);
254	ok($o !~ /^scanning.*file2\.xs/mi);
255	ok($o =~ /^Uses newCONSTSUB/m);
256	ok($o =~ /^Uses SvPV_nolen.depends.sv_2pv_nolen/m);
257	ok($o =~ /hint for newCONSTSUB/m);
258	ok($o !~ /hint for sv_2pv_nolen/m);
259	ok($o =~ /^Looks good/m);
260
261	$o = ppport(qw(--nochanges --nohints file1.xs));
262	ok($o =~ /^scanning.*file1\.xs/mi);
263	ok($o =~ /analyzing.*file1\.xs/mi);
264	ok($o !~ /^scanning.*file2\.xs/mi);
265	ok($o =~ /^Uses newCONSTSUB/m);
266	ok($o =~ /^Uses SvPV_nolen.depends.sv_2pv_nolen/m);
267	ok($o !~ /hint for newCONSTSUB/m);
268	ok($o !~ /hint for sv_2pv_nolen/m);
269	ok($o =~ /^Looks good/m);
270
271	$o = ppport(qw(--nochanges --nohints --nodiag file1.xs));
272	ok($o =~ /^scanning.*file1\.xs/mi);
273	ok($o =~ /analyzing.*file1\.xs/mi);
274	ok($o !~ /^scanning.*file2\.xs/mi);
275	ok($o !~ /^Uses newCONSTSUB/m);
276	ok($o !~ /^Uses SvPV_nolen/m);
277	ok($o !~ /hint for newCONSTSUB/m);
278	ok($o !~ /hint for sv_2pv_nolen/m);
279	ok($o =~ /^Looks good/m);
280
281	$o = ppport(qw(--nochanges --quiet file1.xs));
282	ok($o =~ /^\s*$/);
283
284	$o = ppport(qw(--nochanges file2.xs));
285	ok($o =~ /^scanning.*file2\.xs/mi);
286	ok($o =~ /analyzing.*file2\.xs/mi);
287	ok($o !~ /^scanning.*file1\.xs/mi);
288	ok($o =~ /^Uses mXPUSHp/m);
289	ok($o =~ /^Needs to include.*ppport\.h/m);
290	ok($o !~ /^Looks good/m);
291	ok($o =~ /^1 potentially required change detected/m);
292
293	$o = ppport(qw(--nochanges --nohints file2.xs));
294	ok($o =~ /^scanning.*file2\.xs/mi);
295	ok($o =~ /analyzing.*file2\.xs/mi);
296	ok($o !~ /^scanning.*file1\.xs/mi);
297	ok($o =~ /^Uses mXPUSHp/m);
298	ok($o =~ /^Needs to include.*ppport\.h/m);
299	ok($o !~ /^Looks good/m);
300	ok($o =~ /^1 potentially required change detected/m);
301
302	$o = ppport(qw(--nochanges --nohints --nodiag file2.xs));
303	ok($o =~ /^scanning.*file2\.xs/mi);
304	ok($o =~ /analyzing.*file2\.xs/mi);
305	ok($o !~ /^scanning.*file1\.xs/mi);
306	ok($o !~ /^Uses mXPUSHp/m);
307	ok($o !~ /^Needs to include.*ppport\.h/m);
308	ok($o !~ /^Looks good/m);
309	ok($o =~ /^1 potentially required change detected/m);
310
311	$o = ppport(qw(--nochanges --quiet file2.xs));
312	ok($o =~ /^\s*$/);
313
314	---------------------------- file1.xs -----------------------------------------
315
316	#define NEED_newCONSTSUB
317	#define NEED_sv_2pv_nolen
318	#include "ppport.h"
319
320	newCONSTSUB();
321	SvPV_nolen();
322
323	---------------------------- file2.xs -----------------------------------------
324
325	mXPUSHp(foo);
326
327	===============================================================================
328
329	my $o = ppport(qw(--nochanges));
330	ok($o =~ /^scanning.*FooBar\.xs/mi);
331	ok($o =~ /analyzing.*FooBar\.xs/mi);
332	ok(matches($o, '^scanning', 'mi'), 1);
333	ok($o !~ /^Looks good/m);
334	ok($o =~ /^Uses grok_bin/m);
335
336	---------------------------- FooBar.xs ----------------------------------------
337
338	newSViv();
339	XPUSHs(foo);
340	grok_bin();
341
342	===============================================================================
343
344	my $o = ppport(qw(--nochanges));
345	ok($o =~ /^scanning.*First\.xs/mi);
346	ok($o =~ /analyzing.*First\.xs/mi);
347	ok($o =~ /^scanning.*second\.h/mi);
348	ok($o =~ /analyzing.*second\.h/mi);
349	ok($o =~ /^scanning.sub.third\.c/mi);
350	ok($o =~ /analyzing.sub.third\.c/mi);
351	ok($o !~ /^scanning.*foobar/mi);
352	ok(matches($o, '^scanning', 'mi'), 3);
353
354	---------------------------- First.xs -----------------------------------------
355
356	one
357
358	---------------------------- foobar.xyz ---------------------------------------
359
360	two
361
362	---------------------------- second.h -----------------------------------------
363
364	three
365
366	---------------------------- sub/third.c --------------------------------------
367
368	four
369
370	===============================================================================
371
372	my $o = ppport(qw(--nochanges));
373	ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i);
374
375	---------------------------- test.xs ------------------------------------------
376
377	#define NEED_foobar
378
379	===============================================================================
380
381	# And now some complex "real-world" example
382
383	my $o = ppport(qw(--copy=f));
384	for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) {
385	ok($o =~ /^scanning.*\Q$_\E/mi);
386	ok($o =~ /analyzing.*\Q$_\E/i);
387	}
388	ok(matches($o, '^scanning', 'mi'), 6);
389
390	ok(matches($o, '^Writing copy of', 'mi'), 5);
391	ok(!-e "mod5.cf");
392
393	for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
394	ok($o =~ /^Writing copy of.\Q$_\E.with changes/mi);
395	ok(-e "${_}f");
396	ok(eq_files("${_}f", "${_}r"));
397	unlink "${_}f";
398	}
399
400	---------------------------- main.xs ------------------------------------------
401
402	#include "EXTERN.h"
403	#include "perl.h"
404	#include "XSUB.h"
405
406	#define NEED_newCONSTSUB
407	#define NEED_grok_hex_GLOBAL
408	#include "ppport.h"
409
410	newCONSTSUB();
411	grok_hex();
412	Perl_grok_bin(aTHX_ foo, bar);
413
414	/* some comment */
415
416	perl_eval_pv();
417	grok_bin();
418	Perl_grok_bin(bar, sv_no);
419
420	---------------------------- mod1.c -------------------------------------------
421
422	#include "EXTERN.h"
423	#include "perl.h"
424	#include "XSUB.h"
425
426	#define NEED_grok_bin_GLOBAL
427	#define NEED_newCONSTSUB
428	#include "ppport.h"
429
430	newCONSTSUB();
431	grok_bin();
432	{
433	Perl_croak ("foo");
434	Perl_sv_catpvf(); /* I know it's wrong ;-) */
435	}
436
437	---------------------------- mod2.c -------------------------------------------
438
439	#include "EXTERN.h"
440	#include "perl.h"
441	#include "XSUB.h"
442
443	#define NEED_eval_pv
444	#include "ppport.h"
445
446	newSViv();
447
448	/*
449	eval_pv();
450	*/
451
452	---------------------------- mod3.c -------------------------------------------
453
454	#include "EXTERN.h"
455	#include "perl.h"
456	#include "XSUB.h"
457
458	grok_oct();
459	eval_pv();
460
461	---------------------------- mod4.c -------------------------------------------
462
463	#include "EXTERN.h"
464	#include "perl.h"
465	#include "XSUB.h"
466
467	START_MY_CXT;
468
469	---------------------------- mod5.c -------------------------------------------
470
471	#include "EXTERN.h"
472	#include "perl.h"
473	#include "XSUB.h"
474
475	#include "ppport.h"
476	call_pv();
477
478	---------------------------- main.xsr -----------------------------------------
479
480	#include "EXTERN.h"
481	#include "perl.h"
482	#include "XSUB.h"
483
484	#define NEED_eval_pv_GLOBAL
485	#define NEED_grok_hex
486	#define NEED_newCONSTSUB_GLOBAL
487	#include "ppport.h"
488
489	newCONSTSUB();
490	grok_hex();
491	grok_bin(foo, bar);
492
493	/* some comment */
494
495	eval_pv();
496	grok_bin();
497	grok_bin(bar, PL_sv_no);
498
499	---------------------------- mod1.cr ------------------------------------------
500
501	#include "EXTERN.h"
502	#include "perl.h"
503	#include "XSUB.h"
504
505	#define NEED_grok_bin_GLOBAL
506	#include "ppport.h"
507
508	newCONSTSUB();
509	grok_bin();
510	{
511	Perl_croak (aTHX_ "foo");
512	Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */
513	}
514
515	---------------------------- mod2.cr ------------------------------------------
516
517	#include "EXTERN.h"
518	#include "perl.h"
519	#include "XSUB.h"
520
521
522	newSViv();
523
524	/*
525	eval_pv();
526	*/
527
528	---------------------------- mod3.cr ------------------------------------------
529
530	#include "EXTERN.h"
531	#include "perl.h"
532	#include "XSUB.h"
533	#define NEED_grok_oct
534	#include "ppport.h"
535
536	grok_oct();
537	eval_pv();
538
539	---------------------------- mod4.cr ------------------------------------------
540
541	#include "EXTERN.h"
542	#include "perl.h"
543	#include "XSUB.h"
544	#include "ppport.h"
545
546	START_MY_CXT;
547
548	===============================================================================
549
550	my $o = ppport(qw(--nochanges));
551	ok($o =~ /Uses grok_hex/m);
552	ok($o !~ /Looks good/m);
553
554	$o = ppport(qw(--nochanges --compat-version=5.8.0));
555	ok($o !~ /Uses grok_hex/m);
556	ok($o =~ /Looks good/m);
557
558	---------------------------- FooBar.xs ----------------------------------------
559
560	grok_hex();
561
562	===============================================================================
563
564	my $o = ppport(qw(--nochanges));
565	ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
566
567	$o = ppport(qw(--nochanges --compat-version=5.6.0));
568	ok($o !~ /Uses SvPVutf8_force/m);
569
570	---------------------------- FooBar.xs ----------------------------------------
571
572	SvPVutf8_force();
573
96ad942f MHM	574	===============================================================================
	575
	576	my $o = ppport(qw(--nochanges));
	577	ok($o !~ /potentially required change/);
	578	ok(matches($o, '^Looks good', 'mi'), 2);
	579
	580	---------------------------- FooBar.xs ----------------------------------------
	581
	582	#define NEED_grok_numeric_radix
	583	#define NEED_grok_number
	584	#include "ppport.h"
	585
	586	GROK_NUMERIC_RADIX();
	587	grok_number();
	588
	589	---------------------------- foo.c --------------------------------------------
	590
	591	#include "ppport.h"
	592
	593	call_pv();
	594