1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 14:19:10 -04:00

Housecleaning for the DBD::SQLite release candidate

This commit is contained in:
Adam Kennedy 2010-09-09 01:35:22 +00:00
parent f509d383a2
commit 174f2050f0
5 changed files with 196 additions and 148 deletions

View file

@ -1,8 +1,13 @@
Changes for Perl extension DBD-SQLite
1.30_06 to be released
1.30_06 Thu 9 Sep 2010
- Resolved # 60860: Slow but steady memory leak on
last_insert_id calls (ISHIGAKI)
- Moved DBD::SQLite::FTS3Transitional into a dedicated dist (DAMI)
- Updated bundled Test::NoWarnings to 1.02 (ADAMK)
- Slightly bumped Test::More and added Test::Builder dependencies,
because they are inherited from the bundled Test::NoWarnings (ADAMK)
- Upgraded ppport.h to the latest version (ADAMK)
1.30_05 Fri 27 Aug 2010
- Test::NoWarnings bundled in the "inc" directory was ignored

View file

@ -257,7 +257,8 @@ WriteMakefile(
'Tie::Hash' => 0,
'File::Spec' => (WINLIKE ? '3.27' : '0.82'),
'DBI' => $DBI_required,
'Test::More' => '0.42',
'Test::More' => '0.47', # Test::NoWarnings
'Test::Builder' => '0.86', # Test::NoWarnings
( WINLIKE ? (
'Win32' => '0.30',
) : () ),

View file

@ -1,40 +1,33 @@
use strict;
use warnings;
package Test::NoWarnings;
use Test::Builder;
use Test::NoWarnings::Warning;
my $Test = Test::Builder->new;
my $PID = $$;
use Carp;
use vars qw(
$VERSION @EXPORT_OK @ISA $do_end_test
);
$VERSION = '0.084';
require Exporter;
@ISA = qw( Exporter );
use 5.006;
use strict;
use warnings;
use Carp ();
use Exporter ();
use Test::Builder ();
use Test::NoWarnings::Warning ();
use vars qw( $VERSION @EXPORT_OK @ISA $do_end_test );
BEGIN {
$VERSION = '1.02';
@ISA = 'Exporter';
@EXPORT_OK = qw(
clear_warnings had_no_warnings warnings
);
my @warnings;
$SIG{__WARN__} = make_catcher(\@warnings);
# Do we add the warning test at the end?
$do_end_test = 0;
}
sub import
{
my $TEST = Test::Builder->new;
my $PID = $$;
my @WARNINGS = ();
$SIG{__WARN__} = make_catcher(\@WARNINGS);
sub import {
$do_end_test = 1;
goto &Exporter::import;
}
@ -45,16 +38,14 @@ END {
had_no_warnings() if $do_end_test;
}
sub make_warning
{
sub make_warning {
local $SIG{__WARN__};
my $msg = shift;
my $warning = Test::NoWarnings::Warning->new;
$warning->setMessage($msg);
$warning->fillTest($Test);
$warning->fillTest($TEST);
$warning->fillTrace(__PACKAGE__);
$Carp::Internal{__PACKAGE__.""}++;
@ -65,12 +56,10 @@ sub make_warning
return $warning;
}
sub make_catcher
{
# this make a subroutine which can be used in $SIG{__WARN__}
# it takes one argument, a ref to an array
# it will push the details of the warning onto the end of the array.
sub make_catcher {
my $array = shift;
return sub {
@ -84,8 +73,7 @@ sub make_catcher
};
}
sub had_no_warnings
{
sub had_no_warnings {
return 0 if $$ != $PID;
local $SIG{__WARN__};
@ -93,48 +81,43 @@ sub had_no_warnings
my $ok;
my $diag;
if (@warnings == 0)
{
if ( @WARNINGS == 0 ) {
$ok = 1;
}
else
{
} else {
$ok = 0;
$diag = "There were ".@warnings." warning(s)\n";
$diag .= join("----------\n", map { $_->toString } @warnings);
$diag = "There were ".@WARNINGS." warning(s)\n";
$diag .= join "----------\n", map { $_->toString } @WARNINGS;
}
$Test->ok($ok, $name) || $Test->diag($diag);
$TEST->ok($ok, $name) || $TEST->diag($diag);
return $ok;
}
sub clear_warnings
{
sub clear_warnings {
local $SIG{__WARN__};
@warnings = ();
@WARNINGS = ();
}
sub warnings
{
sub warnings {
local $SIG{__WARN__};
return @warnings;
return @WARNINGS;
}
sub builder
{
sub builder {
local $SIG{__WARN__};
if (@_)
{
$Test = shift;
if ( @_ ) {
$TEST = shift;
}
return $Test;
return $TEST;
}
1;
__END__
=pod
=head1 NAME
Test::NoWarnings - Make sure you didn't emit any warnings while testing
@ -223,18 +206,18 @@ module
=head1 EXPORTABLE FUNCTIONS
=head2 had_no_warnings()
=head2 had_no_warnings
This checks that there have been warnings emitted by your test scripts.
Usually you will not call this explicitly as it is called automatically when
your script finishes.
=head2 clear_warnings()
=head2 clear_warnings
This will clear the array of warnings that have been captured. If the array
is empty then a call to C<had_no_warnings()> will produce a pass result.
=head2 warnings()
=head2 warnings
This will return the array of warnings captured so far. Each element of this
array is an object containing information about the warning. The following
@ -281,9 +264,13 @@ Get the name of the test that executed before the warning was emitted.
When counting your tests for the plan, don't forget to include the test that
runs automatically when your script ends.
=head1 BUGS
=head1 SUPPORT
None that I know of.
Bugs should be reported via the CPAN bug tracker at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-NoWarnings>
For other issues, contact the author.
=head1 HISTORY
@ -293,13 +280,17 @@ This was previously known as L<Test::Warn::None>
L<Test::Builder>, L<Test::Warn>
=head1 AUTHOR
=head1 AUTHORS
Written by Fergal Daly <fergal@esatclear.ie>.
Fergal Daly E<lt>fergal@esatclear.ieE<gt>
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
=head1 COPYRIGHT
Copyright 2003 by Fergal Daly E<lt>fergal@esatclear.ieE<gt>.
Copyright 2003 - 2007 Fergal Daly.
Some parts copyright 2010 Adam Kennedy.
This program is free software and comes with no warranty. It is distributed
under the LGPL license

View file

@ -1,102 +1,74 @@
use strict;
package Test::NoWarnings::Warning;
use Carp;
use 5.006;
use strict;
use Carp ();
my $has_st = eval "require Devel::StackTrace" || 0;
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.02';
sub new
{
my $pkg = shift;
my %args = @_;
my $self = bless \%args, $pkg;
return $self;
# Optional stacktrace support
eval "require Devel::StackTrace";
}
sub getTrace
{
my $self = shift;
return $self->{Trace};
sub new {
my $class = shift;
bless { @_ }, $class;
}
sub fillTrace
{
sub getTrace {
$_[0]->{Trace};
}
sub fillTrace {
my $self = shift;
$self->{Trace} = Devel::StackTrace->new(
ignore_class => [__PACKAGE__, @_],
) if $has_st;
) if $Devel::StackTrace::VERSION;
}
sub getCarp
{
my $self = shift;
return $self->{Carp};
sub getCarp {
$_[0]->{Carp};
}
sub fillCarp
{
sub fillCarp {
my $self = shift;
my $msg = shift;
$Carp::Internal{ __PACKAGE__ . "" }++;
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
$self->{Carp} = Carp::longmess($msg);
$Carp::Internal{ __PACKAGE__ . "" }--;
}
sub getMessage
{
my $self = shift;
return $self->{Message};
sub getMessage {
$_[0]->{Message};
}
sub setMessage
{
my $self = shift;
$self->{Message} = shift;
sub setMessage {
$_[0]->{Message} = $_[1];
}
sub fillTest
{
sub fillTest {
my $self = shift;
my $builder = shift;
my $prev_test = $builder->current_test;
$self->{Test} = $prev_test;
my @tests = $builder->details;
my $prev_test_name = $prev_test ? $tests[$prev_test - 1]->{name} : "";
$self->{TestName} = $prev_test_name;
}
sub getTest
{
my $self = shift;
return $self->{Test};
sub getTest {
$_[0]->{Test};
}
sub getTestName
{
my $self = shift;
return $self->{TestName};
sub getTestName {
$_[0]->{TestName};
}
sub toString
{
sub toString {
my $self = shift;
return <<EOM;
Previous test $self->{Test} '$self->{TestName}'
$self->{Carp}

View file

@ -4,9 +4,9 @@
/*
----------------------------------------------------------------------
ppport.h -- Perl/Pollution/Portability Version 3.17
ppport.h -- Perl/Pollution/Portability Version 3.19
Automatically created by Devel::PPPort running under perl 5.008008.
Automatically created by Devel::PPPort running under perl 5.010001.
Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
includes in parts/inc/ instead.
@ -21,7 +21,7 @@ SKIP
=head1 NAME
ppport.h - Perl/Pollution/Portability version 3.17
ppport.h - Perl/Pollution/Portability version 3.19
=head1 SYNOPSIS
@ -232,6 +232,7 @@ same function or variable in your project.
my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
@ -377,7 +378,7 @@ use strict;
# Disable broken TRIE-optimization
BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
my $VERSION = 3.17;
my $VERSION = 3.19;
my %opt = (
quiet => 0,
@ -486,6 +487,7 @@ G_NOARGS|||
G_SCALAR|||
G_VOID||5.004000|
GetVars|||
GvSVn|5.009003||p
GvSV|||
Gv_AMupdate|||
HEf_SVKEY||5.004000|
@ -498,6 +500,8 @@ HeSVKEY_set||5.004000|
HeSVKEY||5.004000|
HeUTF8||5.011000|
HeVAL||5.004000|
HvNAMELEN_get|5.009003||p
HvNAME_get|5.009003||p
HvNAME|||
INT2PTR|5.006000||p
IN_LOCALE_COMPILETIME|5.007002||p
@ -628,6 +632,9 @@ PERL_SHORT_MAX|5.004000||p
PERL_SHORT_MIN|5.004000||p
PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
PERL_SUBVERSION|5.006000||p
PERL_SYS_INIT3||5.006000|
PERL_SYS_INIT|||
PERL_SYS_TERM||5.011000|
PERL_UCHAR_MAX|5.004000||p
PERL_UCHAR_MIN|5.004000||p
PERL_UINT_MAX|5.004000||p
@ -661,9 +668,12 @@ PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
PL_errgv|5.004050||p
PL_error_count|5.011000||p
PL_expect|5.011000||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_in_my_stash|5.011000||p
PL_in_my|5.011000||p
PL_last_in_gv|||n
PL_laststatval|5.005000||p
PL_lex_state|5.011000||p
@ -769,6 +779,7 @@ SV_MUTABLE_RETURN|5.009003||p
SV_NOSTEAL|5.009002||p
SV_SMAGIC|5.009003||p
SV_UTF8_NO_ENCODING|5.008001||p
SVfARG|5.009005||p
SVf_UTF8|5.006000||p
SVf|5.006000||p
SVt_IV|||
@ -977,6 +988,7 @@ XPUSHn|||
XPUSHp|||
XPUSHs|||
XPUSHu|5.004000||p
XSPROTO|5.010000||p
XSRETURN_EMPTY|||
XSRETURN_IV|||
XSRETURN_NO|||
@ -1055,7 +1067,6 @@ boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_mro|||
boot_core_xsutils|||
bytes_from_utf8||5.007001|
bytes_to_uni|||n
bytes_to_utf8||5.006001|
@ -1341,7 +1352,6 @@ get_vtbl||5.005030|
getcwd_sv||5.007002|
getenv_len|||
glob_2number|||
glob_2pv|||
glob_assign_glob|||
glob_assign_ref|||
gp_dup|||
@ -1372,7 +1382,8 @@ gv_fetchmethod_autoload||5.004000|
gv_fetchmethod_flags||5.011000|
gv_fetchmethod|||
gv_fetchmeth|||
gv_fetchpvn_flags||5.009002|
gv_fetchpvn_flags|5.009002||p
gv_fetchpvs|5.009004||p
gv_fetchpv|||
gv_fetchsv||5.009002|
gv_fullname3||5.004000|
@ -1384,7 +1395,7 @@ gv_init_sv|||
gv_init|||
gv_name_set||5.009004|
gv_stashpvn|5.004000||p
gv_stashpvs||5.009003|
gv_stashpvs|5.009003||p
gv_stashpv|||
gv_stashsv|||
he_dup|||
@ -1470,6 +1481,7 @@ isBLANK|5.006001||p
isCNTRL|5.006000||p
isDIGIT|||
isGRAPH|5.006000||p
isGV_with_GP|5.009004||p
isLOWER|||
isPRINT|5.004000||p
isPSXSPC|5.006001||p
@ -1774,7 +1786,7 @@ newSTATEOP|||
newSUB|||
newSVOP|||
newSVREF|||
newSV_type||5.009005|
newSV_type|5.009005||p
newSVhek||5.009003|
newSViv|||
newSVnv|||
@ -2195,6 +2207,7 @@ sv_derived_from||5.004000|
sv_destroyable||5.010000|
sv_does||5.009004|
sv_dump|||
sv_dup_inc_multiple|||
sv_dup|||
sv_eq|||
sv_exp_grow|||
@ -3907,6 +3920,13 @@ typedef NVTYPE NV;
return; \
} STMT_END
#endif
#ifndef XSPROTO
# define XSPROTO(name) void name(pTHX_ CV* cv)
#endif
#ifndef SVfARG
# define SVfARG(p) ((void*)(p))
#endif
#ifndef PERL_ABS
# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
#endif
@ -4086,9 +4106,11 @@ extern U32 DPPP_(my_PL_signals);
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_error_count error_count
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_in_my in_my
# define PL_laststatval laststatval
# define PL_lex_state lex_state
# define PL_lex_stuff lex_stuff
@ -4171,6 +4193,10 @@ extern yy_parser DPPP_(dummy_PL_parser);
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
#else
@ -4711,6 +4737,35 @@ DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
#ifndef newSV_type
#if defined(NEED_newSV_type)
static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
static
#else
extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
#endif
#ifdef newSV_type
# undef newSV_type
#endif
#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
#define Perl_newSV_type DPPP_(my_newSV_type)
#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
SV*
DPPP_(my_newSV_type)(pTHX_ svtype const t)
{
SV* const sv = newSV(0);
sv_upgrade(sv, t);
return sv;
}
#endif
#endif
#if (PERL_BCDVERSION < 0x5006000)
# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
#else
@ -5298,6 +5353,19 @@ DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
#ifndef SvSHARED_HASH
# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
#endif
#ifndef HvNAME_get
# define HvNAME_get(hv) HvNAME(hv)
#endif
#ifndef HvNAMELEN_get
# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
#endif
#ifndef GvSVn
# define GvSVn(gv) GvSV(gv)
#endif
#ifndef isGV_with_GP
# define isGV_with_GP(gv) isGV(gv)
#endif
#ifndef WARN_ALL
# define WARN_ALL 0
#endif
@ -5561,6 +5629,17 @@ DPPP_(my_warner)(U32 err, const char *pat, ...)
#ifndef hv_stores
# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
#endif
#ifndef gv_fetchpvn_flags
# define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
#endif
#ifndef gv_fetchpvs
# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
#endif
#ifndef gv_stashpvs
# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
#endif
#ifndef SvGETMAGIC
# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
#endif