Permalink
Browse files

import autobox 2.51 from CPAN

git-cpan-module:   autobox
git-cpan-version:  2.51
git-cpan-authorid: CHOCOLATE
git-cpan-file:     authors/id/C/CH/CHOCOLATE/autobox-2.51.tar.gz
  • Loading branch information...
1 parent 9e9c004 commit 7857aff26a3529bcbe05b056cd97f1337e2841b7 @chocolateboy committed May 20, 2008
Showing with 125 additions and 39 deletions.
  1. +6 −0 Changes
  2. +1 −0 MANIFEST
  3. +1 −1 META.yml
  4. +1 −1 README
  5. +12 −12 autobox.pm
  6. +40 −15 autobox.pod
  7. +25 −5 autobox.xs
  8. +4 −5 t/scalar.t
  9. +35 −0 t/type.t
View
@@ -1,5 +1,11 @@
Revision history for Perl extension autobox
+2.51 Tue May 20 10:40:32 2008
+ - fix type identification for former INTEGERs and FLOATs (thanks Mitchell N Charity)
+ - added type.t
+ - fix for perl 5.11 (thanks Andreas Koenig)
+ - document eval EXPR gotcha
+
2.50 Mon May 19 17:39:22 2008
- add support for INTEGER, FLOAT, NUMBER and STRING
- added scalar.t
View
@@ -19,4 +19,5 @@ t/merge.t
t/name.t
t/pod.t
t/scalar.t
+t/type.t
t/unmerge.t
View
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: autobox
-version: 2.50
+version: 2.51
abstract: call methods on native types
license: perl
author:
View
2 README
@@ -1,4 +1,4 @@
-autobox version 2.50
+autobox version 2.51
====================
The autobox pragma allows methods to be called on integers, floats, strings, arrays,
View
@@ -11,7 +11,7 @@ use Scalar::Util;
use Scope::Guard;
use Storable;
-our $VERSION = '2.50';
+our $VERSION = '2.51';
XSLoader::load 'autobox', $VERSION;
@@ -121,7 +121,7 @@ sub _get_isa($) {
# but that requires each (frozen) hash to be cached; at best, it may not be much of a win, and at
# worst it will increase bloat
-sub _register ($) {
+sub _install ($) {
my $bindings = shift;
$^H{autobox} = $bindings;
$BINDINGS_CACHE->{$bindings} = $bindings; # keep the $bindings hash alive
@@ -168,7 +168,7 @@ sub defaults {
return {
ARRAY => 'ARRAY',
CODE => 'CODE',
- DEFAULT => undef, # virtual
+ DEFAULT => undef,
FLOAT => undef,
HASH => 'HASH',
INTEGER => undef,
@@ -283,7 +283,7 @@ sub import {
$value = [ $value ] unless (_isa($value, 'ARRAY'));
- # delete empty arrays; empty arrays e.g. use autobox SCALAR => []
+ # delete empty arrays e.g. use autobox SCALAR => []
if (@$value == 0) {
delete $bindings->{$type};
} else {
@@ -304,11 +304,11 @@ sub import {
}
# install the specified bindings in the current scope
- _register($bindings);
+ _install($bindings);
# this is %^H as an integer - it changes as scopes are entered/exited
# we don't need to stack/unstack it in %^H as %^H itself takes care of that
- # note: we need to call this *after* %^H is referenced, and possibly created, above
+ # note: we need to call this *after* %^H is referenced (and possibly created) above
my $scope = autobox::scope();
my $old_scope = exists($^H{autobox_scope})? $^H{autobox_scope} : 0;
my $new_scope; # is this a new (top-level or nested) scope?
@@ -327,11 +327,11 @@ sub import {
# This sub is called when this scope's $^H{autobox_leavescope} is deleted, usually when
# %^H is destroyed at the end of the scope, but possibly directly in unimport()
#
- # autobox::enterscope splices in the autobox method call checker and method call op if they're not already
- # active
+ # autobox::enterscope splices in the autobox method call checker and method call op
+ # if they're not already active
#
- # autobox::leavescope performs the necessary housekeeping to ensure that the default checker and op are restored
- # when autobox is no longer in scope
+ # autobox::leavescope performs the necessary housekeeping to ensure that the default
+ # checker and op are restored when autobox is no longer in scope
my $leave_scope = sub {
autobox::leavescope();
@@ -345,7 +345,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 (a clone of the current
+# 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)
#
# use autobox;
@@ -394,7 +394,7 @@ sub unimport {
}
if (%$bindings) {
- _register($bindings);
+ _install($bindings);
} else { # remove all traces of autobox from the current scope
$^H &= ~0x120000; # unset HINT_LOCALIZE_HH + the additional bit
delete $^H{autobox};
View
@@ -19,10 +19,6 @@ autobox - call methods on native types
# strings
my @list = 'SELECT * FROM foo'->list();
-
- my $word = 'rubicund';
- my $links = $word->google();
-
my $greeting = "Hello, world!"->upper(); # "HELLO, WORLD!"
$greeting->for_each(\&character_handler);
@@ -219,7 +215,7 @@ This facilitates one-liners and prototypes:
However, using these default bindings is not recommended as there's no guarantee that another
piece of code won't trample over the same namespace/methods.
-=head2 Options
+=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.
@@ -289,9 +285,9 @@ specified type.
=back
-=head3 VIRTUAL TYPES
+=head2 Virtual Types
-Rather than representing native types, the NUMBER and SCALAR keys function as macros or shortcuts which
+Rather than representing native types, the NUMBER and SCALAR options function as macros or shortcuts which
create bindings for their scalar subtypes (INTEGER, FLOAT and STRING).
Thus:
@@ -332,13 +328,13 @@ For instance:
NUMBER => 'MyNumber',
SCALAR => 'MyScalar';
-would result in the methods on the left being looked up (in order) in the classes on the right.
+would result in the methods on the left being looked up (in order) in the classes on the right:
42->foo -> [ MyInteger, MyNumber, MyScalar ]
3.1415927->bar -> [ MyNumber, MyScalar ]
"Hello, world!->baz -> [ MyScalar ]
-=head3 UNDEF
+=head2 UNDEF
The pseudotype, UNDEF, can be used to autobox undefined values. These are
not autoboxed by default.
@@ -361,7 +357,7 @@ So does this:
undef->foo(); # ok
-=head3 DEBUG
+=head2 DEBUG
DEBUG exposes the current bindings for the scope in which C<use autobox> is called by means of a callback, or a
static debugging function.
@@ -496,16 +492,14 @@ The C<defaults> method can also be used to enable autoboxing for new types such
=head2 type
-This method returns the type of its operand within autobox (which is essentially longhand for the type names
+This method returns the type of its argument within autobox (which is essentially longhand for the type names
used within perl). This value is used by autobox to associate a method invocant with its designated classes. e.g.
autobox->type("Hello, world!") # STRING
autobox->type(42) # INTEGER
autobox->type([ ]) # ARRAY
autobox->type(sub { }) # CODE
-&c.
-
=head1 CAVEATS
=head2 Performance
@@ -520,6 +514,8 @@ is slightly slower than the equivalent method call on a string-like object, and
=head2 Gotchas
+=head3 Precedence
+
Due to Perl's precedence rules, some autoboxed literals may need to be parenthesized:
For instance, while this works:
@@ -545,6 +541,8 @@ The same applies for signed integer and float literals:
# this works
my $range = (-10)->to(10);
+=head3 print BLOCK
+
Perl's special-casing for the C<print BLOCK ...> syntax (see L<perlsub>) means that C<print { expression() } ...>
(where the curly brackets denote an anonymous HASH ref) may require some further disambiguation:
@@ -562,7 +560,7 @@ Perl's special-casing for the C<print BLOCK ...> syntax (see L<perlsub>) means t
In the latter case, the solution is to supply something
other than a HASH ref literal as the first argument
-to print():
+to C<print()>:
# e.g.
print STDOUT { @_ }->foo() ? 1 : 0;
@@ -580,6 +578,8 @@ to print():
# or even
{ @_ }->print_if_foo(1, 0);
+=head3 UNIVERSAL
+
Although C<can> and C<isa> are "overloaded" for autoboxed values, the C<VERSION> method isn't.
Thus, while these work:
@@ -612,10 +612,35 @@ Likewise, C<import> and C<unimport> are unaffected by the autobox pragma:
# error: Can't call method "import" on unblessed reference
[]->import()
+
+ autobox
+
+=head3 eval EXPR
+
+Like most pragmas autobox performs some of its operations at compile time, and,
+as a result, runtime string C<eval>s are not executed within its scope i.e. this
+doesn't work:
+
+ use autobox;
+
+ eval "42->foo";
+
+The workaround is to use autobox within the C<eval> e.g.
+
+ eval <<'EOS';
+ use autobox;
+ 42->foo();
+ EOS
+
+Note that the C<eval BLOCK> form works as expected:
+
+ use autobox;
+
+ eval { 42->foo() } # OK
=head1 VERSION
-2.50
+2.51
=head1 SEE ALSO
View
@@ -67,7 +67,7 @@ OP * autobox_ck_subr(pTHX_ OP *o) {
* are to copies (since the keys are just strings rather than full-fledged scalars).
*
* we don't want that (it results in the receiver being a reference to the last element
- * of the list), so we toggle the parentheses off while creating the reference
+ * in the list), so we toggle the parentheses off while creating the reference
* then toggle them back on in case they're needed elsewhere
*
*/
@@ -145,12 +145,24 @@ static const char *autobox_type(pTHX_ SV * const sv, STRLEN *len) {
case SVt_NULL:
AUTOBOX_TYPE_RETURN("UNDEF");
case SVt_IV:
- case SVt_PVIV:
AUTOBOX_TYPE_RETURN("INTEGER");
+ case SVt_PVIV:
+ if (SvIOK(sv)) {
+ AUTOBOX_TYPE_RETURN("INTEGER");
+ } else {
+ AUTOBOX_TYPE_RETURN("STRING");
+ }
case SVt_NV:
- case SVt_PVNV:
AUTOBOX_TYPE_RETURN("FLOAT");
+ case SVt_PVNV:
+ if (SvNOK(sv)) {
+ AUTOBOX_TYPE_RETURN("FLOAT");
+ } else {
+ AUTOBOX_TYPE_RETURN("STRING");
+ }
+#ifdef SVt_RV /* no longer defined by default if PERL_CORE is defined */
case SVt_RV:
+#endif
case SVt_PV:
case SVt_PVMG:
#ifdef SvVOK
@@ -192,6 +204,10 @@ static const char *autobox_type(pTHX_ SV * const sv, STRLEN *len) {
#ifdef SVt_BIND
case SVt_BIND:
AUTOBOX_TYPE_RETURN("BIND");
+#endif
+#ifdef SVt_REGEXP
+ case SVt_REGEXP:
+ AUTOBOX_TYPE_RETURN("REGEXP");
#endif
default:
AUTOBOX_TYPE_RETURN("UNKNOWN");
@@ -325,7 +341,11 @@ scope()
SV *
type(SV * self, SV * sv)
CODE:
- (void)(self); /* silence unused var warnings */
- RETVAL = newSVpv(autobox_type(aTHX_ (SvROK(sv) ? SvRV(sv) : sv), &PL_na), 0);
+ (void)(self); /* silence unused var warning */
+ if (sv) {
+ RETVAL = newSVpv(autobox_type(aTHX_ (SvROK(sv) ? SvRV(sv) : sv), &PL_na), 0);
+ } else {
+ RETVAL = newSVpv("UNDEF", 0);
+ }
OUTPUT:
RETVAL
View
@@ -3,7 +3,6 @@
use strict;
use warnings;
-use blib;
use Test::More tests => 60;
sub INTEGER::inc { $_[0] + 1 }
@@ -16,7 +15,6 @@ my $integer = 42;
my $float = 3.1415927;
my $string = 'Hello';
my $einc = qr{Can't call method "inc" without a package or object reference\b};
-my $ekeys = qr{Can't call method "keys" without a package or object reference\b};
my $einc2 = qr{Can't locate object method "inc" via package "Hello"};
{
@@ -146,6 +144,7 @@ my $einc2 = qr{Can't locate object method "inc" via package "Hello"};
eval { $string->inc };
like ($@, $einc2, '$string->inc');
+
is (42->inc, 43, '42->inc');
is ($integer->inc, 43, '$integer->inc');
is (3.1415927->inc, 4.1415927, '3.1415927->inc');
@@ -156,9 +155,6 @@ my $einc2 = qr{Can't locate object method "inc" via package "Hello"};
use autobox SCALAR => 'SCALAR';
no autobox qw(NUMBER);
- is ("Hello"->inc, "Hellp", '"Hello"->inc');
- is ($string->inc, "Hellp", '$string->inc');
-
eval { 42->inc };
like ($@, $einc, '42->inc');
@@ -170,6 +166,9 @@ my $einc2 = qr{Can't locate object method "inc" via package "Hello"};
eval { $float->inc };
like ($@, $einc, '$float->inc');
+
+ is ("Hello"->inc, "Hellp", '"Hello"->inc');
+ is ($string->inc, "Hellp", '$string->inc');
}
{
Oops, something went wrong.

0 comments on commit 7857aff

Please sign in to comment.