[p5sagit/p5-mst-13.2.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..197\n";
  }
  else {
    plan(tests => 197);
  }
}

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

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

my $tmp = 'ppptmp';
my $inc = '';
my $perl = find_perl();
my $isVMS = $^O eq 'VMS';
my $isMAC = $^O eq 'MacOS';

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') {
    if ($isVMS) {
      $inc = '"-I../../lib"';
    }
    elsif ($isMAC) {
      $inc = '-I:::lib';
    }
    else {
      $inc = '-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 comment
{
  my $c = shift;
  $c =~ s/^/# | /mg;
  $c .= "\n" unless $c =~ /[\r\n]$/;
  print $c;
}

sub ppport
{
  my @args = ('ppport.h', @_);
  unshift @args, $inc if $inc;
  my $run = $perl =~ m/\s/ ? qq("$perl") : $perl;
  $run .= ' -MMac::err=unix' if $isMAC;
  for (@args) {
    $_ = qq("$_") if $isVMS && /^[^"]/;
    $run .= " $_";
  }
  print "# *** running $run ***\n";
  $run .= ' 2>&1' unless $isMAC;
  my @out = `$run`;
  my $out = join '', @out;
  comment($out);
  return wantarray ? @out : $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;
    comment($_);
  }
  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 $isVMS;

  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', 'm'), 1);
ok(matches($o, 'Analyzing', 'm'), 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', 'm'), 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', 'm'), 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', 'm'), 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', 'm'), 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', 'm'), 6);

ok(matches($o, '^Writing copy of', 'm'), 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.5.3));
ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);

$o = ppport(qw(--nochanges --compat-version=5.005_03));
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);

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

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

$o = ppport(qw(--nochanges --compat-version=6.0.0));
ok($o =~ /Only Perl 5 is supported/m);

$o = ppport(qw(--nochanges --compat-version=5.1000.999));
ok($o =~ /Invalid version number: 5.1000.999/m);

$o = ppport(qw(--nochanges --compat-version=5.999.1000));
ok($o =~ /Invalid version number: 5.999.1000/m);

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

SvPVutf8_force();

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

my $o = ppport(qw(--nochanges));
ok($o !~ /potentially required change/);
ok(matches($o, '^Looks good', 'm'), 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();

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

# check --api-info option

my $o = ppport(qw(--api-info=INT2PTR));
my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
ok(scalar keys %found, 1);
ok(exists $found{INT2PTR});
ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1);
ok(matches($o, '^Support by .*ppport.* provided back to perl-5\.003\.', 'm'), 1);

$o = ppport(qw(--api-info=Zero));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
ok(scalar keys %found, 1);
ok(exists $found{Zero});
ok(matches($o, '^No portability information available\.', 'm'), 1);

$o = ppport(qw(--api-info=/Zero/));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
ok(scalar keys %found, 2);
ok(exists $found{Zero});
ok(exists $found{ZeroD});

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

# check --list-provided option

my @o = ppport(qw(--list-provided));
my %p;
my $fail = 0;
for (@o) {
  my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++;
  exists $p{$name} and $fail++;
  $p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : '';
}
ok(@o > 100);
ok($fail, 0);

ok(exists $p{call_sv});
ok(not ref $p{call_sv});

ok(exists $p{grok_bin});
ok(ref $p{grok_bin}, 'HASH');
ok(scalar keys %{$p{grok_bin}}, 1);
ok($p{grok_bin}{explicit});

ok(exists $p{gv_stashpvn});
ok(ref $p{gv_stashpvn}, 'HASH');
ok(scalar keys %{$p{gv_stashpvn}}, 1);
ok($p{gv_stashpvn}{hint});

ok(exists $p{sv_catpvf_mg});
ok(ref $p{sv_catpvf_mg}, 'HASH');
ok(scalar keys %{$p{sv_catpvf_mg}}, 2);
ok($p{sv_catpvf_mg}{explicit});
ok($p{sv_catpvf_mg}{depend});

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

# check --list-unsupported option

my @o = ppport(qw(--list-unsupported));
my %p;
my $fail = 0;
for (@o) {
  my($name, $ver) = /^(\w+)\s*\.+\s*([\d._]+)$/ or $fail++;
  exists $p{$name} and $fail++;
  $p{$name} = $ver;
}
ok(@o > 100);
ok($fail, 0);

ok(exists $p{utf8_distance});
ok($p{utf8_distance}, '5.6.0');

ok(exists $p{save_generic_svref});
ok($p{save_generic_svref}, '5.005_03');

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

# check --nofilter option

my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
ok(matches($o, '^Scanning', 'm'), 1);
ok(matches($o, 'Analyzing', 'm'), 1);

$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL));
ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m);
ok(matches($o, '^\|\s+foo\.o', 'mi'), 1);
ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
ok(matches($o, '^Scanning', 'm'), 1);
ok(matches($o, 'Analyzing', 'm'), 1);

$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
ok($o =~ /^Scanning.*foo\.o/mi);
ok($o =~ /Analyzing.*foo\.o/mi);
ok($o =~ /^Scanning.*Makefile/mi);
ok($o =~ /Analyzing.*Makefile/mi);
ok(matches($o, '^Scanning', 'm'), 3);
ok(matches($o, 'Analyzing', 'm'), 3);

---------------------------- foo.cpp ------------------------------------------

newSViv();

---------------------------- foo.o --------------------------------------------

newSViv();

---------------------------- Makefile.PL --------------------------------------

newSViv();
Commit	Line	Data
adfe19db	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	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';
4a582685	27	print "1..197\n";
adfe19db	28	}
adfe19db	29	else {
4a582685	30	plan(tests => 197);
adfe19db	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	40
adfe19db	41	my $tmp = 'ppptmp';
96ad942f	42	my $inc = '';
96ad942f	43	my $perl = find_perl();
4a582685	44	my $isVMS = $^O eq 'VMS';
4a582685	45	my $isMAC = $^O eq 'MacOS';
adfe19db	46
	47	rmtree($tmp) if -d $tmp;
	48	mkpath($tmp) or die "mkpath $tmp: $!\n";
	49	chdir($tmp) or die "chdir $tmp: $!\n";
	50
adfe19db	51	if ($ENV{'PERL_CORE'}) {
87499469	52	if (-d '../../lib') {
4a582685	53	if ($isVMS) {
	54	$inc = '"-I../../lib"';
	55	}
	56	elsif ($isMAC) {
	57	$inc = '-I:::lib';
	58	}
	59	else {
	60	$inc = '-I../../lib';
	61	}
87499469	62	unshift @INC, '../../lib';
87499469	63	}
adfe19db	64	}
96ad942f	65	if ($perl =~ m!^\./!) {
	66	$perl = ".$perl";
	67	}
adfe19db	68
adfe19db	69	END {
cd266515	70	chdir('..') if !-d $tmp && -d "../$tmp";
cd266515	71	rmtree($tmp) if -d $tmp;
adfe19db	72	}
	73
	74	ok(&Devel::PPPort::WriteFile("ppport.h"));
	75
4a582685	76	sub comment
	77	{
	78	my $c = shift;
	79	$c =~ s/^/# \| /mg;
	80	$c .= "\n" unless $c =~ /[\r\n]$/;
	81	print $c;
	82	}
	83
adfe19db	84	sub ppport
adfe19db	85	{
4a582685	86	my @args = ('ppport.h', @_);
	87	unshift @args, $inc if $inc;
	88	my $run = $perl =~ m/\s/ ? qq("$perl") : $perl;
	89	$run .= ' -MMac::err=unix' if $isMAC;
	90	for (@args) {
	91	$_ = qq("$_") if $isVMS && /^[^"]/;
	92	$run .= " $_";
	93	}
	94	print "# * running $run *\n";
	95	$run .= ' 2>&1' unless $isMAC;
	96	my @out = `$run`;
	97	my $out = join '', @out;
	98	comment($out);
	99	return wantarray ? @out : $out;
adfe19db	100	}
	101
	102	sub matches
	103	{
	104	my($str, $re, $mod) = @_;
	105	my @n;
	106	eval "\@n = \$str =~ /$re/g$mod;";
	107	if ($@) {
	108	my $err = $@;
	109	$err =~ s/^/# *** /mg;
	110	print "# * ERROR *\n$err\n";
	111	}
	112	return $@ ? -42 : scalar @n;
	113	}
	114
	115	sub eq_files
	116	{
	117	my($f1, $f2) = @_;
	118	return 0 unless -e $f1 && -e $f2;
	119	local *F;
	120	for ($f1, $f2) {
	121	print "# File: $_\n";
	122	unless (open F, $_) {
	123	print "# couldn't open $_: $!\n";
	124	return 0;
	125	}
	126	$_ = do { local $/; <F> };
	127	close F;
4a582685	128	comment($_);
adfe19db	129	}
	130	return $f1 eq $f2;
	131	}
	132
	133	my @tests;
	134
	135	for (split /\s={70,}\s/, do { local $/; <DATA> }) {
	136	s/^\s+//; s/\s+$//;
	137	my($c, %f);
	138	($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s-{20,}\s+\S+\s+-{20,}\s/;
	139	push @tests, { code => $c, files => \%f };
	140	}
	141
	142	my $t;
	143	for $t (@tests) {
	144	my $f;
	145	for $f (keys %{$t->{files}}) {
	146	my @f = split /\//, $f;
	147	if (@f > 1) {
	148	pop @f;
	149	my $path = join '/', @f;
	150	mkpath($path) or die "mkpath('$path'): $!\n";
	151	}
	152	my $txt = $t->{files}{$f};
	153	local *F;
	154	open F, ">$f" or die "open $f: $!\n";
	155	print F "$txt\n";
	156	close F;
	157	$txt =~ s/^/# \| /mg;
	158	print "# * writing $f *\n$txt\n";
	159	}
	160
	161	eval $t->{code};
	162	if ($@) {
	163	my $err = $@;
	164	$err =~ s/^/# *** /mg;
	165	print "# * ERROR *\n$err\n";
	166	}
	167	ok($@, '');
	168
	169	for (keys %{$t->{files}}) {
	170	unlink $_ or die "unlink('$_'): $!\n";
	171	}
	172	}
	173
96ad942f	174	sub find_perl
	175	{
	176	my $perl = $^X;
4a582685	177
	178	return $perl if $isVMS;
	179
96ad942f	180	my $exe = $Config{'_exe'} \|\| '';
4a582685	181
96ad942f	182	if ($perl =~ /^perl\Q$exe\E$/i) {
	183	$perl = "perl$exe";
	184	eval "require File::Spec";
	185	if ($@) {
	186	$perl = "./$perl";
	187	} else {
	188	$perl = File::Spec->catfile(File::Spec->curdir(), $perl);
	189	}
	190	}
4a582685	191
96ad942f	192	if ($perl !~ /\Q$exe\E$/i) {
	193	$perl .= $exe;
	194	}
4a582685	195
96ad942f	196	warn "find_perl: cannot find $perl from $^X" unless -f $perl;
4a582685	197
96ad942f	198	return $perl;
	199	}
	200
adfe19db	201	__DATA__
	202
	203	my $o = ppport(qw(--help));
	204	ok($o =~ /^Usage:.*ppport\.h/m);
	205	ok($o =~ /--help/m);
	206
	207	$o = ppport(qw(--nochanges));
4a582685	208	ok($o =~ /^Scanning.*test\.xs/mi);
	209	ok($o =~ /Analyzing.*test\.xs/mi);
	210	ok(matches($o, '^Scanning', 'm'), 1);
	211	ok(matches($o, 'Analyzing', 'm'), 1);
adfe19db	212	ok($o =~ /Uses Perl_newSViv instead of newSViv/);
	213
	214	$o = ppport(qw(--quiet --nochanges));
	215	ok($o =~ /^\s*$/);
	216
	217	---------------------------- test.xs ------------------------------------------
	218
	219	Perl_newSViv();
	220
	221	===============================================================================
	222
	223	# check if C and C++ comments are filtered correctly
	224
	225	my $o = ppport(qw(--copy=a));
4a582685	226	ok($o =~ /^Scanning.*MyExt\.xs/mi);
	227	ok($o =~ /Analyzing.*MyExt\.xs/mi);
	228	ok(matches($o, '^Scanning', 'm'), 1);
adfe19db	229	ok($o =~ /^Needs to include.*ppport\.h/m);
	230	ok($o !~ /^Uses grok_bin/m);
	231	ok($o !~ /^Uses newSVpv/m);
	232	ok($o =~ /Uses 1 C\+\+ style comment/m);
	233	ok(eq_files('MyExt.xsa', 'MyExt.ra'));
	234
	235	# check if C++ are left untouched with --cplusplus
	236
	237	$o = ppport(qw(--copy=b --cplusplus));
4a582685	238	ok($o =~ /^Scanning.*MyExt\.xs/mi);
	239	ok($o =~ /Analyzing.*MyExt\.xs/mi);
	240	ok(matches($o, '^Scanning', 'm'), 1);
adfe19db	241	ok($o =~ /^Needs to include.*ppport\.h/m);
	242	ok($o !~ /^Uses grok_bin/m);
	243	ok($o !~ /^Uses newSVpv/m);
	244	ok($o !~ /Uses \d+ C\+\+ style comment/m);
	245	ok(eq_files('MyExt.xsb', 'MyExt.rb'));
	246
	247	unlink qw(MyExt.xsa MyExt.xsb);
	248
	249	---------------------------- MyExt.xs -----------------------------------------
4a582685	250
adfe19db	251	newSVuv();
	252	// newSVpv();
	253	XPUSHs(foo);
	254	/* grok_bin(); */
	255
	256	---------------------------- MyExt.ra -----------------------------------------
4a582685	257
adfe19db	258	#include "ppport.h"
	259	newSVuv();
	260	/* newSVpv(); */
	261	XPUSHs(foo);
	262	/* grok_bin(); */
	263
	264	---------------------------- MyExt.rb -----------------------------------------
4a582685	265
adfe19db	266	#include "ppport.h"
	267	newSVuv();
	268	// newSVpv();
	269	XPUSHs(foo);
	270	/* grok_bin(); */
	271
	272	===============================================================================
	273
	274	my $o = ppport(qw(--nochanges file1.xs));
4a582685	275	ok($o =~ /^Scanning.*file1\.xs/mi);
	276	ok($o =~ /Analyzing.*file1\.xs/mi);
	277	ok($o !~ /^Scanning.*file2\.xs/mi);
adfe19db	278	ok($o =~ /^Uses newCONSTSUB/m);
	279	ok($o =~ /^Uses SvPV_nolen.depends.sv_2pv_nolen/m);
	280	ok($o =~ /hint for newCONSTSUB/m);
	281	ok($o !~ /hint for sv_2pv_nolen/m);
	282	ok($o =~ /^Looks good/m);
	283
	284	$o = ppport(qw(--nochanges --nohints file1.xs));
4a582685	285	ok($o =~ /^Scanning.*file1\.xs/mi);
	286	ok($o =~ /Analyzing.*file1\.xs/mi);
	287	ok($o !~ /^Scanning.*file2\.xs/mi);
adfe19db	288	ok($o =~ /^Uses newCONSTSUB/m);
	289	ok($o =~ /^Uses SvPV_nolen.depends.sv_2pv_nolen/m);
	290	ok($o !~ /hint for newCONSTSUB/m);
	291	ok($o !~ /hint for sv_2pv_nolen/m);
	292	ok($o =~ /^Looks good/m);
	293
	294	$o = ppport(qw(--nochanges --nohints --nodiag file1.xs));
4a582685	295	ok($o =~ /^Scanning.*file1\.xs/mi);
	296	ok($o =~ /Analyzing.*file1\.xs/mi);
	297	ok($o !~ /^Scanning.*file2\.xs/mi);
adfe19db	298	ok($o !~ /^Uses newCONSTSUB/m);
	299	ok($o !~ /^Uses SvPV_nolen/m);
	300	ok($o !~ /hint for newCONSTSUB/m);
	301	ok($o !~ /hint for sv_2pv_nolen/m);
	302	ok($o =~ /^Looks good/m);
	303
	304	$o = ppport(qw(--nochanges --quiet file1.xs));
	305	ok($o =~ /^\s*$/);
	306
	307	$o = ppport(qw(--nochanges file2.xs));
4a582685	308	ok($o =~ /^Scanning.*file2\.xs/mi);
	309	ok($o =~ /Analyzing.*file2\.xs/mi);
	310	ok($o !~ /^Scanning.*file1\.xs/mi);
adfe19db	311	ok($o =~ /^Uses mXPUSHp/m);
	312	ok($o =~ /^Needs to include.*ppport\.h/m);
	313	ok($o !~ /^Looks good/m);
	314	ok($o =~ /^1 potentially required change detected/m);
	315
	316	$o = ppport(qw(--nochanges --nohints file2.xs));
4a582685	317	ok($o =~ /^Scanning.*file2\.xs/mi);
	318	ok($o =~ /Analyzing.*file2\.xs/mi);
	319	ok($o !~ /^Scanning.*file1\.xs/mi);
adfe19db	320	ok($o =~ /^Uses mXPUSHp/m);
	321	ok($o =~ /^Needs to include.*ppport\.h/m);
	322	ok($o !~ /^Looks good/m);
	323	ok($o =~ /^1 potentially required change detected/m);
	324
	325	$o = ppport(qw(--nochanges --nohints --nodiag file2.xs));
4a582685	326	ok($o =~ /^Scanning.*file2\.xs/mi);
	327	ok($o =~ /Analyzing.*file2\.xs/mi);
	328	ok($o !~ /^Scanning.*file1\.xs/mi);
adfe19db	329	ok($o !~ /^Uses mXPUSHp/m);
	330	ok($o !~ /^Needs to include.*ppport\.h/m);
	331	ok($o !~ /^Looks good/m);
	332	ok($o =~ /^1 potentially required change detected/m);
	333
	334	$o = ppport(qw(--nochanges --quiet file2.xs));
	335	ok($o =~ /^\s*$/);
	336
	337	---------------------------- file1.xs -----------------------------------------
	338
	339	#define NEED_newCONSTSUB
	340	#define NEED_sv_2pv_nolen
	341	#include "ppport.h"
	342
	343	newCONSTSUB();
	344	SvPV_nolen();
	345
	346	---------------------------- file2.xs -----------------------------------------
	347
	348	mXPUSHp(foo);
	349
	350	===============================================================================
	351
	352	my $o = ppport(qw(--nochanges));
4a582685	353	ok($o =~ /^Scanning.*FooBar\.xs/mi);
	354	ok($o =~ /Analyzing.*FooBar\.xs/mi);
	355	ok(matches($o, '^Scanning', 'm'), 1);
adfe19db	356	ok($o !~ /^Looks good/m);
	357	ok($o =~ /^Uses grok_bin/m);
	358
	359	---------------------------- FooBar.xs ----------------------------------------
	360
	361	newSViv();
	362	XPUSHs(foo);
	363	grok_bin();
	364
	365	===============================================================================
	366
	367	my $o = ppport(qw(--nochanges));
4a582685	368	ok($o =~ /^Scanning.*First\.xs/mi);
	369	ok($o =~ /Analyzing.*First\.xs/mi);
	370	ok($o =~ /^Scanning.*second\.h/mi);
	371	ok($o =~ /Analyzing.*second\.h/mi);
	372	ok($o =~ /^Scanning.sub.third\.c/mi);
	373	ok($o =~ /Analyzing.sub.third\.c/mi);
	374	ok($o !~ /^Scanning.*foobar/mi);
	375	ok(matches($o, '^Scanning', 'm'), 3);
adfe19db	376
	377	---------------------------- First.xs -----------------------------------------
	378
	379	one
	380
	381	---------------------------- foobar.xyz ---------------------------------------
	382
	383	two
	384
	385	---------------------------- second.h -----------------------------------------
	386
	387	three
	388
	389	---------------------------- sub/third.c --------------------------------------
	390
	391	four
	392
	393	===============================================================================
	394
	395	my $o = ppport(qw(--nochanges));
	396	ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i);
	397
	398	---------------------------- test.xs ------------------------------------------
	399
	400	#define NEED_foobar
	401
	402	===============================================================================
	403
	404	# And now some complex "real-world" example
	405
	406	my $o = ppport(qw(--copy=f));
	407	for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) {
4a582685	408	ok($o =~ /^Scanning.*\Q$_\E/mi);
4a582685	409	ok($o =~ /Analyzing.*\Q$_\E/i);
adfe19db	410	}
4a582685	411	ok(matches($o, '^Scanning', 'm'), 6);
adfe19db	412
4a582685	413	ok(matches($o, '^Writing copy of', 'm'), 5);
adfe19db	414	ok(!-e "mod5.cf");
	415
	416	for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
	417	ok($o =~ /^Writing copy of.\Q$_\E.with changes/mi);
	418	ok(-e "${_}f");
	419	ok(eq_files("${_}f", "${_}r"));
	420	unlink "${_}f";
	421	}
	422
	423	---------------------------- main.xs ------------------------------------------
	424
	425	#include "EXTERN.h"
	426	#include "perl.h"
	427	#include "XSUB.h"
	428
	429	#define NEED_newCONSTSUB
	430	#define NEED_grok_hex_GLOBAL
	431	#include "ppport.h"
	432
	433	newCONSTSUB();
	434	grok_hex();
	435	Perl_grok_bin(aTHX_ foo, bar);
	436
	437	/* some comment */
	438
	439	perl_eval_pv();
	440	grok_bin();
	441	Perl_grok_bin(bar, sv_no);
	442
	443	---------------------------- mod1.c -------------------------------------------
	444
	445	#include "EXTERN.h"
	446	#include "perl.h"
	447	#include "XSUB.h"
	448
	449	#define NEED_grok_bin_GLOBAL
	450	#define NEED_newCONSTSUB
	451	#include "ppport.h"
	452
	453	newCONSTSUB();
	454	grok_bin();
	455	{
	456	Perl_croak ("foo");
	457	Perl_sv_catpvf(); /* I know it's wrong ;-) */
	458	}
	459
	460	---------------------------- mod2.c -------------------------------------------
	461
	462	#include "EXTERN.h"
	463	#include "perl.h"
	464	#include "XSUB.h"
	465
	466	#define NEED_eval_pv
	467	#include "ppport.h"
	468
	469	newSViv();
	470
	471	/*
	472	eval_pv();
	473	*/
	474
	475	---------------------------- mod3.c -------------------------------------------
	476
	477	#include "EXTERN.h"
478	#include "perl.h"
479	#include "XSUB.h"
480
481	grok_oct();
482	eval_pv();
483
484	---------------------------- mod4.c -------------------------------------------
485
486	#include "EXTERN.h"
487	#include "perl.h"
488	#include "XSUB.h"
489
490	START_MY_CXT;
491
492	---------------------------- mod5.c -------------------------------------------
493
494	#include "EXTERN.h"
495	#include "perl.h"
496	#include "XSUB.h"
497
498	#include "ppport.h"
499	call_pv();
500
501	---------------------------- main.xsr -----------------------------------------
502
503	#include "EXTERN.h"
504	#include "perl.h"
505	#include "XSUB.h"
506
507	#define NEED_eval_pv_GLOBAL
508	#define NEED_grok_hex
509	#define NEED_newCONSTSUB_GLOBAL
510	#include "ppport.h"
511
512	newCONSTSUB();
513	grok_hex();
514	grok_bin(foo, bar);
515
516	/* some comment */
517
518	eval_pv();
519	grok_bin();
520	grok_bin(bar, PL_sv_no);
521
522	---------------------------- mod1.cr ------------------------------------------
523
524	#include "EXTERN.h"
525	#include "perl.h"
526	#include "XSUB.h"
527
528	#define NEED_grok_bin_GLOBAL
529	#include "ppport.h"
530
531	newCONSTSUB();
532	grok_bin();
533	{
534	Perl_croak (aTHX_ "foo");
535	Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */
536	}
537
538	---------------------------- mod2.cr ------------------------------------------
539
540	#include "EXTERN.h"
541	#include "perl.h"
542	#include "XSUB.h"
543
544
545	newSViv();
546
547	/*
548	eval_pv();
549	*/
550
551	---------------------------- mod3.cr ------------------------------------------
552
553	#include "EXTERN.h"
554	#include "perl.h"
555	#include "XSUB.h"
556	#define NEED_grok_oct
557	#include "ppport.h"
558
559	grok_oct();
560	eval_pv();
561
562	---------------------------- mod4.cr ------------------------------------------
563
564	#include "EXTERN.h"
565	#include "perl.h"
566	#include "XSUB.h"
567	#include "ppport.h"
568
569	START_MY_CXT;
570
571	===============================================================================
572
573	my $o = ppport(qw(--nochanges));
574	ok($o =~ /Uses grok_hex/m);
575	ok($o !~ /Looks good/m);
576
577	$o = ppport(qw(--nochanges --compat-version=5.8.0));
578	ok($o !~ /Uses grok_hex/m);
579	ok($o =~ /Looks good/m);
580
581	---------------------------- FooBar.xs ----------------------------------------
582
583	grok_hex();
584
585	===============================================================================
586
587	my $o = ppport(qw(--nochanges));
588	ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
589
4a582685	590	$o = ppport(qw(--nochanges --compat-version=5.5.3));
	591	ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
	592
	593	$o = ppport(qw(--nochanges --compat-version=5.005_03));
	594	ok($o =~ /Uses SvPVutf8_force, which may not be portable/m);
	595
adfe19db	596	$o = ppport(qw(--nochanges --compat-version=5.6.0));
	597	ok($o !~ /Uses SvPVutf8_force/m);
	598
4a582685	599	$o = ppport(qw(--nochanges --compat-version=5.006));
	600	ok($o !~ /Uses SvPVutf8_force/m);
	601
	602	$o = ppport(qw(--nochanges --compat-version=5.999.999));
	603	ok($o !~ /Uses SvPVutf8_force/m);
	604
	605	$o = ppport(qw(--nochanges --compat-version=6.0.0));
	606	ok($o =~ /Only Perl 5 is supported/m);
	607
	608	$o = ppport(qw(--nochanges --compat-version=5.1000.999));
	609	ok($o =~ /Invalid version number: 5.1000.999/m);
	610
	611	$o = ppport(qw(--nochanges --compat-version=5.999.1000));
	612	ok($o =~ /Invalid version number: 5.999.1000/m);
	613
adfe19db	614	---------------------------- FooBar.xs ----------------------------------------
	615
	616	SvPVutf8_force();
	617
96ad942f	618	===============================================================================
	619
	620	my $o = ppport(qw(--nochanges));
	621	ok($o !~ /potentially required change/);
4a582685	622	ok(matches($o, '^Looks good', 'm'), 2);
96ad942f	623
	624	---------------------------- FooBar.xs ----------------------------------------
	625
	626	#define NEED_grok_numeric_radix
	627	#define NEED_grok_number
	628	#include "ppport.h"
	629
	630	GROK_NUMERIC_RADIX();
	631	grok_number();
	632
	633	---------------------------- foo.c --------------------------------------------
	634
	635	#include "ppport.h"
	636
	637	call_pv();
	638
4a582685	639	===============================================================================
	640
	641	# check --api-info option
	642
	643	my $o = ppport(qw(--api-info=INT2PTR));
	644	my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
	645	ok(scalar keys %found, 1);
	646	ok(exists $found{INT2PTR});
	647	ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1);
	648	ok(matches($o, '^Support by .ppport. provided back to perl-5\.003\.', 'm'), 1);
	649
	650	$o = ppport(qw(--api-info=Zero));
	651	%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
	652	ok(scalar keys %found, 1);
	653	ok(exists $found{Zero});
	654	ok(matches($o, '^No portability information available\.', 'm'), 1);
	655
	656	$o = ppport(qw(--api-info=/Zero/));
	657	%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
	658	ok(scalar keys %found, 2);
	659	ok(exists $found{Zero});
	660	ok(exists $found{ZeroD});
	661
	662	===============================================================================
	663
	664	# check --list-provided option
	665
	666	my @o = ppport(qw(--list-provided));
	667	my %p;
	668	my $fail = 0;
	669	for (@o) {
	670	my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++;
	671	exists $p{$name} and $fail++;
	672	$p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : '';
	673	}
	674	ok(@o > 100);
	675	ok($fail, 0);
	676
	677	ok(exists $p{call_sv});
	678	ok(not ref $p{call_sv});
	679
	680	ok(exists $p{grok_bin});
	681	ok(ref $p{grok_bin}, 'HASH');
	682	ok(scalar keys %{$p{grok_bin}}, 1);
	683	ok($p{grok_bin}{explicit});
	684
	685	ok(exists $p{gv_stashpvn});
	686	ok(ref $p{gv_stashpvn}, 'HASH');
	687	ok(scalar keys %{$p{gv_stashpvn}}, 1);
	688	ok($p{gv_stashpvn}{hint});
	689
	690	ok(exists $p{sv_catpvf_mg});
	691	ok(ref $p{sv_catpvf_mg}, 'HASH');
	692	ok(scalar keys %{$p{sv_catpvf_mg}}, 2);
	693	ok($p{sv_catpvf_mg}{explicit});
	694	ok($p{sv_catpvf_mg}{depend});
	695
	696	===============================================================================
	697
	698	# check --list-unsupported option
	699
	700	my @o = ppport(qw(--list-unsupported));
	701	my %p;
	702	my $fail = 0;
703	for (@o) {
704	my($name, $ver) = /^(\w+)\s\.+\s([\d._]+)$/ or $fail++;
705	exists $p{$name} and $fail++;
706	$p{$name} = $ver;
707	}
708	ok(@o > 100);
709	ok($fail, 0);
710
711	ok(exists $p{utf8_distance});
712	ok($p{utf8_distance}, '5.6.0');
713
714	ok(exists $p{save_generic_svref});
715	ok($p{save_generic_svref}, '5.005_03');
716
717	===============================================================================
718
719	# check --nofilter option
720
721	my $o = ppport(qw(--nochanges));
722	ok($o =~ /^Scanning.*foo\.cpp/mi);
723	ok($o =~ /Analyzing.*foo\.cpp/mi);
724	ok(matches($o, '^Scanning', 'm'), 1);
725	ok(matches($o, 'Analyzing', 'm'), 1);
726
727	$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL));
728	ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m);
729	ok(matches($o, '^\\|\s+foo\.o', 'mi'), 1);
730	ok(matches($o, '^\\|\s+Makefile\.PL', 'mi'), 1);
731	ok($o =~ /^Scanning.*foo\.cpp/mi);
732	ok($o =~ /Analyzing.*foo\.cpp/mi);
733	ok(matches($o, '^Scanning', 'm'), 1);
734	ok(matches($o, 'Analyzing', 'm'), 1);
735
736	$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL));
737	ok($o =~ /^Scanning.*foo\.cpp/mi);
738	ok($o =~ /Analyzing.*foo\.cpp/mi);
739	ok($o =~ /^Scanning.*foo\.o/mi);
740	ok($o =~ /Analyzing.*foo\.o/mi);
741	ok($o =~ /^Scanning.*Makefile/mi);
742	ok($o =~ /Analyzing.*Makefile/mi);
743	ok(matches($o, '^Scanning', 'm'), 3);
744	ok(matches($o, 'Analyzing', 'm'), 3);
745
746	---------------------------- foo.cpp ------------------------------------------
747
748	newSViv();
749
750	---------------------------- foo.o --------------------------------------------
751
752	newSViv();
753
754	---------------------------- Makefile.PL --------------------------------------
755
756	newSViv();
757