ext/Devel/PPPort/apicheck_c.PL Devel::PPPort apicheck generator
ext/Devel/PPPort/Changes Devel::PPPort changes
ext/Devel/PPPort/devel/buildperl.pl Devel::PPPort perl version builder
+ext/Devel/PPPort/devel/devtools.pl Devel::PPPort development utilities
ext/Devel/PPPort/devel/mkapidoc.sh Devel::PPPort apidoc collector
ext/Devel/PPPort/devel/mktodo Devel::PPPort baseline/todo generator
ext/Devel/PPPort/devel/mktodo.pl Devel::PPPort baseline/todo generator
+ext/Devel/PPPort/devel/regenerate Devel::PPPort API re-generator
ext/Devel/PPPort/devel/scanprov Devel::PPPort provided API scanner
ext/Devel/PPPort/HACKERS Devel::PPPort hackers documentation
ext/Devel/PPPort/Makefile.PL Devel::PPPort makefile writer
+3.08_03 - 2006-05-25
+
+ * update API info
+ * add devel/regenerate script to regenerate API info
+ * improve and speed up the development tools
+
3.08_02 - 2006-05-22
* fix a POD error
=back
+Alternatively, you can try to use the F<devel/regenerate> script.
+
=head2 Implementation
Residing in F<parts/inc/> is the "heart" of C<Devel::PPPort>. Each
#
################################################################################
#
-# $Revision: 43 $
+# $Revision: 44 $
# $Author: mhx $
-# $Date: 2006/05/22 00:51:20 +0200 $
+# $Date: 2006/05/22 20:28:47 +0200 $
#
################################################################################
#
only purpose is to write the F<ppport.h> C header file. This file
contains a series of macros and, if explicitly requested, functions that
allow XS modules to be built using older versions of Perl. Currently,
-Perl versions from 5.003 to 5.9.3 are supported.
+Perl versions from 5.003 to 5.9.4 are supported.
This module is used by C<h2xs> to write the file F<ppport.h>.
=head1 COMPATIBILITY
-F<ppport.h> supports Perl versions from 5.003 to 5.9.3
+F<ppport.h> supports Perl versions from 5.003 to 5.9.4
in threaded and non-threaded configurations.
=head2 Provided Perl compatibility API
MULTICALL
POP_MULTICALL
PUSH_MULTICALL
+ PerlIO_context_layers
gv_name_set
my_vsnprintf
newXS_flags
dMULTICALL
doref
gv_const_sv
+ gv_stashpvs
hv_eiter_p
hv_eiter_set
hv_name_set
my_sprintf
newGIVENOP
newSVhek
+ newSVpvs_share
newWHENOP
newWHILEOP
ref
+ savepvs
sortsv_flags
vverify
use strict;
use vars qw($VERSION @ISA $data);
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
@ISA = qw(DynaLoader);
|>=head1 COMPATIBILITY
|>
|>This version of F<ppport.h> is designed to support operation with Perl
-|>installations back to 5.003, and has been tested up to 5.9.3.
+|>installations back to 5.003, and has been tested up to 5.9.4.
|>
|>=head1 OPTIONS
|>
PERL_UNUSED_VAR|5.007002||p
PERL_UQUAD_MAX|5.004000||p
PERL_UQUAD_MIN|5.004000||p
-PERL_USE_GCC_BRACE_GROUPS|||p
+PERL_USE_GCC_BRACE_GROUPS|5.009004||p
PERL_USHORT_MAX|5.004000||p
PERL_USHORT_MIN|5.004000||p
PERL_VERSION|5.006000||p
PUTBACK|||
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
-PerlIO_context_layers|||
+PerlIO_context_layers||5.009004|
PerlIO_eof||5.007003|
PerlIO_error||5.007003|
PerlIO_fileno||5.007003|
STMT_START|||p
STR_WITH_LEN|5.009003||p
ST|||
-SVf|||p
+SVf|5.006000||p
SVt_IV|||
SVt_NV|||
SVt_PVAV|||
SvRV|||
SvSETMAGIC|||
SvSHARE||5.007003|
-SvSTASH_set|5.009004||p
+SvSTASH_set|5.009003||p
SvSTASH|||
SvSetMagicSV_nosteal||5.004000|
SvSetMagicSV||5.004000|
boot_core_UNIVERSAL|||
boot_core_xsutils|||
bytes_from_utf8||5.007001|
-bytes_to_uni|||
+bytes_to_uni|||n
bytes_to_utf8||5.006001|
call_argv|5.006000||p
call_atexit||5.006000|
check_uni|||
checkcomma|||
checkposixcc|||
-ckWARN|||p
+ckWARN|5.006000||p
ck_anoncode|||
ck_bitop|||
ck_concat|||
gv_init|||
gv_name_set||5.009004|
gv_stashpvn|5.006000||p
+gv_stashpvs||5.009003|
gv_stashpv|||
gv_stashsv|||
he_dup|||
newSVpvf||5.004000|v
newSVpvn_share||5.007001|
newSVpvn|5.006000||p
+newSVpvs_share||5.009003|
newSVpvs|5.009003||p
newSVpv|||
newSVrv|||
save_svref|||
save_vptr||5.006000|
savepvn|||
+savepvs||5.009003|
savepv|||
savesharedpv||5.007003|
savestack_grow_cnt||5.008001|
#
################################################################################
#
-# $Revision: 43 $
+# $Revision: 44 $
# $Author: mhx $
-# $Date: 2006/05/22 00:51:20 +0200 $
+# $Date: 2006/05/22 20:28:47 +0200 $
#
################################################################################
#
{join "\n", @todo}gem;
$data =~ s{__MIN_PERL__}{5.003}g;
-$data =~ s{__MAX_PERL__}{5.9.3}g;
+$data =~ s{__MAX_PERL__}{5.9.4}g;
open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
print FH $data;
#
################################################################################
#
-# $Revision: 43 $
+# $Revision: 44 $
# $Author: mhx $
-# $Date: 2006/05/22 00:51:20 +0200 $
+# $Date: 2006/05/22 20:28:47 +0200 $
#
################################################################################
#
use strict;
use vars qw($VERSION @ISA $data);
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
@ISA = qw(DynaLoader);
TODO:
-* see if we can implement sv_catpvf() for < 5.004
+* figure out why many of the function for which Perl_* exists
+ fail the automated API check
+
+* use 'nm' to more efficiently find 'undefined' symbols?
+
+* implement snprintf with newSVpvf for >= 5.004, which is safer?
+
+* add support for my_vsnprintf?
+
+* try to perform some core consistency checks:
-* add hv_stores() to blead
+ - check if 'd' flag in embed.fnc matches with
+ supplied documentation
+
+ - check if all public API is documented
+
+* check (during make regen?) if MAX_PERL in PPPort_pm.PL
+ needs to be updated
+
+* see if we can implement sv_catpvf() for < 5.004
* MULTICALL ?
#
################################################################################
#
-# $Revision: 6 $
+# $Revision: 7 $
# $Author: mhx $
-# $Date: 2006/01/14 18:07:56 +0100 $
+# $Date: 2006/05/25 17:20:38 +0200 $
#
################################################################################
#
#
################################################################################
-$out = 'apicheck.c';
-print "creating $out\n";
-system $^X, 'parts/apicheck.pl', $out
+use strict;
+
+my $out = 'apicheck.c';
+my @api = map { /^--api=(\w+)$/ ? ($1) : () } @ARGV;
+print "creating $out", (@ARGV ? " (@api)" : ''), "\n";
+system $^X, 'parts/apicheck.pl', @api, $out
and die "couldn't create $out\n";
+
--- /dev/null
+################################################################################
+#
+# devtools.pl -- various utility functions
+#
+################################################################################
+#
+# $Revision: 1 $
+# $Author: mhx $
+# $Date: 2006/05/25 17:19:22 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
+# Version 2.x, Copyright (C) 2001, Paul Marquess.
+# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+################################################################################
+
+use IO::File;
+
+eval "use Term::ANSIColor";
+$@ and eval "sub colored { pop; @_ }";
+
+my @argvcopy = @ARGV;
+
+sub verbose
+{
+ if ($opt{verbose}) {
+ my @out = @_;
+ s/^(.*)/colored("($0) ", 'bold blue').colored($1, 'blue')/eg for @out;
+ print STDERR @out;
+ }
+}
+
+sub ddverbose
+{
+ return $opt{verbose} ? ('--verbose') : ();
+}
+
+sub runtool
+{
+ my $opt = ref $_[0] ? shift @_ : {};
+ my($prog, @args) = @_;
+ my $sysstr = join ' ', map { "'$_'" } $prog, @args;
+ $sysstr .= " >$opt->{'out'}" if exists $opt->{'out'};
+ $sysstr .= " 2>$opt->{'err'}" if exists $opt->{'err'};
+ verbose("running $sysstr\n");
+ my $rv = system $sysstr;
+ verbose("$prog => exit code $rv\n");
+ return not $rv;
+}
+
+sub runperl
+{
+ my $opt = ref $_[0] ? shift @_ : {};
+ runtool($opt, $^X, @_);
+}
+
+sub run
+{
+ my $prog = shift;
+ my @args = @_;
+
+ runtool({ 'out' => 'tmp.out', 'err' => 'tmp.err' }, $prog, @args);
+
+ my $out = new IO::File "tmp.out" || die "tmp.out: $!\n";
+ my $err = new IO::File "tmp.err" || die "tmp.err: $!\n";
+
+ my %rval = (
+ status => $? >> 8,
+ stdout => [<$out>],
+ stderr => [<$err>],
+ didnotrun => 0,
+ );
+
+ unlink "tmp.out", "tmp.err";
+
+ $? & 128 and $rval{core} = 1;
+ $? & 127 and $rval{signal} = $? & 127;
+
+ return \%rval;
+}
+
+sub ident_str
+{
+ return "$^X $0 @argvcopy";
+}
+
+sub identify
+{
+ verbose(ident_str() . "\n");
+}
+
+sub ask($)
+{
+ my $q = shift;
+ my $a;
+ local $| = 1;
+ print "\n$q [y/n] ";
+ do { $a = <>; } while ($a !~ /^\s*([yn])\s*$/i);
+ return lc $1 eq 'y';
+}
+
+sub quit_now
+{
+ print "\nSorry, cannot continue.\n\n";
+ exit 1;
+}
+
+sub ask_or_quit
+{
+ quit_now unless &ask;
+}
+
+sub eta
+{
+ my($start, $i, $n) = @_;
+ return "--:--:--" if $i < 3;
+ my $elapsed = tv_interval($start);
+ my $h = int($elapsed*($n-$i)/$i);
+ my $s = $h % 60; $h /= 60;
+ my $m = $h % 60; $h /= 60;
+ return sprintf "%02d:%02d:%02d", $h, $m, $s;
+}
+
+1;
#
################################################################################
#
-# $Revision: 10 $
+# $Revision: 12 $
# $Author: mhx $
-# $Date: 2006/01/14 23:02:12 +0100 $
+# $Date: 2006/05/25 17:22:31 +0200 $
#
################################################################################
#
use strict;
use Getopt::Long;
-my %opt = (
- base => 0,
+require 'devel/devtools.pl';
+
+our %opt = (
+ base => 0,
+ verbose => 0,
);
GetOptions(\%opt, qw(
base
+ verbose
)) or die;
+identify();
+
# my $outdir = $opt{base} ? 'parts/base' : 'parts/todo';
my $outdir = 'parts/todo';
shift @perls;
-$ENV{SKIP_PPPHTEST} = 1;
-
for (@perls) {
my $todo = do { my $v = $_->{todo}; $v =~ s/\D+//g; $v };
-e "$outdir/$todo" and next;
my @args = ('--perl', $_->{path}, '--todo', "$outdir/$todo", '--version', "$_->{todo}");
push @args, '--base' if $opt{base};
- system 'devel/mktodo.pl', @args and die "system(@args): [$!] [$?]\n";
+ push @args, '--verbose' if $opt{verbose};
+ runperl('devel/mktodo.pl', @args) or die "error running mktodo.pl [$!] [$?]\n";
}
+
#
################################################################################
#
-# $Revision: 8 $
+# $Revision: 11 $
# $Author: mhx $
-# $Date: 2006/01/14 22:41:14 +0100 $
+# $Date: 2006/05/25 17:22:32 +0200 $
#
################################################################################
#
use Data::Dumper;
use IO::File;
use IO::Select;
+use Time::HiRes qw( gettimeofday tv_interval );
-my %opt = (
- debug => 0,
- base => 0,
-);
+require 'devel/devtools.pl';
-print "\n$0 @ARGV\n\n";
+our %opt = (
+ debug => 0,
+ base => 0,
+ verbose => 0,
+);
GetOptions(\%opt, qw(
- perl=s todo=s version=s debug base
+ perl=s todo=s version=s debug base verbose
)) or die;
+identify();
+
+print "\n", ident_str(), "\n\n";
+
my $fullperl = `which $opt{perl}`;
chomp $fullperl;
+$ENV{SKIP_SLOW_TESTS} = 1;
+
regen_all();
my %sym;
unless (@new) {
@new = grep !$all{$_->[0]}, @tmp;
# TODO: @recheck was here, find a better way to get recheck syms
- # * we definitely don't have to check (U) symbols
# * try to grep out warnings before making symlist ?
}
unless (@new) {
print Dumper($r);
die "no new TODO symbols found...";
}
- push @recheck, map { $_->[0] } @new;
+ # don't recheck undefined symbols reported by the dynamic linker
+ push @recheck, map { $_->[0] } grep { $_->[1] !~ /^U/ } @new;
for (@new) {
printf "[$opt{version}] new symbol: %-30s # %s\n", @$_;
$all{$_->[0]} = $_->[1];
write_todo($opt{todo}, $opt{version}, \%all);
}
-for my $sym (@recheck) {
+my $ifmt = '%' . length(scalar @recheck) . 'd';
+my $t0 = [gettimeofday];
+
+RECHECK: for my $i (0 .. $#recheck) {
+ my $sym = $recheck[$i];
my $cur = delete $all{$sym};
- printf "[$opt{version}] chk symbol: %-30s # %s\n", $sym, $cur;
+
+ printf "[$opt{version}] chk symbol: %-30s # %s [$ifmt/$ifmt, ETA %s]\n",
+ $sym, $cur, $i + 1, scalar @recheck, eta($t0, $i, scalar @recheck);
+
write_todo($opt{todo}, $opt{version}, \%all);
+
+ if ($cur eq "E (Perl_$sym)") {
+ # we can try a shortcut here
+ regen_apicheck($sym);
+
+ my $r = run(qw(make test));
+
+ if (!$r->{didnotrun} && $r->{status} == 0) {
+ printf "[$opt{version}] del symbol: %-30s # %s\n", $sym, $cur;
+ next RECHECK;
+ }
+ }
+
+ # run the full test
regen_all();
+
my $r = run(qw(make test));
+
$r->{didnotrun} and die "couldn't run make test: $!\n";
+
if ($r->{status} == 0) {
printf "[$opt{version}] del symbol: %-30s # %s\n", $sym, $cur;
}
sub regen_all
{
- my @mf_arg = qw( --with-apicheck OPTIMIZE=-O0 );
+ my @mf_arg = ('--with-apicheck', 'OPTIMIZE=-O0');
push @mf_arg, qw( DEFINE=-DDPPP_APICHECK_NO_PPPORT_H ) if $opt{base};
# just to be sure
sub regen_apicheck
{
unlink qw(apicheck.c apicheck.o);
- system "$fullperl apicheck_c.PL >/dev/null";
+ runtool({ out => '/dev/null' }, $fullperl, 'apicheck_c.PL', map { "--api=$_" } @_)
+ or die "cannot regenerate apicheck.c\n";
}
sub load_todo
}
}
-sub run
-{
- my $prog = shift;
- my @args = @_;
-
- # print "[$prog @args]\n";
-
- system "$prog @args >tmp.out 2>tmp.err";
-
- my $out = new IO::File "tmp.out" || die "tmp.out: $!\n";
- my $err = new IO::File "tmp.err" || die "tmp.err: $!\n";
-
- my %rval = (
- status => $? >> 8,
- stdout => [<$out>],
- stderr => [<$err>],
- didnotrun => 0,
- );
-
- unlink "tmp.out", "tmp.err";
-
- $? & 128 and $rval{core} = 1;
- $? & 127 and $rval{signal} = $? & 127;
-
- \%rval;
-}
-
--- /dev/null
+#!/usr/bin/perl -w
+################################################################################
+#
+# regenerate -- regenerate baseline and todo files
+#
+################################################################################
+#
+# $Revision: 2 $
+# $Author: mhx $
+# $Date: 2006/05/25 17:22:32 +0200 $
+#
+################################################################################
+#
+# Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
+# Version 2.x, Copyright (C) 2001, Paul Marquess.
+# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+################################################################################
+
+use strict;
+use File::Path;
+use File::Copy;
+use Getopt::Long;
+use Pod::Usage;
+
+require 'devel/devtools.pl';
+
+our %opt = (
+ verbose => 0
+);
+
+GetOptions(\%opt, qw( verbose )) or die pod2usage();
+
+identify();
+
+unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') {
+ print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n";
+ quit_now();
+}
+
+ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?");
+
+my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );
+
+my(@notwr, @wr);
+for my $f (map @$_, values %files) {
+ push @{-w $f ? \@wr : \@notwr}, $f;
+}
+
+if (@notwr) {
+ if (@wr) {
+ print "\nThe following files are not writable:\n\n";
+ print " $_\n" for @notwr;
+ print "\nAre you sure you have checked out these files?\n";
+ }
+ else {
+ print "\nAll baseline / todo file are not writable.\n";
+ ask_or_quit("Do you want to try to check out these files?");
+ unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) {
+ print "\nSomething went wrong while checking out the files.\n";
+ quit_now();
+ }
+ }
+}
+
+for my $dir (qw( base todo )) {
+ my $cur = "parts/$dir";
+ my $old = "$cur-old";
+ if (-e $old) {
+ ask_or_quit("Do you want me to remove the old $old directory?");
+ rmtree($old);
+ }
+ mkdir $old;
+ print "\nBacking up $cur in $old.\n";
+ for my $src (@{$files{$dir}}) {
+ my $dst = $src;
+ $dst =~ s/\E$cur/$old/ or die "Ooops!";
+ move($src, $dst) or die "Moving $src to $dst failed: $!\n";
+ }
+}
+
+my $T0 = time;
+
+print "\nBuilding baseline files...\n\n";
+
+unless (runperl('devel/mktodo', '--base', ddverbose())) {
+ print "\nSomething went wrong while building the baseline files.\n";
+ quit_now();
+}
+
+print "\nMoving baseline files...\n\n";
+
+for my $src (glob 'parts/todo/5*') {
+ my $dst = $src;
+ $dst =~ s/todo/base/ or die "Ooops!";
+ move($src, $dst) or die "Moving $src to $dst failed: $!\n";
+}
+
+print "\nBuilding todo files...\n\n";
+
+unless (runperl('devel/mktodo', ddverbose())) {
+ print "\nSomething went wrong while building the baseline files.\n";
+ quit_now();
+}
+
+print "\nAdding remaining baseline info...\n\n";
+
+unless (runperl('Makefile.PL') and
+ runtool('make') and
+ runperl('devel/scanprov', 'write')) {
+ print "\nSomething went wrong while adding the baseline info.\n";
+ quit_now();
+}
+
+my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times);
+my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys;
+$usr = sprintf "%.2f", $usr + $cusr;
+$sys = sprintf "%.2f", $sys + $csys;
+
+print <<END;
+
+API info regenerated successfully.
+
+Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU)
+
+Don't forget to check in the files in parts/base and parts/todo.
+
+END
+
#
################################################################################
#
-# $Revision: 16 $
+# $Revision: 19 $
# $Author: mhx $
-# $Date: 2006/05/19 16:15:51 +0200 $
+# $Date: 2006/05/25 17:21:23 +0200 $
#
################################################################################
#
require 'parts/ppptools.pl';
if (@ARGV) {
- open OUT, ">$ARGV[0]" or die "$ARGV[0]: $!\n";
+ my $file = pop @ARGV;
+ open OUT, ">$file" or die "$file: $!\n";
}
else {
*OUT = \*STDOUT;
HEAD
+if (@ARGV) {
+ my %want = map { ($_ => 0) } @ARGV;
+ @f = grep { exists $want{$_->{name}} } @f;
+ for (@f) { $want{$_->{name}}++ }
+ for (keys %want) {
+ die "nothing found for '$_'\n" unless $want{$_};
+ }
+}
+
my $f;
for $f (@f) {
$ignore{$f->{name}} and next;
next;
}
$n = $tmap{$n} || $n;
- my $v = 'arg' . $i++;
- push @arg, $v;
- $stack .= " static $n $p$v$d;\n";
+ if ($n eq 'const char' and $p eq '*' and !$f->{flags}{f}) {
+ push @arg, '"foo"';
+ }
+ else {
+ my $v = 'arg' . $i++;
+ push @arg, $v;
+ $stack .= " static $n $p$v$d;\n";
+ }
}
unless ($f->{flags}{n} || $f->{flags}{'m'}) {
+Ama|char*|savepvs|const char* s
+Ama|SV*|newSVpvs|const char* s
+Ama|SV*|newSVpvs_share|const char* s
Am|bool|isALNUM|char ch
Am|bool|isALPHA|char ch
Am|bool|isDIGIT|char ch
Am|char|toLOWER|char ch
Am|char|toUPPER|char ch
Am|HV*|CvSTASH|CV* cv
+Am|HV*|gv_stashpvs|const char* name|I32 create
Am|HV*|SvSTASH|SV* sv
Am|int|AvFILL|AV* av
Am|IV|SvIV_nomg|SV* sv
Am|SV*|HeSVKEY|HE* he
Am|SV*|HeSVKEY_set|HE* he|SV* sv
Am|SV*|HeVAL|HE* he
+Am|SV**|hv_fetchs|HV* tb|const char* key|I32 lval
+Am|SV**|hv_stores|HV* tb|const char* key|NULLOK SV* val
Am|SV*|newRV_inc|SV* sv
Am|SV*|ST|int ix
+Am|void|sv_catpvs|SV* sv|const char* s
Am|SV*|SvREFCNT_inc_NN|SV* sv
Am|SV*|SvREFCNT_inc_simple_NN|SV* sv
Am|SV*|SvREFCNT_inc_simple|SV* sv
-Am|SV*|SvREFCNT_inc_simple_void_NN|SV* sv
-Am|SV*|SvREFCNT_inc_simple_void|SV* sv
+Am|void|SvREFCNT_inc_simple_void_NN|SV* sv
+Am|void|SvREFCNT_inc_simple_void|SV* sv
Am|SV*|SvREFCNT_inc|SV* sv
-Am|SV*|SvREFCNT_inc_void_NN|SV* sv
-Am|SV*|SvREFCNT_inc_void|SV* sv
+Am|void|SvREFCNT_inc_void_NN|SV* sv
+Am|void|SvREFCNT_inc_void|SV* sv
Am|SV*|SvRV|SV* sv
+Am|void|sv_setpvs|SV* sv|const char* s
Am|svtype|SvTYPE|SV* sv
Ams||XCPT_RETHROW
Ams||XSRETURN_EMPTY
PTRV # added by devel/scanprov
Perl_warner # added by devel/scanprov
Perl_warner_nocontext # added by devel/scanprov
+SVf # added by devel/scanprov
UVSIZE # added by devel/scanprov
UVTYPE # added by devel/scanprov
UVof # added by devel/scanprov
XSprePUSH # added by devel/scanprov
aTHX # added by devel/scanprov
aTHX_ # added by devel/scanprov
+ckWARN # added by devel/scanprov
dNOOP # added by devel/scanprov
dTHX # added by devel/scanprov
dTHXa # added by devel/scanprov
Newxz # E
SvMAGIC_set # U
SvRV_set # U
+SvSTASH_set # U
SvUV_set # U
av_arylen_p # E
ckwarn # U
dMULTICALL # E
doref # E
gv_const_sv # E
+gv_stashpvs # E
hv_eiter_p # E
hv_eiter_set # U
+hv_fetchs # E
hv_name_set # U
hv_placeholders_get # U
hv_placeholders_p # E
my_sprintf # U
newGIVENOP # E
newSVhek # E
+newSVpvs # E
+newSVpvs_share # E
newWHENOP # E
newWHILEOP # E (Perl_newWHILEOP)
ref # E (Perl_ref)
+savepvs # E
sortsv_flags # U
+sv_catpvs # U
vverify # U
PERL_UNUSED_ARG # added by devel/scanprov
STR_WITH_LEN # added by devel/scanprov
SvPVX_const # added by devel/scanprov
SvPVX_mutable # added by devel/scanprov
dVAR # added by devel/scanprov
-hv_fetchs # added by devel/scanprov
-newSVpvs # added by devel/scanprov
-sv_catpvs # added by devel/scanprov
MULTICALL # E
POP_MULTICALL # E
PUSH_MULTICALL # E
+PerlIO_context_layers # E
PoisonFree # E
PoisonNew # E
PoisonWith # E
SvREFCNT_inc_NN # E
SvREFCNT_inc_simple # E
SvREFCNT_inc_simple_NN # E
-SvREFCNT_inc_simple_void # E
-SvREFCNT_inc_simple_void_NN # E
-SvREFCNT_inc_void # E
-SvREFCNT_inc_void_NN # E
-SvSTASH_set # E
+SvREFCNT_inc_simple_void # U
+SvREFCNT_inc_simple_void_NN # U
+SvREFCNT_inc_void # U
+SvREFCNT_inc_void_NN # U
gv_name_set # U
+hv_stores # E
my_snprintf # U
my_vsnprintf # U
newXS_flags # E
pad_sv # U
regclass_swash # E (Perl_regclass_swash)
stashpv_hvname_match # U
+sv_setpvs # U
sv_usepvn_flags # U
PERL_BCDVERSION # added by devel/scanprov
PERL_UNUSED_CONTEXT # added by devel/scanprov
+PERL_USE_GCC_BRACE_GROUPS # added by devel/scanprov
SvVSTRING_mg # added by devel/scanprov
-hv_stores # added by devel/scanprov
-sv_setpvs # added by devel/scanprov
|NULLOK SV *keysv|NULLOK const char *key \
|STRLEN klen, int flags, U32 hash
dpoM |void |refcounted_he_free|NULLOK struct refcounted_he *he
-dpoM |struct refcounted_he *|refcounted_he_new \
+XEdpoM |struct refcounted_he *|refcounted_he_new \
|NULLOK struct refcounted_he *const parent \
|NULLOK SV *const key|NULLOK SV *const value
Apd |SV** |hv_store |NULLOK HV* tb|NULLOK const char* key|I32 klen|NULLOK SV* val \
ns |bool |need_utf8 |NN const char *pat|NN const char *patend
ns |char |first_symbol |NN const char *pat|NN const char *patend
sR |char * |sv_exp_grow |NN SV *sv|STRLEN needed
-sR |char * |bytes_to_uni |NN const U8 *start|STRLEN len|NN char *dest
+snR |char * |bytes_to_uni |NN const U8 *start|STRLEN len|NN char *dest
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
Apnod |int |my_sprintf |NN char *buffer|NN const char *pat|...
#endif
-Apnod |int |my_snprintf |NN char *buffer|const Size_t len|NN const char *format|...
+Apnodf |int |my_snprintf |NN char *buffer|const Size_t len|NN const char *format|...
Apnod |int |my_vsnprintf |NN char *buffer|const Size_t len|NN const char *format|va_list ap
px |void |my_clearenv
################################################################################
##
-## $Revision: 2 $
+## $Revision: 3 $
## $Author: mhx $
-## $Date: 2006/05/22 00:50:40 +0200 $
+## $Date: 2006/05/24 09:25:00 +0200 $
##
################################################################################
##
my @pods = qw( HACKERS PPPort.pm ppport.h );
-# 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;
-};
+my $reason = '';
-my $TP = $@ eq '';
+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 $@;
+}
-unless ($TP) {
+if ($reason) {
load();
plan(tests => scalar @pods);
}
for (@pods) {
print "# checking $_\n";
- if ($TP) {
- pod_file_ok($_);
+ if ($reason) {
+ skip("skip: $reason", 0);
}
else {
- skip("skip: Test::Pod >= 0.95 required", 0);
+ pod_file_ok($_);
}
}
################################################################################
##
-## $Revision: 30 $
+## $Revision: 31 $
## $Author: mhx $
-## $Date: 2006/01/19 18:34:14 +0100 $
+## $Date: 2006/05/24 09:25:00 +0200 $
##
################################################################################
##
=tests plan => 202
BEGIN {
- if ($ENV{'SKIP_PPPHTEST'}) {
+ if ($ENV{'SKIP_SLOW_TESTS'}) {
for (1 .. 202) {
- ok(1);
+ skip("skip: SKIP_SLOW_TESTS", 0);
}
exit 0;
}
dMULTICALL # E
doref # E
gv_const_sv # E
+gv_stashpvs # E
hv_eiter_p # E
hv_eiter_set # U
hv_name_set # U
my_sprintf # U
newGIVENOP # E
newSVhek # E
+newSVpvs_share # E
newWHENOP # E
newWHILEOP # E (Perl_newWHILEOP)
ref # E (Perl_ref)
+savepvs # E
sortsv_flags # U
vverify # U
MULTICALL # E
POP_MULTICALL # E
PUSH_MULTICALL # E
+PerlIO_context_layers # E
gv_name_set # U
my_vsnprintf # U
newXS_flags # E
#
################################################################################
#
-# $Revision: 11 $
+# $Revision: 12 $
# $Author: mhx $
-# $Date: 2006/05/22 01:57:33 +0200 $
+# $Date: 2006/05/22 20:26:02 +0200 $
#
################################################################################
#
use List::Util qw(max);
use Config;
-my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
$| = 1;
my $verbose = 0;
$OPT{mmargs} = [''] unless exists $OPT{mmargs};
$OPT{min} = parse_version($OPT{min}) - 1e-10;
-my @GoodPerls = sort { eval { parse_version($a) <=> parse_version($b) } or $a cmp $b }
- grep { my $v = eval { parse_version($_) }; $@ or $v >= $OPT{min} }
+my @GoodPerls = map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
+ grep { $_->[1] >= $OPT{min} }
+ map { [$_ => perl_version($_)] }
@ARGV ? SearchPerls(@ARGV) : FindPerls();
+
+unless (@GoodPerls) {
+ print "Sorry, got no Perl binaries for testing.\n\n";
+ exit 0;
+}
+
my $maxlen = max(map length, @GoodPerls) + 3;
my $mmalen = max(map length, @{$OPT{mmargs}});
$maxlen += $mmalen+3 if $mmalen > 0;
my @found;
print "Searching for Perl binaries in '$arg'...\n";
find(sub {
- if ($File::Find::name =~ m!bin/perl5\.!) {
- eval { parse_version($File::Find::name) };
- $@ or push @found, $File::Find::name;
- }
+ $File::Find::name =~ m!perl5[\w._]+$!
+ and -f $File::Find::name
+ and -x $File::Find::name
+ and perl_version($File::Find::name)
+ and push @found, $File::Find::name;
}, $arg);
printf "Found %d Perl binar%s in '%s'.\n\n", scalar @found, @found == 1 ? 'y' : 'ies', $arg;
push @perls, @found;
return @perls;
}
+sub perl_version
+{
+ my $perl = shift;
+ my $ver = `$perl -e 'print \$]' 2>&1`;
+ return $? == 0 && $ver >= 5 ? $ver : 0;
+}
+
sub parse_version
{
my $ver = shift;
- $ver = $1 if $ver =~ /perl(5\.[\d\._]+)/;
-
if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
return $1 + 1e-3*$2 + 1e-6*$3;
}
my @pods = qw( HACKERS PPPort.pm ppport.h );
-# 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;
-};
+my $reason = '';
-my $TP = $@ eq '';
+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 $@;
+}
-unless ($TP) {
+if ($reason) {
load();
plan(tests => scalar @pods);
}
for (@pods) {
print "# checking $_\n";
- if ($TP) {
- pod_file_ok($_);
+ if ($reason) {
+ skip("skip: $reason", 0);
}
else {
- skip("skip: Test::Pod >= 0.95 required", 0);
+ pod_file_ok($_);
}
}
$^W = 1;
BEGIN {
- if ($ENV{'SKIP_PPPHTEST'}) {
+ if ($ENV{'SKIP_SLOW_TESTS'}) {
for (1 .. 202) {
- ok(1);
+ skip("skip: SKIP_SLOW_TESTS", 0);
}
exit 0;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff