@@ -1,5 +1,24 @@
Revision history for Perl extension autobox
+2.82 Sat Oct 26 12:44:52 2013
+ - simplify test to avoid portability woes
+
+2.81 Sat Oct 26 11:32:31 2013
+ - fix failing test on Windows
+
+2.80 Fri Oct 25 19:32:12 2013
+ - RT #71777: fix segfault in destructor called during global destruction (thanks, Tomas Doran)
+ - added t/rt_71777.t
+
+2.79 Tue Apr 30 21:22:05 2013
+ - allow import arguments to be passed as a hashref
+ - added t/import_hashref.t
+ - doc tweaks
+
+2.78 Tue Apr 30 18:53:54 2013
+ - RT #80400: fix segfault in destructor called in END block (thanks, Tokuhiro Matsuno)
+ - added t/rt_80400.t
+
2.77 Thu Dec 13 19:59:48 2012
- doc tweaks
- add multiple-arg autoref tests
@@ -26,17 +45,17 @@ Revision history for Perl extension autobox
2.70 Wed Mar 17 19:27:44 2010
- replace autobox_can and autobox_isa with autobox_class
this also fixes import, unimport and VERSION
- - added t/version.t
- - renamed t/universal.t => t/autobox_class.t
+ - added t/version.t
+ - renamed t/universal.t => t/autobox_class.t
2.60 Wed Mar 17 16:34:56 2010
- fix RT #46814 (thanks Tye McQueen)
- - added t/rt_46814.t
+ - added t/rt_46814.t
- fix RT #49273 (thanks Daniel Austin)
- fix RT #55565 (thanks Schwern)
- fix RT #55652 (thanks Schwern)
- - $native->isa and $native->can must now be called as $native->autobox_isa and $native->autobox_can
- - added t/rt_55652.t
+ - $native->isa and $native->can must now be called as $native->autobox_isa and $native->autobox_can
+ - added t/rt_55652.t
2.55 Sun May 25 03:20:54 2008
- fix MANIFEST again - restore Changes
@@ -123,7 +142,6 @@ Revision history for Perl extension autobox
- documentation fix:
rm reference to $class->SUPER::import(TYPE => __PACKAGE__)
and explain why an auxiliary class should be used
-
2.00 Sun Feb 17 02:29:11 2008
- API changes:
@@ -133,7 +151,6 @@ Revision history for Perl extension autobox
multiple bindings for each type can be supplied as an ARRAY ref of classes
or namespaces
"no autobox qw(...)" disables/resets bindings for the specified type(s)
-
- fixed incorrect bareword handling
- perl 5.10 compatibility fixes (thanks Andreas Koenig)
- document previously undocumented features
@@ -17,13 +17,15 @@ t/coderef.t
t/default.t
t/export.t
t/hints.t
+t/import_hashref.t
t/isa.t
t/lib/Versioned.pm
t/merge.t
t/name.t
-t/pod.t
t/rt_46814.t
t/rt_55652.t
+t/rt_71777.t
+t/rt_80400.t
t/scalar.t
t/type.t
t/universal_type.t
@@ -4,7 +4,7 @@
"chocolateboy <chocolate@cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150",
+ "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.130880",
"license" : [
"perl_5"
],
@@ -22,12 +22,12 @@
"prereqs" : {
"build" : {
"requires" : {
- "ExtUtils::MakeMaker" : 0
+ "ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
- "ExtUtils::MakeMaker" : 0
+ "ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
@@ -42,5 +42,5 @@
"url" : "http://github.com/chocolateboy/autobox"
}
},
- "version" : "2.77"
+ "version" : "2.82"
}
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150'
+generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.130880'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -21,4 +21,4 @@ requires:
Scope::Guard: 0.20
resources:
repository: http://github.com/chocolateboy/autobox
-version: 2.77
+version: 2.82
@@ -1,4 +1,4 @@
-autobox version 2.77
+autobox version 2.82
====================
The autobox pragma allows methods to be called on integers, floats, strings, arrays, hashes, and code references in exactly the same manner as blessed references.
@@ -28,4 +28,4 @@ COPYRIGHT AND LICENCE
This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
-Copyright (c) 2003-2012 chocolateboy <chocolate@cpan.org>
+Copyright (c) 2003-2013 chocolateboy <chocolate@cpan.org>
@@ -290,12 +290,27 @@ static SV * autobox_method_common(pTHX_ SV * meth, U32* hashp) {
return NULL;
}
+static void autobox_cleanup(pTHX_ void * unused) {
+ PERL_UNUSED_VAR(unused); /* silence warning */
+
+ if (AUTOBOX_OP_MAP) {
+ PTABLE_free(AUTOBOX_OP_MAP);
+ AUTOBOX_OP_MAP = NULL;
+ }
+}
+
MODULE = autobox PACKAGE = autobox
PROTOTYPES: ENABLE
BOOT:
-AUTOBOX_OP_MAP = PTABLE_new(); if (!AUTOBOX_OP_MAP) Perl_croak(aTHX_ "Can't initialize op map");
+/* XXX the BOOT section extends to the next blank line, so don't add one for readability */
+AUTOBOX_OP_MAP = PTABLE_new();
+if (AUTOBOX_OP_MAP) {
+ Perl_call_atexit(aTHX_ autobox_cleanup, NULL);
+} else {
+ Perl_croak(aTHX_ "Can't initialize OP map");
+}
void
_enter()
@@ -335,17 +350,6 @@ _scope()
CODE:
XSRETURN_UV(PTR2UV(GvHV(PL_hintgv)));
-void
-END()
- PROTOTYPE:
- CODE:
- if (autobox_old_ck_subr) { /* make sure we got as far as initializing it */
- PL_check[OP_ENTERSUB] = autobox_old_ck_subr;
- }
-
- PTABLE_free(AUTOBOX_OP_MAP);
- AUTOBOX_OP_MAP = NULL;
-
MODULE = autobox PACKAGE = autobox::universal
SV *
@@ -11,7 +11,7 @@ use Scalar::Util;
use Scope::Guard;
use Storable;
-our $VERSION = '2.77';
+our $VERSION = '2.82';
XSLoader::load 'autobox', $VERSION;
@@ -80,7 +80,7 @@ sub _generate_class($) {
# rather than in the ISA hierarchy with its attendant AUTOLOAD-related overhead
if (@$isa == 1) {
my $class = $isa->[0];
- _make_class_accessor($class); # nop if it's already been universalized
+ _make_class_accessor($class); # NOP if it has already been added
return $class;
}
@@ -182,7 +182,8 @@ sub _expand_namespace($$) {
# enable some flavour of autoboxing in the current scope
sub import {
- my ($class, %args) = @_;
+ my $class = shift;
+ my %args = ((@_ == 1) && _isa($_[0], 'HASH')) ? %{shift()} : @_; # hash or hashref
my $debug = delete $args{DEBUG};
%args = %DEFAULT unless (%args); # wait till DEBUG has been deleted
@@ -219,7 +220,7 @@ sub import {
#
# undefs are winnowed out by _expand_namespace
- next if (@{$args{$type}});
+ next if (@{$args{$type}});
push @{$args{$type}}, map { _expand_namespace($_, $type) } @$default;
}
}
@@ -263,7 +264,7 @@ sub import {
Carp::confess("unrecognized option: '", (defined $type ? $type : '<undef>'), "'") unless ($TYPES{$type});
my (@isa, $class);
-
+
if ($class = $bindings->{$type}) {
@isa = $synthetic{$class} ? _get_isa($class) : ($class);
}
@@ -277,7 +278,7 @@ sub import {
# replace each array ref of classes with the name of the generated class.
# if there's only one class in the type's @ISA (e.g. SCALAR => 'MyScalar') then
# that class is used; otherwise a shim class whose @ISA contains the two or more classes
- # is created
+ # is created
for my $type (keys %$bindings) {
my $isa = $bindings->{$type};
@@ -287,7 +288,7 @@ sub import {
delete $bindings->{$type};
} else {
# associate the synthetic/single class with the specified type
- $bindings->{$type} = _generate_class($isa);
+ $bindings->{$type} = _generate_class($isa);
}
}
@@ -343,7 +344,7 @@ sub import {
# delete one or more bindings; if none remain, disable autobox in the current scope
#
# note: if bindings remain, we need to create a new hash (initially a clone of the current
-# hash) so that the previous hash (if any) is not contaminated by new deletions(s)
+# hash) so that the previous hash (if any) is not contaminated by new deletion(s)
#
# use autobox;
#
@@ -176,7 +176,7 @@ a method name or subroutine reference. Thus the following are all valid:
{ ... }->$method3();
sub { ... }->$method4();
-A native type is only asociated with a class if the type => class mapping
+A native type is only associated with a class if the type => class mapping
is supplied in the C<use autobox> statement. Thus the following will not work:
use autobox SCALAR => 'MyScalar';
@@ -218,11 +218,11 @@ piece of code won't trample over the same namespace/methods.
=head1 OPTIONS
A mapping from native types to their user-defined classes can be specified
-by passing a list of key/value pairs to the C<use autobox> statement.
+by passing a hashref or a list of key/value pairs to the C<use autobox> statement.
The following example shows the range of valid arguments:
- use autobox
+ use autobox {
SCALAR => 'MyScalar' # class name
ARRAY => 'MyNamespace::', # class prefix (ending in '::')
HASH => [ 'MyHash', 'MyNamespace::' ], # one or more class names and/or prefixes
@@ -234,7 +234,8 @@ The following example shows the range of valid arguments:
UNDEF => ..., # any of the 3 value types above
UNIVERSAL => ..., # any of the 3 value types above
DEFAULT => ..., # any of the 3 value types above
- DEBUG => ...; # boolean or coderef
+ DEBUG => ... # boolean or coderef
+ };
The INTEGER, FLOAT, NUMBER, STRING, SCALAR, ARRAY, HASH, CODE, UNDEF, DEFAULT and UNIVERSAL options can take
three different types of value:
@@ -485,10 +486,12 @@ translate C<use MyModule> into a bespoke C<use autobox> call. e.g.:
sub import {
my $class = shift;
- $class->SUPER::import(STRING => 'String::Trim::Scalar');
+ $class->SUPER::import(
+ STRING => 'String::Trim::String'
+ );
}
- package String::Trim::Scalar;
+ package String::Trim::String;
sub trim {
my $string = shift;
@@ -500,7 +503,7 @@ translate C<use MyModule> into a bespoke C<use autobox> call. e.g.:
1;
Note that C<trim> is defined in an auxiliary class rather than in C<String::Trim> itself to prevent
-C<String::Trim>'s own methods (i.e. the methods it inherits from C<autobox>) being exposed to SCALAR types.
+C<String::Trim>'s own methods (i.e. the methods it inherits from C<autobox>) being exposed to C<STRING> types.
This module can now be used without a C<use autobox> statement to enable the C<trim> method in the current
lexical scope. e.g.:
@@ -525,8 +528,8 @@ Note: C<autobox_class> should B<always> be used when calling these methods. The
these methods are called directly on the native type e.g.:
42->can('foo')
- 42->can('can')
- 42->can('autobox_class')
+ 42->isa('Bar')
+ 42->VERSION
- is undefined.
@@ -658,7 +661,7 @@ Note that the C<eval BLOCK> form works as expected:
=head1 VERSION
-2.77
+2.82
=head1 SEE ALSO
@@ -680,7 +683,7 @@ chocolateboy <chocolate@cpan.org>
=head1 COPYRIGHT
-Copyright (c) 2003-2012, chocolateboy.
+Copyright (c) 2003-2013, chocolateboy.
This module is free software. It may be used, redistributed
and/or modified under the same terms as Perl itself.
@@ -609,38 +609,6 @@ my $undef_error = qr{Can't call method "[^"]+" on an undefined value};
is($code->autobox_class->isa('UNKNOWN'), '', 'isa UNKNOWN: $code');
}
-# test VERSION
-
-=pod
-{
- use autobox;
-
- is (3->VERSION(), 0.01, 'can: integer literal');
- is ((-3)->VERSION(), 0.01, 'can: negative integer literal');
- is ((+3)->VERSION(), 0.01, 'can: positive integer literal');
- is ($int->VERSION(), 0.01, 'can: $integer');
-
- is (3.1415927->VERSION(), 0.01, 'can: float literal');
- is ((-3.1415927)->VERSION(), 0.01, 'can: negative float literal');
- is ((+3.1415927)->VERSION(), 0.01, 'can: positive float literal');
- is ($float->VERSION(), 0.01, 'can: $float');
-
- is ('Hello, world'->VERSION(), 0.01, 'can: single quoted string literal');
- is ("Hello, world"->VERSION(), 0.01, 'can: double quoted string literal');
- is ($string->VERSION(), 0.01, 'can: $string');
-
- is ([ 0 .. 9 ]->VERSION(), 0.01, 'can: ARRAY ref');
- is ($array->VERSION(), 0.01, 'can: $array');
-
- is ({ 0 .. 9 }->VERSION(), 0.01, 'can: HASH ref');
- is ($hash->VERSION(), 0.01, 'can: $hash');
-
- is ((\&add)->VERSION(), 0.01, 'can: CODE ref');
- is (sub { $_[0] + $_[1] }->VERSION(), 0.01, 'can: ANON sub');
- is ($code->VERSION(), 0.01, 'can: $code');
-}
-=cut
-
# test undef: by default, undef shouldn't be autoboxed...
{
use autobox;
@@ -103,7 +103,7 @@ like ($@, $ekeys, '%hash->keys fails before autobox is enabled');
# make sure it doesn't work when autobox is disabled
eval { @array->join(', ') };
- like ($@, $ejoin, '@array->join fails after is disabled');
+ like ($@, $ejoin, '@array->join fails after autobox is disabled');
eval { %hash->keys };
like ($@, $ekeys, '%hash->keys fails after autobox is disabled');
@@ -12,7 +12,7 @@ sub debug ($) { push @GOT, shift }
{
use autobox
DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyDefault' ],
@@ -29,8 +29,8 @@ sub debug ($) { push @GOT, shift }
{
use autobox
INTEGER => 'MyInteger',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyInteger', 'MyDefault' ],
@@ -47,8 +47,8 @@ sub debug ($) { push @GOT, shift }
{
use autobox
FLOAT => 'MyFloat',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyDefault' ],
@@ -65,8 +65,8 @@ sub debug ($) { push @GOT, shift }
{
use autobox
STRING => 'MyString',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyDefault' ],
@@ -83,8 +83,8 @@ sub debug ($) { push @GOT, shift }
{
use autobox
ARRAY => 'MyArray',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyDefault' ],
@@ -101,8 +101,8 @@ sub debug ($) { push @GOT, shift }
{
use autobox
HASH => 'MyHash',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyDefault' ],
@@ -119,8 +119,8 @@ sub debug ($) { push @GOT, shift }
{
use autobox
CODE => 'MyCode',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyDefault' ],
@@ -138,8 +138,8 @@ sub debug ($) { push @GOT, shift }
use autobox
INTEGER => 'MyInteger',
NUMBER => 'MyNumber',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyInteger', 'MyNumber', 'MyDefault' ],
@@ -158,8 +158,8 @@ sub debug ($) { push @GOT, shift }
INTEGER => 'MyInteger',
NUMBER => 'MyNumber',
SCALAR => 'MyScalar',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyInteger', 'MyNumber', 'MyScalar' ],
@@ -179,8 +179,8 @@ sub debug ($) { push @GOT, shift }
NUMBER => 'MyNumber',
SCALAR => 'MyScalar',
UNIVERSAL => 'MyUniversal',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyInteger', 'MyNumber', 'MyScalar', 'MyUniversal' ],
@@ -200,8 +200,8 @@ sub debug ($) { push @GOT, shift }
ARRAY => 'MyArray',
HASH => 'MyHash',
CODE => 'MyCode',
- DEFAULT => 'MyDefault',
- DEBUG => \&debug;
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug;
my $want = {
INTEGER => [ 'MyScalar' ],
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+
+# confirm that:
+#
+# use autobox { TYPE => 'Class', ... };
+#
+# works the same as:
+#
+# use autobox TYPE => 'Class', ...;
+#
+# Note: these are tested without hashrefs in t/default.t
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+my @GOT;
+
+sub debug ($) { push @GOT, shift }
+
+{
+ use autobox {
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug
+ };
+
+ my $want = {
+ INTEGER => [ 'MyDefault' ],
+ FLOAT => [ 'MyDefault' ],
+ STRING => [ 'MyDefault' ],
+ ARRAY => [ 'MyDefault' ],
+ HASH => [ 'MyDefault' ],
+ CODE => [ 'MyDefault' ]
+ };
+
+ is_deeply(shift(@GOT), $want);
+}
+
+{
+ use autobox {
+ SCALAR => 'MyScalar',
+ ARRAY => 'MyArray',
+ HASH => 'MyHash',
+ DEFAULT => 'MyDefault',
+ DEBUG => \&debug
+ };
+
+ my $want = {
+ INTEGER => [ 'MyScalar' ],
+ FLOAT => [ 'MyScalar' ],
+ STRING => [ 'MyScalar' ],
+ ARRAY => [ 'MyArray' ],
+ HASH => [ 'MyHash' ],
+ CODE => [ 'MyDefault' ]
+ };
+
+ is_deeply(shift(@GOT), $want);
+}
@@ -1,10 +0,0 @@
-eval "use Test::Pod";
-
-if ($@) {
- print "1..0 # Skip Test::Pod not installed", $/;
- exit;
-}
-
-my @PODS = qw#../blib#;
-
-all_pod_files_ok(all_pod_files(@PODS));
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use blib;
+
+# simplified version of the test case provided by Tomas Doran (t0m)
+# https://rt.cpan.org/Ticket/Display.html?id=71777
+
+# we need to do this manually.
+# schwern++: http://www.nntp.perl.org/group/perl.qa/2013/01/msg13351.html
+print '1..1', $/;
+
+{
+ package Foo;
+ use autobox;
+ sub DESTROY {
+ # confirm a method compiled under "use autobox" doesn't segfault when
+ # called during global destruction. the "Can't call method" error is
+ # raised by perl's method call function (pp_method_named), which means
+ # our version correctly delegated to it, which means our version didn't
+ # segfault by trying to access the pointer table after it's been freed
+ eval { undef->bar };
+
+ if ($@ =~ /Can't call method "bar" on an undefined value/) {
+ print 'ok 1', $/;
+ } else { # if it doesn't work, we won't get here
+ print 'not ok 1', $/;
+ }
+ }
+}
+
+{
+ package Bar;
+ sub unused { }
+}
+
+my $bar = bless {}, 'Bar';
+my $foo = bless {}, 'Foo';
+
+$foo->{bar} = $bar;
+$bar->{foo} = $foo;
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+
+# Thanks to Tokuhiro Matsuno for the test case and patch
+# https://rt.cpan.org/Ticket/Display.html?id=80400
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+my $X;
+
+END { $X->() }
+
+use autobox INTEGER => __PACKAGE__;
+
+sub test {
+ is_deeply(\@_, [ 1, 42 ], 'autoboxed method called in END block');
+};
+
+$X = sub { 1->test(42) };