[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / parts / inc / ppphtest

################################################################################
##
##  $Revision: 26 $
##  $Author: mhx $
##  $Date: 2005/06/24 19:03:21 +0200 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
##  Version 2.x, Copyright (C) 2001, Paul Marquess.
##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
##
##  This program is free software; you can redistribute it and/or
##  modify it under the same terms as Perl itself.
##
################################################################################

=tests plan => 197

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