dslinux/user/perl/ext/Devel/PPPort/t MY_CXT.t SvPV.t call.t cop.t exception.t grok.t limits.t mPUSH.t magic.t misc.t newCONSTSUB.t newRV.t ppphtest.t sv_xpvf.t testutil.pl threads.t uv.t
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:20 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/ext/Devel/PPPort/t
In directory antilope:/tmp/cvs-serv17422/ext/Devel/PPPort/t
Added Files:
MY_CXT.t SvPV.t call.t cop.t exception.t grok.t limits.t
mPUSH.t magic.t misc.t newCONSTSUB.t newRV.t ppphtest.t
sv_xpvf.t testutil.pl threads.t uv.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: MY_CXT.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/MY_CXT 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..3\n";
}
else {
plan(tests => 3);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
ok(&Devel::PPPort::MY_CXT_1());
ok(&Devel::PPPort::MY_CXT_2());
ok(&Devel::PPPort::MY_CXT_CLONE());
--- NEW FILE: grok.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/grok 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..10\n";
}
else {
plan(tests => 10);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
ok(&Devel::PPPort::grok_number("42"), 42);
ok(!defined(&Devel::PPPort::grok_number("A")));
ok(&Devel::PPPort::grok_bin("10000001"), 129);
ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
ok(&Devel::PPPort::grok_oct("377"), 255);
ok(&Devel::PPPort::Perl_grok_number("42"), 42);
ok(!defined(&Devel::PPPort::Perl_grok_number("A")));
ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
ok(&Devel::PPPort::Perl_grok_oct("377"), 255);
--- NEW FILE: sv_xpvf.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/sv_xpvf 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..9\n";
}
else {
plan(tests => 9);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
use Tie::Hash;
my %h;
tie %h, 'Tie::StdHash';
$h{foo} = 'foo-';
$h{bar} = '';
ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d');
ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d');
&Devel::PPPort::sv_catpvf_mg($h{foo});
ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-');
&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
&Devel::PPPort::sv_setpvf_mg($h{bar});
ok($h{bar}, $] >= 5.004 ? 'mhx-42' : '');
&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
ok($h{bar}, $] >= 5.004 ? 'foo-43' : '');
&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
ok($h{bar}, $] >= 5.004 ? 'bar-44' : '');
--- NEW FILE: 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();
--- NEW FILE: cop.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/cop 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..2\n";
}
else {
plan(tests => 2);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
my $package;
{
package MyPackage;
$package = &Devel::PPPort::CopSTASHPV();
}
print "# $package\n";
ok($package, "MyPackage");
my $file = &Devel::PPPort::CopFILE();
print "# $file\n";
ok($file =~ /cop/i);
--- NEW FILE: newRV.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/newRV 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..2\n";
}
else {
plan(tests => 2);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
ok(&Devel::PPPort::newRV_inc_REFCNT, 1);
ok(&Devel::PPPort::newRV_noinc_REFCNT, 1);
--- NEW FILE: call.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/call 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..44\n";
}
else {
plan(tests => 44);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
sub eq_array
{
my($a, $b) = @_;
join(':', @$a) eq join(':', @$b);
}
sub f
{
shift;
unshift @_, 'b';
pop @_;
@_, defined wantarray ? wantarray ? 'x' : 'y' : 'z';
}
my $obj = bless [], 'Foo';
sub Foo::meth
{
return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo';
shift;
shift;
unshift @_, 'b';
pop @_;
@_, defined wantarray ? wantarray ? 'x' : 'y' : 'z';
}
my $test;
for $test (
# flags args expected description
[ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ],
[ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ],
[ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ],
[ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ],
[ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ],
[ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ],
)
{
my ($flags, $args, $expected, $description) = @$test;
print "# --- $description ---\n";
ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected));
ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected));
ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected));
ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected));
ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected));
ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected));
ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected));
};
ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
--- NEW FILE: uv.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/uv 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..10\n";
}
else {
plan(tests => 10);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
ok(&Devel::PPPort::sv_setuv(42), 42);
ok(&Devel::PPPort::newSVuv(123), 123);
ok(&Devel::PPPort::sv_2uv("4711"), 4711);
ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
ok(&Devel::PPPort::XSRETURN_UV(), 42);
ok(&Devel::PPPort::PUSHu(), 42);
ok(&Devel::PPPort::XPUSHu(), 43);
--- NEW FILE: misc.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/misc 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..32\n";
}
else {
plan(tests => 32);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
use vars qw($my_sv @my_av %my_hv);
my @s = &Devel::PPPort::newSVpvn();
ok(@s == 5);
ok($s[0], "test");
ok($s[1], "te");
ok($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
ok(!defined(&Devel::PPPort::PL_sv_undef()));
ok(&Devel::PPPort::PL_sv_yes());
ok(!&Devel::PPPort::PL_sv_no());
ok(&Devel::PPPort::PL_na("abcd"), 4);
ok(&Devel::PPPort::boolSV(1));
ok(!&Devel::PPPort::boolSV(0));
$_ = "Fred";
ok(&Devel::PPPort::DEFSV(), "Fred");
ok(&Devel::PPPort::UNDERBAR(), "Fred");
eval { 1 };
ok(!&Devel::PPPort::ERRSV());
eval { cannot_call_this_one() };
ok(&Devel::PPPort::ERRSV());
ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0));
ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0));
ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1));
$my_sv = 1;
ok(&Devel::PPPort::get_sv('my_sv', 0));
ok(!&Devel::PPPort::get_sv('not_my_sv', 0));
ok(&Devel::PPPort::get_sv('not_my_sv', 1));
@my_av = (1);
ok(&Devel::PPPort::get_av('my_av', 0));
ok(!&Devel::PPPort::get_av('not_my_av', 0));
ok(&Devel::PPPort::get_av('not_my_av', 1));
%my_hv = (a=>1);
ok(&Devel::PPPort::get_hv('my_hv', 0));
ok(!&Devel::PPPort::get_hv('not_my_hv', 0));
ok(&Devel::PPPort::get_hv('not_my_hv', 1));
sub my_cv { 1 };
ok(&Devel::PPPort::get_cv('my_cv', 0));
ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
ok(&Devel::PPPort::get_cv('not_my_cv', 1));
ok(Devel::PPPort::dXSTARG(42), 43);
--- NEW FILE: testutil.pl ---
{
my $__ntest;
sub ok ($;$$) {
local($\,$,);
my $ok = 0;
my $result = shift;
if (@_ == 0) {
$ok = $result;
} else {
$expected = shift;
if (!defined $expected) {
$ok = !defined $result;
} elsif (!defined $result) {
$ok = 0;
} elsif (ref($expected) eq 'Regexp') {
$ok = $result =~ /$expected/;
} else {
$ok = $result eq $expected;
}
}
++$__ntest;
if ($ok) {
print "ok $__ntest\n"
}
else {
print "not ok $__ntest\n"
}
}
}
1;
--- NEW FILE: exception.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/exception 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..7\n";
}
else {
plan(tests => 7);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
my $rv;
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(0) };
ok($@, '');
ok(defined $rv);
ok($rv, 42);
ok($Devel::PPPort::exception_caught, 0);
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(1) };
ok($@, "boo\n");
ok(not defined $rv);
ok($Devel::PPPort::exception_caught, 1);
--- NEW FILE: magic.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/magic 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..10\n";
}
else {
plan(tests => 10);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
use Tie::Hash;
my %h;
tie %h, 'Tie::StdHash';
$h{foo} = 'foo';
$h{bar} = '';
&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
ok($h{foo}, 'foobar');
&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
ok($h{bar}, 'baz');
&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
ok($h{foo}, 'foobar42');
&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
ok($h{bar}, 42);
&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
ok(abs($h{PI} - 3.14159) < 0.01);
&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
ok($h{mhx}, 'mhx');
&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
ok($h{mhx}, 'Marcus');
&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
ok($h{sv}, 'SV');
&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
ok($h{sv}, 4711);
&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
ok($h{sv}, 'Perl');
--- NEW FILE: SvPV.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/SvPV 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..2\n";
}
else {
plan(tests => 2);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
ok(&Devel::PPPort::SvPVbyte("mhx"), 3);
ok(&Devel::PPPort::SvPV_nolen("mhx"), 42);
--- NEW FILE: limits.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/limits 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..4\n";
}
else {
plan(tests => 4);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
ok(&Devel::PPPort::iv_size());
ok(&Devel::PPPort::uv_size());
ok(&Devel::PPPort::iv_type());
ok(&Devel::PPPort::uv_type());
--- NEW FILE: threads.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/threads 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..2\n";
}
else {
plan(tests => 2);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
ok(&Devel::PPPort::no_THX_arg("42"), 43);
eval { &Devel::PPPort::with_THX_arg("yes\n"); };
ok($@ =~ /^yes/);
--- NEW FILE: mPUSH.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/mPUSH 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..8\n";
}
else {
plan(tests => 8);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
--- NEW FILE: newCONSTSUB.t ---
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or parts/inc/newCONSTSUB 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..3\n";
}
else {
plan(tests => 3);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
&Devel::PPPort::call_newCONSTSUB_1();
ok(&Devel::PPPort::test_value_1(), 1);
&Devel::PPPort::call_newCONSTSUB_2();
ok(&Devel::PPPort::test_value_2(), 2);
&Devel::PPPort::call_newCONSTSUB_3();
ok(&Devel::PPPort::test_value_3(), 3);
More information about the dslinux-commit
mailing list