diff options
Diffstat (limited to 'dist/Devel-PPPort/t')
34 files changed, 3334 insertions, 0 deletions
diff --git a/dist/Devel-PPPort/t/HvNAME.t b/dist/Devel-PPPort/t/HvNAME.t new file mode 100644 index 0000000000..f54fac2c89 --- /dev/null +++ b/dist/Devel-PPPort/t/HvNAME.t @@ -0,0 +1,56 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/HvNAME instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (4) { + load(); + plan(tests => 4); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort'); +ok(Devel::PPPort::HvNAME_get({}), undef); + +ok(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort')); +ok(Devel::PPPort::HvNAMELEN_get({}), 0); + diff --git a/dist/Devel-PPPort/t/MY_CXT.t b/dist/Devel-PPPort/t/MY_CXT.t new file mode 100644 index 0000000000..a94bd386c4 --- /dev/null +++ b/dist/Devel-PPPort/t/MY_CXT.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/MY_CXT instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (3) { + load(); + plan(tests => 3); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::MY_CXT_1()); +ok(&Devel::PPPort::MY_CXT_2()); +ok(&Devel::PPPort::MY_CXT_CLONE()); + diff --git a/dist/Devel-PPPort/t/SvPV.t b/dist/Devel-PPPort/t/SvPV.t new file mode 100644 index 0000000000..392a0ccb0e --- /dev/null +++ b/dist/Devel-PPPort/t/SvPV.t @@ -0,0 +1,120 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/SvPV instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (49) { + load(); + plan(tests => 49); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $mhx = "mhx"; + +ok(&Devel::PPPort::SvPVbyte($mhx), 3); + +my $i = 42; + +ok(&Devel::PPPort::SvPV_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++); + +ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_force($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0); + +my $str = ""; +&Devel::PPPort::SvPV_force($str); +my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80); +ok($str, "x"x80); +ok($s2, "x"x80); +ok($before < 81); +ok($after, 81); + +$str = "x"x400; +&Devel::PPPort::SvPV_force($str); +($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40); +ok($str, "x"x40); +ok($s2, "x"x40); +ok($before > 41); +ok($after, 41); + diff --git a/dist/Devel-PPPort/t/SvREFCNT.t b/dist/Devel-PPPort/t/SvREFCNT.t new file mode 100644 index 0000000000..0b46a51793 --- /dev/null +++ b/dist/Devel-PPPort/t/SvREFCNT.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/SvREFCNT instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (14) { + load(); + plan(tests => 14); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +for (Devel::PPPort::SvREFCNT()) { + ok(defined $_ and $_); +} + diff --git a/dist/Devel-PPPort/t/Sv_set.t b/dist/Devel-PPPort/t/Sv_set.t new file mode 100644 index 0000000000..77a7a860db --- /dev/null +++ b/dist/Devel-PPPort/t/Sv_set.t @@ -0,0 +1,71 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/Sv_set instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (5) { + load(); + plan(tests => 5); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $foo = 5; +ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); +ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); +ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); + +my $bar = []; + +bless $bar, 'foo'; +ok($bar->x(), 'foobar'); + +Devel::PPPort::TestSvSTASH_set($bar, 'bar'); +ok($bar->x(), 'hacker'); + +package foo; + +sub x { 'foobar' } + +package bar; + +sub x { 'hacker' } + diff --git a/dist/Devel-PPPort/t/call.t b/dist/Devel-PPPort/t/call.t new file mode 100644 index 0000000000..4d3e80e4c8 --- /dev/null +++ b/dist/Devel-PPPort/t/call.t @@ -0,0 +1,107 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/call instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (52) { + load(); + plan(tests => 52); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +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(eq_array( [ &Devel::PPPort::call_sv_G_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'); + +ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet"); +Devel::PPPort::load_module(0, "less", undef); +ok(defined $::{'less::'}, 1, "Have now loaded less"); + diff --git a/dist/Devel-PPPort/t/cop.t b/dist/Devel-PPPort/t/cop.t new file mode 100644 index 0000000000..1677dee79a --- /dev/null +++ b/dist/Devel-PPPort/t/cop.t @@ -0,0 +1,110 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/cop instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (28) { + load(); + plan(tests => 28); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +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); + +BEGIN { + if ($] < 5.006000) { + # Skip + for (1..28) { + ok(1, 1); + } + exit; + } +} + +BEGIN { + package DB; + no strict "refs"; + local $^P = 1; + sub sub { &$DB::sub } +} + +{ package One; sub one { Devel::PPPort::caller_cx($_[0]) } } +{ + package Two; + sub two { One::one(@_) } + sub dbtwo { + BEGIN { $^P = 1 } + One::one(@_); + BEGIN { $^P = 0 } + } +} + +for ( + # This is rather confusing. The package is the package the call is + # made *from*, the sub name is the sub the call is made *to*. When + # DB::sub is involved the first call is to DB::sub from the calling + # package, the second is to the real sub from package DB. + [\&One::one, 0, qw/main one main one/], + [\&One::one, 2, ], + [\&Two::two, 0, qw/Two one Two one/], + [\&Two::two, 1, qw/main two main two/], + [\&Two::dbtwo, 0, qw/Two sub DB one/], + [\&Two::dbtwo, 1, qw/main dbtwo main dbtwo/], +) { + my ($sub, $arg, @want) = @$_; + my @got = $sub->($arg); + ok(@got, @want); + for (0..$#want) { + ok($got[$_], $want[$_]); + } +} + diff --git a/dist/Devel-PPPort/t/exception.t b/dist/Devel-PPPort/t/exception.t new file mode 100644 index 0000000000..c432df6e69 --- /dev/null +++ b/dist/Devel-PPPort/t/exception.t @@ -0,0 +1,67 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/exception instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (7) { + load(); + plan(tests => 7); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +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); + diff --git a/dist/Devel-PPPort/t/format.t b/dist/Devel-PPPort/t/format.t new file mode 100644 index 0000000000..a25ede533f --- /dev/null +++ b/dist/Devel-PPPort/t/format.t @@ -0,0 +1,55 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/format instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $num = 1.12345678901234567890; + +eval { Devel::PPPort::croak_NVgf($num) }; +ok($@ =~ /^1.1234567890/); + diff --git a/dist/Devel-PPPort/t/grok.t b/dist/Devel-PPPort/t/grok.t new file mode 100644 index 0000000000..b807ce8ccd --- /dev/null +++ b/dist/Devel-PPPort/t/grok.t @@ -0,0 +1,62 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/grok instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +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); + diff --git a/dist/Devel-PPPort/t/gv.t b/dist/Devel-PPPort/t/gv.t new file mode 100644 index 0000000000..06dfed1b54 --- /dev/null +++ b/dist/Devel-PPPort/t/gv.t @@ -0,0 +1,63 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/gv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (7) { + load(); + plan(tests => 7); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::GvSVn(), 1); + +ok(Devel::PPPort::isGV_with_GP(), 2); + +ok(Devel::PPPort::get_cvn_flags(), 3); + +ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION); + +ok(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION); + +ok(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check"); +ok($::{sanity_check}); + diff --git a/dist/Devel-PPPort/t/limits.t b/dist/Devel-PPPort/t/limits.t new file mode 100644 index 0000000000..ed1cb2e3ac --- /dev/null +++ b/dist/Devel-PPPort/t/limits.t @@ -0,0 +1,55 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/limits instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (4) { + load(); + plan(tests => 4); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::iv_size()); +ok(&Devel::PPPort::uv_size()); +ok(&Devel::PPPort::iv_type()); +ok(&Devel::PPPort::uv_type()); + diff --git a/dist/Devel-PPPort/t/mPUSH.t b/dist/Devel-PPPort/t/mPUSH.t new file mode 100644 index 0000000000..2f38276828 --- /dev/null +++ b/dist/Devel-PPPort/t/mPUSH.t @@ -0,0 +1,62 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/mPUSH instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42"); +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::mXPUSHs()), "foo:bar:42"); +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"); + diff --git a/dist/Devel-PPPort/t/magic.t b/dist/Devel-PPPort/t/magic.t new file mode 100644 index 0000000000..f467613f27 --- /dev/null +++ b/dist/Devel-PPPort/t/magic.t @@ -0,0 +1,120 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/magic instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (23) { + load(); + plan(tests => 23); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +# Find proper magic +ok(my $obj1 = Devel::PPPort->new_with_mg()); +ok(Devel::PPPort::as_string($obj1), 'hello'); + +# Find with no magic +my $obj = bless {}, 'Fake::Class'; +ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); + +# Find with other magic (not the magic we are looking for) +ok($obj = Devel::PPPort->new_with_other_mg()); +ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); + +# Okay, attempt to remove magic that isn't there +Devel::PPPort::remove_other_magic($obj1); +ok(Devel::PPPort::as_string($obj1), 'hello'); + +# Remove magic that IS there +Devel::PPPort::remove_null_magic($obj1); +ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); + +# Removing when no magic present +Devel::PPPort::remove_null_magic($obj1); +ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); + +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'); + +# v1 is treated as a bareword in older perls... +my $ver = do { local $SIG{'__WARN__'} = sub {}; eval qq[v1.2.0] }; +ok($] < 5.009 || $@ eq ''); +ok($] < 5.009 || Devel::PPPort::SvVSTRING_mg($ver)); +ok(!Devel::PPPort::SvVSTRING_mg(4711)); + +my $foo = 'bar'; +ok(Devel::PPPort::sv_magic_portable($foo)); +ok($foo eq 'bar'); + diff --git a/dist/Devel-PPPort/t/memory.t b/dist/Devel-PPPort/t/memory.t new file mode 100644 index 0000000000..74ecb991bc --- /dev/null +++ b/dist/Devel-PPPort/t/memory.t @@ -0,0 +1,52 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/memory instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::checkmem(), 6); + diff --git a/dist/Devel-PPPort/t/misc.t b/dist/Devel-PPPort/t/misc.t new file mode 100644 index 0000000000..0c4f027380 --- /dev/null +++ b/dist/Devel-PPPort/t/misc.t @@ -0,0 +1,157 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/misc instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (48) { + load(); + plan(tests => 48); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +use vars qw($my_sv @my_av %my_hv); + +ok(&Devel::PPPort::boolSV(1)); +ok(!&Devel::PPPort::boolSV(0)); + +$_ = "Fred"; +ok(&Devel::PPPort::DEFSV(), "Fred"); +ok(&Devel::PPPort::UNDERBAR(), "Fred"); + +if ($] >= 5.009002 && $] < 5.023 && $] < 5.023004) { + eval q{ + no warnings "deprecated"; + no if $^V > v5.17.9, warnings => "experimental::lexical_topic"; + my $_ = "Tony"; + ok(&Devel::PPPort::DEFSV(), "Fred"); + ok(&Devel::PPPort::UNDERBAR(), "Tony"); + }; +} +else { + ok(1); + ok(1); +} + +my @r = &Devel::PPPort::DEFSV_modify(); + +ok(@r == 3); +ok($r[0], 'Fred'); +ok($r[1], 'DEFSV'); +ok($r[2], 'Fred'); + +ok(&Devel::PPPort::DEFSV(), "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); +ok(Devel::PPPort::dAXMARK(4711), 4710); + +ok(Devel::PPPort::prepush(), 42); + +ok(join(':', Devel::PPPort::xsreturn(0)), 'test1'); +ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); + +ok(Devel::PPPort::PERL_ABS(42), 42); +ok(Devel::PPPort::PERL_ABS(-13), 13); + +ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42'); +ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc'); + +ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo"); + +ok(&Devel::PPPort::ptrtests(), 63); + +ok(&Devel::PPPort::OpSIBLING_tests(), 0); + +if ($] >= 5.009000) { + eval q{ + ok(&Devel::PPPort::check_HeUTF8("hello"), "norm"); + ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8"); + }; +} else { + ok(1, 1); + ok(1, 1); +} + +@r = &Devel::PPPort::check_c_array(); +ok($r[0], 4); +ok($r[1], "13"); + +ok(!Devel::PPPort::SvRXOK("")); +ok(!Devel::PPPort::SvRXOK(bless [], "Regexp")); + +if ($] < 5.005) { + skip 'no qr// objects in this perl', 0; + skip 'no qr// objects in this perl', 0; +} else { + my $qr = eval 'qr/./'; + ok(Devel::PPPort::SvRXOK($qr)); + ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise")); +} + diff --git a/dist/Devel-PPPort/t/newCONSTSUB.t b/dist/Devel-PPPort/t/newCONSTSUB.t new file mode 100644 index 0000000000..cb207a4587 --- /dev/null +++ b/dist/Devel-PPPort/t/newCONSTSUB.t @@ -0,0 +1,59 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newCONSTSUB instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (3) { + load(); + plan(tests => 3); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +&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); + diff --git a/dist/Devel-PPPort/t/newRV.t b/dist/Devel-PPPort/t/newRV.t new file mode 100644 index 0000000000..731a62b1f6 --- /dev/null +++ b/dist/Devel-PPPort/t/newRV.t @@ -0,0 +1,53 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newRV instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::newRV_inc_REFCNT, 1); +ok(&Devel::PPPort::newRV_noinc_REFCNT, 1); + diff --git a/dist/Devel-PPPort/t/newSV_type.t b/dist/Devel-PPPort/t/newSV_type.t new file mode 100644 index 0000000000..1b3233e5ce --- /dev/null +++ b/dist/Devel-PPPort/t/newSV_type.t @@ -0,0 +1,52 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newSV_type instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::newSV_type(), 4); + diff --git a/dist/Devel-PPPort/t/newSVpv.t b/dist/Devel-PPPort/t/newSVpv.t new file mode 100644 index 0000000000..d14a53fbe8 --- /dev/null +++ b/dist/Devel-PPPort/t/newSVpv.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newSVpv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (15) { + load(); + plan(tests => 15); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +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])); + +@s = &Devel::PPPort::newSVpvn_flags(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_utf8(); +ok(@s == 1); +ok($s[0], "test"); + +if ($] >= 5.008001) { + require utf8; + ok(utf8::is_utf8($s[0])); +} +else { + skip("skip: no is_utf8()", 0); +} + diff --git a/dist/Devel-PPPort/t/podtest.t b/dist/Devel-PPPort/t/podtest.t new file mode 100644 index 0000000000..c1a35b20a0 --- /dev/null +++ b/dist/Devel-PPPort/t/podtest.t @@ -0,0 +1,83 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/podtest instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (0) { + load(); + plan(tests => 0); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate devel/buildperl.pl ); + +my $reason = ''; + +if ($ENV{'SKIP_SLOW_TESTS'}) { + $reason = 'SKIP_SLOW_TESTS'; +} +else { + # Try loading Test::Pod + eval q{ + use Test::Pod; + $Test::Pod::VERSION >= 0.95 + or die "Test::Pod version only $Test::Pod::VERSION"; + import Test::Pod tests => scalar @pods; + }; + $reason = 'Test::Pod >= 0.95 required' if $@; +} + +if ($reason) { + load(); + plan(tests => scalar @pods); +} + +for (@pods) { + print "# checking $_\n"; + if ($reason) { + skip("skip: $reason", 0); + } + else { + pod_file_ok($_); + } +} + diff --git a/dist/Devel-PPPort/t/ppphtest.t b/dist/Devel-PPPort/t/ppphtest.t new file mode 100644 index 0000000000..45840f9fc7 --- /dev/null +++ b/dist/Devel-PPPort/t/ppphtest.t @@ -0,0 +1,946 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/ppphtest instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (238) { + load(); + plan(tests => 238); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +BEGIN { + if ($ENV{'SKIP_SLOW_TESTS'}) { + for (1 .. 238) { + skip("skip: SKIP_SLOW_TESTS", 0); + } + exit 0; + } +} + +use File::Path qw/rmtree mkpath/; +use Config; + +my $tmp = 'ppptmp'; +my $inc = ''; +my $isVMS = $^O eq 'VMS'; +my $isMAC = $^O eq 'MacOS'; +my $perl = find_perl(); + +rmtree($tmp) if -d $tmp; +mkpath($tmp) or die "mkpath $tmp: $!\n"; +chdir($tmp) or die "chdir $tmp: $!\n"; + +if ($ENV{'PERL_CORE'}) { + if (-d '../../lib') { + 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")); + +# Check GetFileContents() +ok(-e "ppport.h", 1); + +my $data; + +open(F, "<ppport.h") or die "Failed to open ppport.h: $!"; +while(<F>) { + $data .= $_; +} +close(F); + +ok(Devel::PPPort::GetFileContents("ppport.h"), $data); +ok(Devel::PPPort::GetFileContents(), $data); + +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) { + print "#\n", ('# ', '-'x70, "\n")x3, "#\n"; + 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"; + } + + my $code = $t->{code}; + $code =~ s/^/# | /mg; + + print "# *** evaluating test code ***\n$code\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(--version)); +ok($o =~ /^This is.*ppport.*\d+\.\d+(?:_?\d+)?\.$/); + +$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 PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o =~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/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 PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/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 PL_expect/m); +ok($o !~ /^Uses SvPV_nolen/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/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_flags +#define NEED_PL_parser +#include "ppport.h" + +newCONSTSUB(); +SvPV_nolen(); +PL_expect = 0; + +---------------------------- 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_pv}); +ok(not ref $p{call_pv}); + +ok(exists $p{grok_bin}); +ok(ref $p{grok_bin}, 'HASH'); +ok(scalar keys %{$p{grok_bin}}, 2); +ok($p{grok_bin}{explicit}); +ok($p{grok_bin}{depend}); + +ok(exists $p{gv_stashpvn}); +ok(ref $p{gv_stashpvn}, 'HASH'); +ok(scalar keys %{$p{gv_stashpvn}}, 2); +ok($p{gv_stashpvn}{depend}); +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}); + +ok(exists $p{PL_signals}); +ok(ref $p{PL_signals}, 'HASH'); +ok(scalar keys %{$p{PL_signals}}, 1); +ok($p{PL_signals}{explicit}); + +=============================================================================== + +# 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(); + +=============================================================================== + +# check if explicit variables are handled propery + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o =~ /^Uses PL_signals/m); +ok($o =~ /^File needs PL_signals, adding static request/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +unlink qw(MyExt.xsa); + +---------------------------- MyExt.xs ----------------------------------------- + +PL_signals = 123; +if (PL_signals == 42) + foo(); + +---------------------------- MyExt.ra ----------------------------------------- + +#define NEED_PL_signals +#include "ppport.h" +PL_signals = 123; +if (PL_signals == 42) + foo(); + +=============================================================================== + +my $o = ppport(qw(--nochanges file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o =~ /^Uses SvUOK/m); +ok($o =~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(2 warnings\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0 file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o !~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +---------------------------- file.xs ----------------------------------------- + +#define NEED_PL_parser +#include "ppport.h" +SvUOK +PL_copline + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE defgv + \ + sv_undef + +---------------------------- file.xsr ----------------------------------------- + +#include "ppport.h" +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING PL_defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE PL_defgv + \ + PL_sv_undef + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak("bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner("foo"); +warner_nocontext("foo"); +warner("foo"); + +---------------------------- file.xsr ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak(aTHX_ "bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner(aTHX_ "foo"); +warner_nocontext("foo"); +warner("foo"); + diff --git a/dist/Devel-PPPort/t/pv_tools.t b/dist/Devel-PPPort/t/pv_tools.t new file mode 100644 index 0000000000..e53beed0a0 --- /dev/null +++ b/dist/Devel-PPPort/t/pv_tools.t @@ -0,0 +1,74 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/pv_tools instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (13) { + load(); + plan(tests => 13); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $uni = &Devel::PPPort::pv_escape_can_unicode(); + +# sanity check +ok($uni ? $] >= 5.006 : $] < 5.008); + +my @r; + +@r = &Devel::PPPort::pv_pretty(); +ok($r[0], $r[1]); +ok($r[0], "foobarbaz"); +ok($r[2], $r[3]); +ok($r[2], '<leftpv_p\retty\nright>'); +ok($r[4], $r[5]); +ok($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303'); +ok($r[6], $r[7]); +ok($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...'); + +@r = &Devel::PPPort::pv_display(); +ok($r[0], $r[1]); +ok($r[0], '"foob\0rbaz"\0'); +ok($r[2], $r[3]); +ok($r[2] eq '"pv_di"...\0' || + $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :( + diff --git a/dist/Devel-PPPort/t/pvs.t b/dist/Devel-PPPort/t/pvs.t new file mode 100644 index 0000000000..ff4d3e0586 --- /dev/null +++ b/dist/Devel-PPPort/t/pvs.t @@ -0,0 +1,73 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/pvs instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (12) { + load(); + plan(tests => 12); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $x = 'foo'; + +ok(Devel::PPPort::newSVpvs(), "newSVpvs"); +ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); +ok(Devel::PPPort::newSVpvs_share(), 3); + +Devel::PPPort::sv_catpvs($x); +ok($x, "foosv_catpvs"); + +Devel::PPPort::sv_setpvs($x); +ok($x, "sv_setpvs"); + +my %h = ('hv_fetchs' => 42); +Devel::PPPort::hv_stores(\%h, 4711); +ok(scalar keys %h, 2); +ok(exists $h{'hv_stores'}); +ok($h{'hv_stores'}, 4711); +ok(Devel::PPPort::hv_fetchs(\%h), 42); +ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION); +ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::); + +ok(Devel::PPPort::get_cvs(), 3); + diff --git a/dist/Devel-PPPort/t/shared_pv.t b/dist/Devel-PPPort/t/shared_pv.t new file mode 100644 index 0000000000..eac79c6ca8 --- /dev/null +++ b/dist/Devel-PPPort/t/shared_pv.t @@ -0,0 +1,52 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/shared_pv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::newSVpvn_share(), 6); + diff --git a/dist/Devel-PPPort/t/snprintf.t b/dist/Devel-PPPort/t/snprintf.t new file mode 100644 index 0000000000..0b90004d9e --- /dev/null +++ b/dist/Devel-PPPort/t/snprintf.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/snprintf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my($l, $s) = Devel::PPPort::my_snprintf(); +ok($l, 8); +ok($s, "foobar42"); + diff --git a/dist/Devel-PPPort/t/sprintf.t b/dist/Devel-PPPort/t/sprintf.t new file mode 100644 index 0000000000..8b0d51fc91 --- /dev/null +++ b/dist/Devel-PPPort/t/sprintf.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/sprintf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my($l, $s) = Devel::PPPort::my_sprintf(); +ok($l, 8); +ok($s, "foobar42"); + diff --git a/dist/Devel-PPPort/t/strlfuncs.t b/dist/Devel-PPPort/t/strlfuncs.t new file mode 100644 index 0000000000..c8175472de --- /dev/null +++ b/dist/Devel-PPPort/t/strlfuncs.t @@ -0,0 +1,65 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/strlfuncs instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (13) { + load(); + plan(tests => 13); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my @e = (3, 'foo', + 6, 'foobar', + 9, 'foobarb', + 10, '1234567', + 4, '1234', + 16, '1234567', + ); +my @r = Devel::PPPort::my_strlfunc(); + +ok(@e == @r); + +for (0 .. $#e) { + ok($r[$_], $e[$_]); +} + diff --git a/dist/Devel-PPPort/t/sv_xpvf.t b/dist/Devel-PPPort/t/sv_xpvf.t new file mode 100644 index 0000000000..15074317df --- /dev/null +++ b/dist/Devel-PPPort/t/sv_xpvf.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/sv_xpvf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (9) { + load(); + plan(tests => 9); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +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' : ''); + diff --git a/dist/Devel-PPPort/t/testutil.pl b/dist/Devel-PPPort/t/testutil.pl new file mode 100644 index 0000000000..4fc7d667a6 --- /dev/null +++ b/dist/Devel-PPPort/t/testutil.pl @@ -0,0 +1,48 @@ +{ + my $__ntest; + my $__total; + + sub plan { + @_ == 2 or die "usage: plan(tests => count)"; + my $what = shift; + $what eq 'tests' or die "cannot plan anything but tests"; + $__total = shift; + defined $__total && $__total > 0 or die "need a positive number of tests"; + print "1..$__total\n"; + } + + sub skip { + my $reason = shift; + ++$__ntest; + print "ok $__ntest # skip: $reason\n" + } + + 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') { + die "using regular expression objects is not backwards compatible"; + } else { + $ok = $result eq $expected; + } + } + ++$__ntest; + if ($ok) { + print "ok $__ntest\n" + } + else { + print "not ok $__ntest\n" + } + } +} + +1; diff --git a/dist/Devel-PPPort/t/threads.t b/dist/Devel-PPPort/t/threads.t new file mode 100644 index 0000000000..a1c8caa5c8 --- /dev/null +++ b/dist/Devel-PPPort/t/threads.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/threads instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::no_THX_arg("42"), 43); +eval { &Devel::PPPort::with_THX_arg("yes\n"); }; +ok($@ =~ /^yes/); + diff --git a/dist/Devel-PPPort/t/uv.t b/dist/Devel-PPPort/t/uv.t new file mode 100644 index 0000000000..bc123c6bbf --- /dev/null +++ b/dist/Devel-PPPort/t/uv.t @@ -0,0 +1,61 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/uv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +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); + diff --git a/dist/Devel-PPPort/t/variables.t b/dist/Devel-PPPort/t/variables.t new file mode 100644 index 0000000000..ef1ac8b20d --- /dev/null +++ b/dist/Devel-PPPort/t/variables.t @@ -0,0 +1,107 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/variables instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (52) { + load(); + plan(tests => 52); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::compare_PL_signals()); + +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::PL_Sv(), "mhx"); +ok(defined &Devel::PPPort::PL_tokenbuf()); +ok($] >= 5.009005 || &Devel::PPPort::PL_parser()); +ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/); +ok(defined &Devel::PPPort::PL_hints()); +ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX"); + +for (&Devel::PPPort::other_variables()) { + ok($_ != 0); +} + +{ + my @w; + my $fail = 0; + { + local $SIG{'__WARN__'} = sub { push @w, @_ }; + ok(&Devel::PPPort::dummy_parser_warning()); + } + if ($] >= 5.009005) { + ok(@w >= 0); + for (@w) { + print "# $_"; + unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) { + warn $_; + $fail++; + } + } + } + else { + ok(@w == 0); + } + ok($fail, 0); +} + +ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0)); + +eval { &Devel::PPPort::no_dummy_parser_vars(0) }; + +if ($] < 5.009005) { + ok($@, ''); +} +else { + if ($@) { + print "# $@"; + ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i); + } + else { + ok(1); + } +} + diff --git a/dist/Devel-PPPort/t/warn.t b/dist/Devel-PPPort/t/warn.t new file mode 100644 index 0000000000..d538055a65 --- /dev/null +++ b/dist/Devel-PPPort/t/warn.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/warn instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (5) { + load(); + plan(tests => 5); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +$^W = 0; + +my $warning; + +$SIG{'__WARN__'} = sub { $warning = $_[0] }; + +$warning = ''; +Devel::PPPort::warner(); +ok($] >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner_nocontext(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($warning, ''); + +$^W = 1; + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($] >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); + |