X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Foverload.pm;h=e506a7c2d35787570e97255983edc61da8c4aecb;hb=7cb0cfe6b05b22a9c89198b7133aee5507599e8c;hp=838c91fcee0479881aaa7909c8958eb9e2d4b6ac;hpb=d1be9408a3c14848d30728674452e191ba5fffaa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/overload.pm b/lib/overload.pm index 838c91f..e506a7c 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -1,8 +1,6 @@ package overload; -our $VERSION = '1.00'; - -$overload::hint_bits = 0x20000; +our $VERSION = '1.09'; sub nil {} @@ -11,6 +9,7 @@ sub OVERLOAD { my %arg = @_; my ($sub, $fb); $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching. + $fb = ${$package . "::()"}; # preserve old fallback value RT#68196 *{$package . "::()"} = \&nil; # Make it findable via fetchmethod. for (keys %arg) { if ($_ eq 'fallback') { @@ -74,7 +73,13 @@ sub OverloadedStringify { sub Method { my $package = shift; - $package = ref $package if ref $package; + if(ref $package) { + local $@; + local $!; + require Scalar::Util; + $package = Scalar::Util::blessed($package); + return undef if !defined $package; + } #my $meth = $package->can('(' . shift); ov_method mycan($package, '(' . shift), $package; #return $meth if $meth ne \&nil; @@ -84,35 +89,41 @@ sub Method { sub AddrRef { my $package = ref $_[0]; return "$_[0]" unless $package; - bless $_[0], overload::Fake; # Non-overloaded package - my $str = "$_[0]"; - bless $_[0], $package; # Back - $package . substr $str, index $str, '='; -} -sub StrVal { - (OverloadedStringify($_[0]) or ref($_[0]) eq 'Regexp') ? - (AddrRef(shift)) : - "$_[0]"; + local $@; + local $!; + require Scalar::Util; + my $class = Scalar::Util::blessed($_[0]); + my $class_prefix = defined($class) ? "$class=" : ""; + my $type = Scalar::Util::reftype($_[0]); + my $addr = Scalar::Util::refaddr($_[0]); + return sprintf("$class_prefix$type(0x%x)", $addr); } +*StrVal = *AddrRef; + sub mycan { # Real can would leave stubs. my ($package, $meth) = @_; - return \*{$package . "::$meth"} if defined &{$package . "::$meth"}; - my $p; - foreach $p (@{$package . "::ISA"}) { - my $out = mycan($p, $meth); - return $out if $out; + + local $@; + local $!; + require mro; + + my $mro = mro::get_linear_isa($package); + foreach my $p (@$mro) { + my $fqmeth = $p . q{::} . $meth; + return \*{$fqmeth} if defined &{$fqmeth}; } + return undef; } %constants = ( - 'integer' => 0x1000, - 'float' => 0x2000, - 'binary' => 0x4000, - 'q' => 0x8000, - 'qr' => 0x10000, + 'integer' => 0x1000, # HINT_NEW_INTEGER + 'float' => 0x2000, # HINT_NEW_FLOAT + 'binary' => 0x4000, # HINT_NEW_BINARY + 'q' => 0x8000, # HINT_NEW_STRING + 'qr' => 0x10000, # HINT_NEW_RE ); %ops = ( with_assign => "+ - * / % ** << >> x .", @@ -120,13 +131,15 @@ sub mycan { # Real can would leave stubs. num_comparison => "< <= > >= == !=", '3way_comparison'=> "<=> cmp", str_comparison => "lt le gt ge eq ne", - binary => "& | ^", + binary => '& &= | |= ^ ^=', unary => "neg ! ~", mutators => '++ --', func => "atan2 cos sin exp abs log sqrt int", - conversion => 'bool "" 0+', + conversion => 'bool "" 0+ qr', iterators => '<>', + filetest => "-X", dereferencing => '${} @{} %{} &{} *{}', + matching => '~~', special => 'nomethod fallback ='); use warnings::register; @@ -140,7 +153,7 @@ sub constant { elsif (!exists $constants {$_ [0]}) { warnings::warnif ("`$_[0]' is not an overloadable type"); } - elsif (!ref $_ [1] || "$_[1]" !~ /CODE\(0x[\da-f]+\)$/) { + elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE\(0x[0-9a-f]+\)$/) { # Can't use C above as code references can be # blessed, and C would return the package the ref is blessed into. if (warnings::enabled) { @@ -150,7 +163,7 @@ sub constant { } else { $^H{$_[0]} = $_[1]; - $^H |= $constants{$_[0]} | $overload::hint_bits; + $^H |= $constants{$_[0]}; } shift, shift; } @@ -171,7 +184,7 @@ __END__ =head1 NAME -overload - Package for overloading perl operations +overload - Package for overloading Perl operations =head1 SYNOPSIS @@ -184,7 +197,7 @@ overload - Package for overloading perl operations ... package main; - $a = new SomeThing 57; + $a = SomeThing->new( 57 ); $b=5+$a; ... if (overload::Overloaded $b) {...} @@ -193,6 +206,9 @@ overload - Package for overloading perl operations =head1 DESCRIPTION +This pragma allows overloading of Perl's operators for a class. +To overload built-in functions, see L instead. + =head2 Declaration of overloaded functions The compilation directive @@ -333,9 +349,9 @@ The following symbols can be specified in C directive: "**", "**=", "<<", "<<=", ">>", ">>=", "x", "x=", ".", ".=", For these operations a substituted non-assignment variant can be called if -the assignment variant is not available. Methods for operations "C<+>", -"C<->", "C<+=>", and "C<-=>" can be called to automatically generate -increment and decrement methods. The operation "C<->" can be used to +the assignment variant is not available. Methods for operations C<+>, +C<->, C<+=>, and C<-=> can be called to automatically generate +increment and decrement methods. The operation C<-> can be used to autogenerate missing methods for unary minus or C. See L<"MAGIC AUTOGENERATION">, L<"Calling Conventions for Mutators"> and @@ -353,12 +369,16 @@ arrays, C is used to compare values subject to C. =item * I - "&", "^", "|", "neg", "!", "~", + "&", "&=", "^", "^=", "|", "|=", "neg", "!", "~", -"C" stands for unary minus. If the method for C is not +C stands for unary minus. If the method for C is not specified, it can be autogenerated using the method for -subtraction. If the method for "C" is not specified, it can be -autogenerated using the methods for "C", or "C<\"\">", or "C<0+>". +subtraction. If the method for C is not specified, it can be +autogenerated using the methods for C, or C<"">, or C<0+>. + +The same remarks in L<"Arithmetic operations"> about +assignment-variants and autogeneration apply for +bit operations C<"&">, C<"^">, and C<"|"> as well. =item * I @@ -380,15 +400,20 @@ floating-point-like types one should follow the same semantic. If C is unavailable, it can be autogenerated using the overloading of C<0+>. -=item * I +=item * I + + 'bool', '""', '0+', 'qr' - "bool", "\"\"", "0+", +If one or two of these operations are not overloaded, the remaining ones +can be used instead. C is used in the flow control operators +(like C) and for the ternary C operation; C is used for +the RHS of C<=~> and when an object is interpolated into a regexp. -If one or two of these operations are not overloaded, the remaining ones can -be used instead. C is used in the flow control operators -(like C) and for the ternary "C" operation. These functions can -return any arbitrary Perl value. If the corresponding operation for this value -is overloaded too, that operation will be called again with this value. +C, C<"">, and C<0+> can return any arbitrary Perl value. If the +corresponding operation for this value is overloaded too, that operation +will be called again with this value. C must return a compiled +regexp, or a ref to a compiled regexp (such as C returns), and any +further overloading on the return value will be ignored. As a special case if the overload returns the object itself then it will be used directly. An overloaded conversion returning the object is @@ -404,6 +429,63 @@ glob (which may require a stringification). The same overloading happens both for the I syntax C$varE> and I syntax C${var}E>. +B Even in list context, the iterator is currently called only +once and with scalar context. + +=item * I + + "-X" + +This overload is used for all the filetest operators (C<-f>, C<-x> and +so on: see L for the full list). Even though these are +unary operators, the method will be called with a second argument which +is a single letter indicating which test was performed. Note that the +overload key is the literal string C<"-X">: you can't provide separate +overloads for the different tests. + +Calling an overloaded filetest operator does not affect the stat value +associated with the special filehandle C<_>. It still refers to the +result of the last C, C or unoverloaded filetest. + +If not overloaded, these operators will fall back to the default +behaviour even without C<< fallback => 1 >>. This means that if the +object is a blessed glob or blessed IO ref it will be treated as a +filehandle, otherwise string overloading will be invoked and the result +treated as a filename. + +This overload was introduced in perl 5.12. + +=item * I + +The key C<"~~"> allows you to override the smart matching logic used by +the C<~~> operator and the switch construct (C/C). See +L and L. + +Unusually, overloading of the smart match operator does not automatically +take precedence over normal smart match behaviour. In particular, in the +following code: + + package Foo; + use overload '~~' => 'match'; + + my $obj = Foo->new(); + $obj ~~ [ 1,2,3 ]; + +the smart match does I invoke the method call like this: + + $obj->match([1,2,3],0); + +rather, the smart match distributive rule takes precedence, so $obj is +smart matched against each array element in turn until a match is found, +so you may see between one and three of these calls instead: + + $obj->match(1,0); + $obj->match(2,0); + $obj->match(3,0); + +Consult the match table in L for +details of when overloading is invoked. + =item * I '${}', '@{}', '%{}', '&{}', '*{}'. @@ -420,7 +502,7 @@ The dereference operators must be specified explicitly they will not be passed t =item * I - "nomethod", "fallback", "=", + "nomethod", "fallback", "=". see L>. @@ -437,13 +519,15 @@ A computer-readable form of the above table is available in the hash num_comparison => '< <= > >= == !=', '3way_comparison'=> '<=> cmp', str_comparison => 'lt le gt ge eq ne', - binary => '& | ^', + binary => '& &= | |= ^ ^=', unary => 'neg ! ~', mutators => '++ --', func => 'atan2 cos sin exp abs log sqrt', - conversion => 'bool "" 0+', + conversion => 'bool "" 0+ qr', iterators => '<>', + filetest => '-X', dereferencing => '${} @{} %{} &{} *{}', + matching => '~~', special => 'nomethod fallback =' =head2 Inheritance and overloading @@ -570,7 +654,8 @@ appear as lvalue when the above code is executed. If the copy constructor is required during the execution of some mutator, but a method for C<'='> was not specified, it can be autogenerated as a -string copy if the object is a plain scalar. +string copy if the object is a plain scalar or a simple assignment if it +is not. =over 5 @@ -613,8 +698,8 @@ is not defined. =item I -String, numeric, and boolean conversion are calculated in terms of one -another if not all of them are defined. +String, numeric, boolean and regexp conversion are calculated in terms +of one another if not all of them are defined. =item I @@ -657,10 +742,28 @@ C=E> or C: =item I can be expressed in terms of an assignment to the dereferenced value, if this -value is a scalar and not a reference. +value is a scalar and not a reference, or simply a reference assignment +otherwise. =back +=head1 Minimal set of overloaded operations + +Since some operations can be automatically generated from others, there is +a minimal set of operations that need to be overloaded in order to have +the complete set of overloaded operations at one's disposal. +Of course, the autogenerated operations may not do exactly what the user +expects. See L above. The minimal set is: + + + - * / % ** << >> x + <=> cmp + & | ^ ~ + atan2 cos sin exp log sqrt int + +Additionally, you need to define at least one of string, boolean or +numeric conversions because any one can be used to emulate the others. +The string conversion can also be used to emulate concatenation. + =head1 Losing overloading The restriction for the comparison operation is that even if, for example, @@ -698,7 +801,10 @@ Package C provides the following public functions: =item overload::StrVal(arg) -Gives string value of C as in absence of stringify overloading. +Gives string value of C as in absence of stringify overloading. If you +are using this to get the address of a reference (useful for checking if two +references point to the same thing) then you may be better off using +C, which is faster. =item overload::Overloaded(arg) @@ -712,12 +818,12 @@ Returns C or a reference to the method that implements C. =head1 Overloading constants -For some application Perl parser mangles constants too much. It is possible -to hook into this process via overload::constant() and overload::remove_constant() -functions. +For some applications, the Perl parser mangles constants too much. +It is possible to hook into this process via C +and C functions. These functions take a hash as an argument. The recognized keys of this hash -are +are: =over 8 @@ -773,9 +879,6 @@ From these methods they may be called as overload::constant integer => sub {Math::BigInt->new(shift)}; } -B Currently overloaded-ness of constants does not propagate -into C. - =head1 IMPLEMENTATION What follows is subject to change RSN. @@ -861,7 +964,7 @@ If some mutator methods are directly applied to the overloaded values, one may need to I other values which references the same value: - $a = new Data 23; + $a = Data->new(23); ... $b = $a; # $b is "linked" to $a ... @@ -870,13 +973,13 @@ same value: Note that overloaded access makes this transparent: - $a = new Data 23; + $a = Data->new(23); $b = $a; # $b is "linked" to $a $a += 4; # would unlink $b automagically However, it would not make - $a = new Data 23; + $a = Data->new(23); $a = 4; # Now $a is a plain 4, not 'Data' preserve "objectness" of $a. But Perl I a way to make assignments @@ -906,7 +1009,7 @@ Put this in F in your Perl library directory: Use it as follows: require two_face; - my $seven = new two_face ("vii", 7); + my $seven = two_face->new("vii", 7); printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1; print "seven contains `i'\n" if $seven =~ /i/; @@ -919,10 +1022,7 @@ numeric value.) This prints: =head2 Two-face references Suppose you want to create an object which is accessible as both an -array reference and a hash reference, similar to the -L -builtin Perl type. Let's make it better than a pseudo-hash by -allowing index 0 to be treated as a normal element. +array reference and a hash reference. package two_refs; use overload '%{}' => \&gethash, '@{}' => sub { $ {shift()} }; @@ -956,7 +1056,7 @@ allowing index 0 to be treated as a normal element. Now one can access an object using both the array and hash syntax: - my $bar = new two_refs 3,4,5,6; + my $bar = two_refs->new(3,4,5,6); $bar->[2] = 11; $bar->{two} == 11 or die 'bad hash fetch'; @@ -1061,15 +1161,15 @@ This module is very unusual as overloaded modules go: it does not provide any usual overloaded operators, instead it provides the L operator C. In this example the corresponding subroutine returns an object which encapsulates operations done over -the objects: C contains C<['n', 3]>, C<2 + new -symbolic 3> contains C<['+', 2, ['n', 3]]>. +the objects: C<< symbolic->new(3) >> contains C<['n', 3]>, C<< 2 + +symbolic->new(3) >> contains C<['+', 2, ['n', 3]]>. Here is an example of the script which "calculates" the side of circumscribed octagon using the above package: require symbolic; my $iter = 1; # 2**($iter+2) = 8 - my $side = new symbolic 1; + my $side = symbolic->new(1); my $cnt = $iter; while ($cnt--) { @@ -1084,7 +1184,7 @@ The value of $side is Note that while we obtained this value using a nice little script, there is no simple way to I this value. In fact this value may -be inspected in debugger (see L), but ony if +be inspected in debugger (see L), but only if C Bption is set, and not via C

command. If one attempts to print this value, then the overloaded operator @@ -1193,8 +1293,8 @@ explicit recursion in num()? (Answer is at the end of this section.) Use this module like this: require symbolic; - my $iter = new symbolic 2; # 16-gon - my $side = new symbolic 1; + my $iter = symbolic->new(2); # 16-gon + my $side = symbolic->new(1); my $cnt = $iter; while ($cnt) { @@ -1314,8 +1414,8 @@ To see it in action, add a method to the package C. After this change one can do - my $a = new symbolic 3; - my $b = new symbolic 4; + my $a = symbolic->new(3); + my $b = symbolic->new(4); my $c = sqrt($a**2 + $b**2); and the numeric value of $c becomes 5. However, after calling @@ -1364,6 +1464,11 @@ and $b. Ilya Zakharevich EFE. +=head1 SEE ALSO + +The L pragma can be used to enable or disable overloaded +operations within a lexical scope. + =head1 DIAGNOSTICS When Perl is run with the B<-Do> switch or its equivalent, overloading