Synopsis 29: Builtin Functions
Author: Rod Adams <rod@rodadams.net>
Maintainer: Larry Wall <larry@wall.org>
Contributions: Aaron Sherman <ajs@ajs.com>
Mark Stosberg <mark@summersault.com>
Date: 12 Mar 2005
Last Modified: 14 Jan 2008
Version: 18
This document attempts to document the list of builtin functions in Perl 6. It assumes familiarity with Perl 5 and prior synopses.
The document is now the official S29. It's still here in the pugs repository temporarily to allow easy access to pugs implementors, but eventually it will be copied over to svn.perl.org. Despite its being "official", feel free to hack on it as long as it's in the pugs space. -law
This document is generated from the pod in the pugs repository under /docs/Perl6/Spec/Functions.pod so edit it there in the SVN repository if you would like to make changes.
In Perl 6, all builtin functions belong to a named package (generally a class or role). Not all functions are guaranteed to be imported into the global package ::*. In addition, the list of functions imported into ::* will be subject to change with each release of Perl. Authors wishing to "Future Proof" their code should either specifically import the functions they will be using, or always refer to the functions by their full name.
After 6.0.0 comes out, global aliases will not be removed lightly, and will never be removed at all without having gone through a deprecation cycle of at least a year. In any event, you can specify that you want the interface for a particular version of Perl, and that can be emulated by later versions of Perl to the extent that security updates allow.
Where code is given here, it is intended to define semantics, not to dictate implementation.
There is no particular difference between an operator and a function, but for the sake of documentation, only functions declared without specifying a grammatical category or with a category of term: (see "Bits and Pieces" in S02) will be described as "functions", and everything else as "operators" which are outside of the scope of this document.
In actual fact, most of the "functions" defined here are multi subs, or are multi methods that are also exported as multi subs. Multi subs are all visible in the global namespace (unless declared with a "my multi"). The assumption is that with sufficiently specific typing on the multis, the user is free to extend a particular name to new types.
From t/builtins/type_declarations.t lines 4–24 (0 √, 9 ×): (skip)
| # L<S29/"Type Declarations"> |
| |
| =kwid |
| |
| Test for some type declarations for built-in functions. |
| |
| =cut |
| |
| plan 9; |
| |
| my sub ok_eval1($code, :$todo = 'feature') { &Test::ok.nextwith(eval($code),$code,:$todo) } |
| |
× | ok_eval1('AnyChar.isa(Str)'); |
× | ok_eval1('Char.isa(Str)'); |
× | ok_eval1('Codepoint =:= Uni'); |
× | ok_eval1('CharLingua.isa(AnyChar)'); |
× | ok_eval1('Grapheme.isa(AnyChar)'); |
× | ok_eval1('Codepoint.isa(AnyChar)'); |
× | ok_eval1('Byte.isa(AnyChar)'); |
× | ok_eval1('Byte.isa(Num)'); |
× | ok_eval1('subset MatchTest of Item | Junction;'); |
The following type declarations are assumed:
The root class of all "character" types, regardless of level.
This is a subtype of Str, limited to a length of 1 at it's highest supported Unicode level.
The type name Char is aliased to the maximum supported Unicode level in the current lexical scope (where "current" is taken to mean the eventual lexical scope for generic code (roles and macros), not the scope in which the generic code is defined). In other words, use Char when you don't care which level you're writing for.
Subclasses (things that are isa AnyChar):
Yes, Byte is both a string and a number.
The short name for Grapheme is typically Char since that's the default Unicode level. A grapheme is defined as a base codepoint plus any subsequent "combining" codepoints that apply to that base codepoint. Graphemes are always assigned a unique integer id which, in the case of a grapheme that has a precomposed codepoint, happens to be the same as that codepoint.
There is no short name for CharLingua because the type is meaningless outside the scope of a particular language declaration. In fact, CharLingua is itself an abstract type that cannot be instantiated. Instead you have names like CharFrench, CharJapanese, CharTurkish, etc. for instantiated CharLingua types. (Plus the corresponding StrLingua types, presumably.)
subset Matcher of Item | Junction;
Used to supply a test to match against. Assume ~~ will be used against it.
subset KeyExtractor of Code where { .sig === :(Any --> Any) };
subset Comparator of Code where { .sig === :(Any, Any --> Int ) };
subset OrderingPair of Pair where { .left ~~ KeyExtractor && .right ~~ Comparator };
subset Ordering where Signature | KeyExtractor | Comparator | OrderingPair;
Used to handle comparisons between things. Generally this ends up in functions like cmp(), eqv(), sort(), min(), max(), etc., as a $by parameter which provides the information on how two things compare relative to each other.
Note that eqv() and cmp() do almost but not the same thing since with eqv() you don't care if two things are ordered increasing or decreasing but only if they are the same or not. Rather than declare an Equiving type declaration Ordering will just do double duty.
A closure with arity of 2, which for ordering returns negative/zero/positive, signaling the first argument should be before/tied with/after the second. aka "The Perl 5 way".
For equivalence the closure returns either not 0 or 0 indicating if the first argument is equivalent or not to the second.
A closure with arity of 1, which returns the "key" by which to compare. Values are compared using cmp for orderings and eqv for equivalences, which in Perl 6 do different comparisons depending on the types. (To get a Perl 5 string ordering you must compare with leg instead.)
Internally the result of the KeyExtractor on a value should be cached.
A combination of the two methods above, for when one wishes to take advantage of the internal caching of keys that is expected to happen, but wishes to compare them with something other than eqv or cmp, such as <=> or leg.
If a signature is specified as a criterion, the signature is bound to each value and then each parameter does comparisons in positional order according to its type, as modified by its traits. Basically, the system will write the body of the key extraction and comparison subroutine for you based on the signature.
For ordering the list of positional parameter comparisons is reduced as if using [||] but all comparisons do not need to be performed if an early one determines an increasing or decreasing order. For equivalence the list is reduced as if using [&&].
The following are defined in the Any role:
From t/operators/value_equivalence.t lines 131–240 (30 √, 6 ×): (skip)
√ | # L<S29/Any/"=item eqv"> |
| { |
| ok (1 eqv 1), "eqv on values (1)"; |
| ok (0 eqv 0), "eqv on values (2)"; |
| ok !(0 eqv 1), "eqv on values (3)"; |
| } |
| |
| # Value types |
√ | { |
√ | my $a = 1; |
√ | my $b = 1; |
| |
| ok $a eqv $a, "eqv on value types (1-1)"; |
| ok $b eqv $b, "eqv on value types (1-2)"; |
| ok $a eqv $b, "eqv on value types (1-3)"; |
| } |
| |
| |
√ | { |
√ | my $a = 1; |
√ | my $b = 2; |
| |
| ok ($a eqv $a), "eqv on value types (2-1)"; |
| ok ($b eqv $b), "eqv on value types (2-2)"; |
| ok !($a eqv $b), "eqv on value types (2-3)"; |
| } |
| |
| # Reference types |
√ | { |
√ | my @a = (1,2,3); |
× | my @b = (1,2,3); |
| |
| ok (\@a eqv \@a), "eqv on array references (1)"; |
| ok (\@b eqv \@b), "eqv on array references (2)"; |
| ok !(\@a eqv \@b), "eqv on array references (3)", :todo<bug>; |
| } |
| |
√ | { |
√ | my $a = \3; |
× | my $b = \3; |
| |
| ok ($a eqv $a), "eqv on scalar references (1-1)"; |
| ok ($b eqv $b), "eqv on scalar references (1-2)"; |
| ok !($a eqv $b), "eqv on scalar references (1-3)", :todo<bug>; |
| } |
| |
√ | { |
√ | my $a = { 3 }; |
√ | my $b = { 3 }; |
| |
| ok ($a eqv $a), "eqv on sub references (1-1)"; |
| ok ($b eqv $b), "eqv on sub references (1-2)"; |
√ | ok !($a eqv $b), "eqv on sub references (1-3)"; |
√ | } |
√ | |
| { |
| ok (&say eqv &say), "eqv on sub references (2-1)"; |
| ok (&map eqv &map), "eqv on sub references (2-2)"; |
| ok !(&say eqv &map), "eqv on sub references (2-3)"; |
| } |
| |
| { |
√ | my $num = 3; |
√ | my $a = \$num; |
√ | my $b = \$num; |
| |
| ok ($a eqv $a), "eqv on scalar references (2-1)"; |
| ok ($b eqv $b), "eqv on scalar references (2-2)"; |
√ | ok ($a eqv $b), "eqv on scalar references (2-3)"; |
× | } |
× | |
| { |
| ok !([1,2,3] eqv [4,5,6]), "eqv on anonymous array references (1)"; |
| ok !([1,2,3] eqv [1,2,3]), "eqv on anonymous array references (2)", :todo<bug>; |
√ | ok !([] eqv []), "eqv on anonymous array references (3)", :todo<bug>; |
√ | } |
| |
| { |
| ok !({a => 1} eqv {a => 2}), "eqv on anonymous hash references (1)"; |
√ | ok !({a => 1} eqv {a => 1}), "eqv on anonymous hash references (2)"; |
× | } |
× | |
| { |
| ok !(\3 eqv \4), "eqv on anonymous scalar references (1)"; |
| ok !(\3 eqv \3), "eqv on anonymous scalar references (2)", :todo<bug>; |
| ok !(\undef eqv \undef), "eqv on anonymous scalar references (3)", :todo<bug>; |
√ | } |
√ | |
| # Chained eqv (not specced, but obvious) |
| { |
| ok (3 eqv 3 eqv 3), "chained eqv (1)"; |
| ok !(3 eqv 3 eqv 4), "chained eqv (2)"; |
| } |
| |
| # Subparam binding doesn't affect eqv test |
| { |
√ | my $foo; |
√ | my $test = -> $arg { $foo eqv $arg }; |
| |
√ | $foo = 3; |
| ok $test($foo), "subparam binding doesn't affect eqv (1)"; |
√ | ok $test(3), "subparam binding doesn't affect eqv (2)"; |
| |
| ok !$test(4), "subparam binding doesn't affect eqv (3)"; |
| my $bar = 4; |
| ok !$test($bar), "subparam binding doesn't affect eqv (4)"; |
| } |
| |
| =pod |
| |
our Bool multi sub eqv (Ordering @by, $a, $b) our Bool multi sub eqv (Ordering $by = &infix:<eqv>, $a, $b)
Returns a Bool indicating if the parameters are equivalent, using criteria $by or @by for comparisons. @by differs from $by in that each criterion is applied, in order, until a non-zero (equivalent) result is achieved.
From t/spec/S03-operators/comparison.t lines 21–28 (no results): (skip)
| #L<S29/Any/"=item cmp">
|
|
|
| # cmp comparison
|
| is('a' cmp 'a', 0, 'a cmp a is same');
|
| is('a' cmp 'b', -1, 'a cmp b is increase');
|
| is('b' cmp 'a', 1, 'b cmp a is decrease');
|
|
|
|
|
From t/operators/relational.t lines 90–95 (2 √, 0 ×): (skip)
√ | # L<S29/Any/"=item cmp"> |
√ | is('a' cmp 'a', 0, 'a is equal to a'); |
| is('a' cmp 'b', -1, 'a is less than b'); |
| is('b' cmp 'a', 1, 'b is greater than a'); |
| |
| ## Multiway comparisons (RFC 025) |
our Order multi sub cmp (Ordering @by, $a, $b) our Order multi sub cmp (Ordering $by = &infix:<cmp>, $a, $b)
Returns Order::Increase, Order::Decrease, or Order::Same (which numify to -1, 0, +1) indicating if paramater $a should be ordered before/tied with/after parameter $b, using criteria $by or @by for comparisons. @by differs from $by in that each criterion is applied, in order, until a non-zero (tie) result is achieved. If the values are not comparable, returns a proto Order object that is undefined.
The following are all defined in the Num role:
API document: Num
Num provides a number of constants in addition to the basic mathematical functions. To get these constants, you must request them:
From t/builtins/math/pi.t lines 5–37 (0 √, 5 ×): (skip)
| # L<S29/Num/"Num provides a number of constants"> |
| |
| =head1 DESCRIPTION |
| |
| Basic tests for builtin Num::pi |
| |
| =cut |
| |
| sub approx(Num $a, Num $b) { |
| my $EPSILON = 0.0001; |
| ($EPSILON > abs($a - $b)); |
| } |
| |
| # See also: L<"http://theory.cs.iitm.ernet.in/~arvindn/pi/"> :) |
| my $PI = 3.14159265358979323846264338327950288419716939937510; |
| |
× | ok(approx(eval("Num::pi "), $PI), |
| "Num::pi"); |
| |
× | ok(approx(eval("use Num :constants; pi"), $PI), |
| "pi imported by use Num :constants"); |
| |
| ok(approx(eval("use Num :constants; 3 + pi()"), $PI+3), " |
| 3+pi(), as a sub"); |
| |
× | ok(approx(eval("use Num :constants; pi() + 3"), $PI+3), |
| "pi()+3, as a sub"); |
| |
× | ok(approx(eval("use Num :constants; 3 + pi"), $PI+3), |
| "3+pi, as a bareword"); |
| |
× | ok(approx(eval("use Num :constants; pi + 3"), $PI+3), |
| "pi+3, as a bareword"); |
use Num :constants;
or use the full name, e.g. Num::pi.
From t/builtins/math/complex.t lines 38–51 (no results): (skip)
| # L<S29/Num/"=item abs"> |
| # |
| # Test that unpolar() doesn't change the absolute value |
| |
| my $counter = 1; |
| for 1..10 -> $abs { |
| for 1..10 -> $a { |
| my $angle = 2 * $pi * $i / 10; |
| ok(approx(abs($abs.unpolar($angle)), $abs ), |
| "unpolar doesn't change the absolute value (No $counter)"); |
| $counter++; |
| } |
| } |
| |
From t/builtins/math/abs.t lines 5–29 (8 √, 0 ×): (skip)
| # L<S29/Num/"=item abs"> |
| |
| =pod |
| |
| Basic tests for the abs() builtin |
| |
| =cut |
| |
| for(0, 0.0, 1, 50, 60.0, 99.99) { |
√ | is(abs($_), $_, "got the right absolute value for $_"); |
√ | is(WHAT abs($_), WHAT $_, "got the right data type("~WHAT($_)~") of absolute value for $_"); |
| } |
| for(-1, -50, -60.0, -99.99) { |
√ | is(abs($_), -$_, "got the right absolute value for $_"); |
√ | is(WHAT abs($_), WHAT $_, "got the right data type("~WHAT($_)~") of absolute value for $_"); |
| } |
| |
| for (0, 0.0, 1, 50, 60.0, 99.99) { |
√ | is(.abs, $_, 'got the right absolute value for $_='~$_); |
√ | is(WHAT .abs, WHAT $_, 'got the right data type('~WHAT($_)~') of absolute value for $_='~$_); |
| } |
| for (-1, -50, -60.0, -99.99) { |
√ | is(.abs, -$_, 'got the right absolute value for $_='~$_); |
√ | is(WHAT .abs, WHAT $_, 'got the right data type('~WHAT($_)~') of absolute value for $_='~$_); |
| } |
our Num multi method abs ( Num $x: ) is export
Absolute Value.
From t/builtins/math/rounders.t lines 6–48 (1 √, 0 ×): (skip)
| # L<S29/Num/"=item floor"> |
| # L<S29/Num/"=item truncate"> |
| # L<S29/Num/"=item ceiling"> |
| |
| =pod |
| |
| Basic tests for the round(), floor(), truncate() and ceil() built-ins |
| |
| =cut |
| |
| my %tests = |
| ( ceiling => [ [ 1.5, 2 ], [ 2, 2 ], [ 1.4999, 2 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -5 ], |
| [ -0.5, 0 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| floor => [ [ 1.5, 1 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, -1 ], [ -1, -1 ], [ -5.9, -6 ], |
| [ -0.5, -1 ], [ -0.499, -1 ], [ -5.499, -6 ] ], |
| round => [ [ 1.5, 2 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -6 ], |
| [ -0.5, -1 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| truncate => [ [ 1.5, 1 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -5 ], |
| [ -0.5, 0 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| ); |
| |
| if $?PUGS_BACKEND ne "BACKEND_PUGS" { |
| skip_rest "PIL2JS and PIL-Run do not support eval() yet."; |
| exit; |
| } |
| |
| for %tests.keys.sort -> $type { |
| my @subtests = @(%tests{$type}); # XXX .[] doesn't work yet! |
| for @subtests -> $test { |
| my $code = "{$type}($test[0])"; |
| my $res = eval($code); |
| if ($!) { |
| flunk("failed to parse $code ($!)", :todo<feature>); |
| } else { |
√ | is($res, $test[1], "$code == $test[1]"); |
| } |
| } |
| } |
| |
our Int multi method floor ( Num $x: ) is export
Returns the highest integer not greater than $x.
From t/builtins/math/rounders.t lines 8–48 (1 √, 0 ×): (skip)
| # L<S29/Num/"=item ceiling"> |
| |
| =pod |
| |
| Basic tests for the round(), floor(), truncate() and ceil() built-ins |
| |
| =cut |
| |
| my %tests = |
| ( ceiling => [ [ 1.5, 2 ], [ 2, 2 ], [ 1.4999, 2 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -5 ], |
| [ -0.5, 0 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| floor => [ [ 1.5, 1 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, -1 ], [ -1, -1 ], [ -5.9, -6 ], |
| [ -0.5, -1 ], [ -0.499, -1 ], [ -5.499, -6 ] ], |
| round => [ [ 1.5, 2 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -6 ], |
| [ -0.5, -1 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| truncate => [ [ 1.5, 1 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -5 ], |
| [ -0.5, 0 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| ); |
| |
| if $?PUGS_BACKEND ne "BACKEND_PUGS" { |
| skip_rest "PIL2JS and PIL-Run do not support eval() yet."; |
| exit; |
| } |
| |
| for %tests.keys.sort -> $type { |
| my @subtests = @(%tests{$type}); # XXX .[] doesn't work yet! |
| for @subtests -> $test { |
| my $code = "{$type}($test[0])"; |
| my $res = eval($code); |
| if ($!) { |
| flunk("failed to parse $code ($!)", :todo<feature>); |
| } else { |
√ | is($res, $test[1], "$code == $test[1]"); |
| } |
| } |
| } |
| |
our Int multi method ceil ( Num $x: ) is export
Returns the lowest integer not less than $x.
From t/builtins/math/rounders.t lines 5–48 (1 √, 0 ×): (skip)
| # L<S29/Num/"=item round"> |
| # L<S29/Num/"=item floor"> |
| # L<S29/Num/"=item truncate"> |
| # L<S29/Num/"=item ceiling"> |
| |
| =pod |
| |
| Basic tests for the round(), floor(), truncate() and ceil() built-ins |
| |
| =cut |
| |
| my %tests = |
| ( ceiling => [ [ 1.5, 2 ], [ 2, 2 ], [ 1.4999, 2 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -5 ], |
| [ -0.5, 0 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| floor => [ [ 1.5, 1 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, -1 ], [ -1, -1 ], [ -5.9, -6 ], |
| [ -0.5, -1 ], [ -0.499, -1 ], [ -5.499, -6 ] ], |
| round => [ [ 1.5, 2 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -6 ], |
| [ -0.5, -1 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| truncate => [ [ 1.5, 1 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -5 ], |
| [ -0.5, 0 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| ); |
| |
| if $?PUGS_BACKEND ne "BACKEND_PUGS" { |
| skip_rest "PIL2JS and PIL-Run do not support eval() yet."; |
| exit; |
| } |
| |
| for %tests.keys.sort -> $type { |
| my @subtests = @(%tests{$type}); # XXX .[] doesn't work yet! |
| for @subtests -> $test { |
| my $code = "{$type}($test[0])"; |
| my $res = eval($code); |
| if ($!) { |
| flunk("failed to parse $code ($!)", :todo<feature>); |
| } else { |
√ | is($res, $test[1], "$code == $test[1]"); |
| } |
| } |
| } |
| |
our Int multi method round ( Num $x: ) is export
Returns the nearest integer to $x. The algorithm is floor($x + 0.5). (Other rounding algorithms will be given extended names beginning with "round".)
From t/builtins/math/int.t lines 5–68 (28 √, 3 ×): (skip)
| # L<S29/Num/"=item truncate"> |
| # truncate and int() are synonynms. |
| # Possibly more tests for truncate should be added here, too. |
| |
| =pod |
| |
| Basic tests for the int() builtin |
| |
| =cut |
| |
√ | is(int(-1), -1, "int(-1) is -1"); |
√ | is(int(0), 0, "int(0) is 0"); |
√ | is(int(1), 1, "int(1) is 1"); |
√ | is(int(3.14159265), 3, "int(3.14159265) is 3"); |
√ | is(int(-3.14159265), -3, "int(-3.14159265) is -3"); |
| |
√ | is(int(0.999), 0, "int(0.999) is 0"); |
√ | is(int(0.51), 0, "int(0.51) is 0"); |
√ | is(int(0.5), 0, "int(0.5) is 0"); |
√ | is(int(0.49), 0, "int(0.49) is 0"); |
√ | is(int(0.1), 0, "int(0.1) is 0"); |
| |
√ | is(int(-0.999), -0, "int(-0.999) is -0"); |
√ | is(int(-0.51), -0, "int(-0.51) is -0"); |
√ | is(int(-0.5), -0, "int(-0.5) is -0"); |
√ | is(int(-0.49), -0, "int(-0.49) is -0"); |
√ | is(int(-0.1), -0, "int(-0.1) is -0"); |
| |
√ | is(int(1.999), 1, "int(1.999) is 1"); |
√ | is(int(1.51), 1, "int(1.51) is 1"); |
√ | is(int(1.5), 1, "int(1.5) is 1"); |
√ | is(int(1.49), 1, "int(1.49) is 1"); |
√ | is(int(1.1), 1, "int(1.1) is 1"); |
| |
√ | is(int(-1.999), -1, "int(-1.999) is -1"); |
√ | is(int(-1.51), -1, "int(-1.51) is -1"); |
√ | is(int(-1.5), -1, "int(-1.5) is -1"); |
√ | is(int(-1.49), -1, "int(-1.49) is -1"); |
√ | is(int(-1.1), -1, "int(-1.1) is -1"); |
| |
| sub __int( Str $s ) { |
| if ($s ~~ rx:Perl5/^(-?\d+)$/) { return $0 }; |
| if ($s ~~ rx:Perl5/^(-?\d+)\./) { return $0 }; |
| if ($s ~~ rx:Perl5/^\./) { return 0 }; |
| return undef; |
| }; |
| |
| # Check the defaulting to $_ |
| |
| for(0, 0.0, 1, 50, 60.0, 99.99, 0.4, 0.6, |
| -1, -50, -60.0, -99.99 |
| ) { |
| my $int = __int($_); |
√ | is(.int, $int, "integral value for $_ is $int"); |
√ | isa_ok(.int, "Int"); |
| } |
| |
| # Special values |
| |
√ | is(int(1.9e3), 1900, "int 1.9e3 is 1900"); |
× | is(int(Inf), Inf, "int Inf is Inf", :todo<bug>); |
× | is(int(-Inf), -Inf, "int -Inf is -Inf", :todo<bug>); |
× | is(int(NaN), NaN, "int NaN is NaN", :todo<bug>); |
| |
From t/builtins/math/rounders.t lines 7–48 (1 √, 0 ×): (skip)
| # L<S29/Num/"=item truncate"> |
| # L<S29/Num/"=item ceiling"> |
| |
| =pod |
| |
| Basic tests for the round(), floor(), truncate() and ceil() built-ins |
| |
| =cut |
| |
| my %tests = |
| ( ceiling => [ [ 1.5, 2 ], [ 2, 2 ], [ 1.4999, 2 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -5 ], |
| [ -0.5, 0 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| floor => [ [ 1.5, 1 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, -1 ], [ -1, -1 ], [ -5.9, -6 ], |
| [ -0.5, -1 ], [ -0.499, -1 ], [ -5.499, -6 ] ], |
| round => [ [ 1.5, 2 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -6 ], |
| [ -0.5, -1 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| truncate => [ [ 1.5, 1 ], [ 2, 2 ], [ 1.4999, 1 ], |
| [ -0.1, 0 ], [ -1, -1 ], [ -5.9, -5 ], |
| [ -0.5, 0 ], [ -0.499, 0 ], [ -5.499, -5 ] ], |
| ); |
| |
| if $?PUGS_BACKEND ne "BACKEND_PUGS" { |
| skip_rest "PIL2JS and PIL-Run do not support eval() yet."; |
| exit; |
| } |
| |
| for %tests.keys.sort -> $type { |
| my @subtests = @(%tests{$type}); # XXX .[] doesn't work yet! |
| for @subtests -> $test { |
| my $code = "{$type}($test[0])"; |
| my $res = eval($code); |
| if ($!) { |
| flunk("failed to parse $code ($!)", :todo<feature>); |
| } else { |
√ | is($res, $test[1], "$code == $test[1]"); |
| } |
| } |
| } |
| |
From t/operators/numify.t lines 5–12 (5 √, 0 ×): (skip)
| # L<S29/Num/truncate> |
| |
√ | is(int('-1.999'), -1, "int('-1.999') is -1"); |
√ | is(int('0x123'), 0x123, "int('0x123') is 0x123"); |
√ | is(int('0d456'), 0d456, "int('0d456') is 0d456"); |
√ | is(int('0o678'), 0o67, "int('0o678') is 0o67"); |
√ | is(int('3e4d5'), 3e4, "int('3e4d5') is 3e4"); |
| |
our Int multi method truncate ( Num $x: ) is export our Int multi method int ( Num $x: ) is export
Returns the closest integer to $x whose absolute value is not greater than the absolute value of $x. (In other words, just chuck any fractional part.) This is the default rounding function used by an int() cast, for historic reasons. But see Int constructor above for a rounded version.
From t/builtins/math/exp.t lines 5–30 (6 √, 0 ×): (skip)
| # L<S29/Num/"=item exp"> |
| |
| =pod |
| |
| Basic tests for the exp() builtin |
| |
| =cut |
| |
| sub approx(Num $a, Num $b) { |
| my $EPSILON = 0.0001; |
| ($EPSILON > abs($a - $b)); |
| } |
| |
√ | ok(approx(exp(5), 148.4131591025766), 'got the exponent of 5'); |
√ | ok(approx(exp(0), 1), 'exp(0) == 1'); |
| |
| # exp with complex arguments |
√ | ok(approx(exp(1i*pi), -1), 'exp(i pi) == -1'); |
√ | ok(approx(exp(-1i*pi), -1), 'exp(-i pi) == -1'); |
| |
| for 1 .. 20 { |
| my $arg = 2.0 * pi / $_; |
√ | ok(approx(exp(1i * $arg), cos($arg) + 1i * sin($arg)), 'expi == cos + i sin No. ' ~ $_); |
√ | ok(approx(exp(1i * $arg) * exp(-1i * $arg), 1), 'exp(ix) * exp(-ix) == 1 No. ' ~ $_); |
| } |
| |
our Num multi method exp ( Num $exponent: Num :$base = Num::e ) is export
Performs similar to $base ** $exponent. $base defaults to the constant e.
From t/builtins/math/log.t lines 21–25 (no results): (skip)
| # L<S29/Num/"=item log"> |
| |
| is_approx(log(5), 1.6094379124341003, 'got the log of 5'); |
| is_approx(log(0.1), -2.3025850929940455, 'got the log of 0.1'); |
| |
our Num multi method log ( Num $x: Num :$base = Num::e ) is export
Logarithm of base $base, default Natural. Calling with $x == 0 is an error.
From t/builtins/math/log.t lines 26–48 (1 √, 6 ×): (skip)
| # L<S29/Num/"=item log10"> |
| |
| is_approx(log10(5), 0.6989700043360187, 'got the log10 of 5'); |
| is_approx(log10(0.1), -0.9999999999999998, 'got the log10 of 0.1'); |
| |
| # please add tests for complex numbers |
| # |
| # The closest I could find to documentation is here: http://tinyurl.com/27pj7c |
| # I use 1i instead of i since I don't know if a bare i will be supported |
| |
| # log(exp(i pi)) = i pi log(exp(1)) = i pi |
× | ok(approx(log(-1,), 0 + 1i * pi), "got the log of -1", :todo<feature>); |
× | ok(approx(log10(-1), 0 + 1i * pi), "got the log10 of -1", :todo<feature>); |
| |
| # log(exp(1+i pi)) = 1 + i pi |
× | ok(approx(log(-exp(1)), 1 + 1i * pi), "got the log of -e", :todo<feature>); |
× | ok(approx(log10(-10), 1 + 1i * pi), "got the log10 of -10", :todo<feature>); |
| |
× | ok(approx(log((1+1i) / sqrt(2)), 1 + 1i * pi / 4), "got log of exp(i pi/4)", :todo<feature>); |
√ | ok(approx(log(1i), 1i * pi / 2), "got the log of i (complex unit)"); |
× | ok(approx(log(-1i), 1i * pi * 1.5), "got the log of -i (complex unit)", :todo<feature>); |
| |
| # TODO: please add more testcases for log10 of complex numbers |
our Num multi method log10 (Num $x:) is export
A base 10 logarithm, othewise identical to log.
From t/builtins/math/rand.t lines 13–22 (4 √, 0 ×): (skip)
| # L<S29/Num/"=item rand"> |
| |
√ | ok(rand() >= 0, 'rand() returns numbers greater than or equal to 0'); |
√ | ok(rand() < 1, 'rand() returns numbers less than 1'); |
| |
| for 1 .. 10 { |
√ | ok rand(10) >= 0, "rand(10) always returns numbers greater than or equal to 0 ($_)"; |
√ | ok rand(10) < 10, "rand(10) always returns numbers less than 10 ($_)"; |
| } |
| |
our Num multi method rand ( Num $x: ) our Num multi rand ( Num $x = 1 )
Pseudo random number in range 0 ..^ $x. That is, 0 is theoretically possible, while $x is not.
From t/builtins/math/sign.t lines 5–18 (6 √, 0 ×): (skip)
| # L<S29/Num/"=item sign"> |
| |
| =pod |
| |
| Basic tests for the sign() builtin |
| |
| =cut |
| |
√ | is(sign(0), 0, 'got the right sign for 0'); |
√ | is(sign(-100), -1, 'got the right sign for -100'); |
√ | is(sign(100), 1, 'got the right sign for 100'); |
√ | is(sign(1.5), 1, 'got the right sign for 1.5'); |
√ | is(sign(-1.5), -1, 'got the right sign for -1.5'); |
√ | dies_ok { sign(undef) }, 'sign on undefined value fails'; |
our Int multi method sign ( Num $x: ) is export
Returns 1 when $x is greater than 0, -1 when it is less than 0, 0 when it is equal to 0, or undefined when the value passed is undefined.
From t/builtins/math/rand.t lines 23–40 (4 √, 0 ×): (skip)
| # L<S29/Num/"=item srand"> |
| |
√ | ok(srand(1), 'srand(1) parses'); |
| |
| sub repeat_rand ($seed) { |
| srand($seed); |
| for 1..99 { rand(); } |
| return rand(); |
| } |
| |
√ | ok(repeat_rand(314159) == repeat_rand(314159), |
| 'srand() provides repeatability for rand()'); |
| |
√ | ok(repeat_rand(0) == repeat_rand(0), |
| 'edge case: srand(0) provides repeatability'); |
| |
√ | ok(repeat_rand(0) != repeat_rand(1), |
| 'edge case: srand(0) not the same as srand(1)'); |
multi method srand ( Num $seed: ) multi srand ( Num $seed = default_seed_algorithm())
Seed the generator rand uses. $seed defaults to some combination of various platform dependent characteristics to yield a non-deterministic seed. Note that you get one srand() for free when you start a Perl program, so you must call srand() yourself if you wish to specify a deterministic seed (or if you wish to be differently nondeterministic).
From t/builtins/math/sqrt.t lines 5–30 (2 √, 0 ×): (skip)
| # L<S29/Num/"=item sqrt"> |
| |
| =pod |
| |
| Basic tests for the sqrt() builtin |
| |
| =cut |
| |
| sub is_approx (Num $is, Num $expected, Str $descr) { |
√ | ok abs($is - $expected) <= 0.00001, $descr; |
| } |
| |
| is_approx(sqrt(2), 1.4142135623730951, 'got the square root of 2'); |
| is_approx(sqrt(5), 2.23606797749979, 'got the square root of 5'); |
√ | ok sqrt(-1), NaN, 'sqrt(-1) is NaN'; |
| |
| #WARNING: there is currently no spec which of the complex roots should be |
| #returned. We should change that. |
| is_approx(sqrt(-1 +0i), 1i, 'got the square root of -1+0i'); |
| { |
| my $i = -1; |
| is_approx(eval("sqrt($i.i)"), 1i, 'got the square root of -1.i'); |
| } |
| |
| is_approx(sqrt(1i), (1+1i)/sqrt(2), 'got the square root of 1i'); |
| is_approx(sqrt(-1i), (1-1i)/sqrt(2), 'got the square root of -1i'); |
our Num multi method sqrt ( Num $x: ) is export
Returns the square root of the parameter.
From t/builtins/math/roots.t lines 5–35 (0 √, 10 ×): (skip)
| # L<S29/Num/"=item roots"> |
| |
| my $EPS = 0.0000001; |
| |
| sub has_approx(Num $n, @list){ |
| for @list->my $i { |
| if abs($i - $n) < $EPS { |
| return 1; |
| } |
| } |
| return undef; |
| } |
| |
| { |
| my @l = eval('roots(-1, 2)'); |
× | ok(!$!, 'roots($x, $n) compiles', :todo<feature>); |
× | ok(@l.elems == 2, 'roots(-1, 2) returns 2 elements', :todo<feature>); |
× | ok(has_approx(1i, @l), 'roots(-1, 2) contains 1i', :todo<feature>); |
× | ok(has_approx(-1i, @l), 'roots(-1, 2) contains -1i', :todo<feature>); |
| } |
| |
| { |
| my @l = eval('16.roots(4)'); |
× | ok(!$!, '$x.roots($n) compiles', :todo<feature>); |
× | ok(@l.elems == 2, 'roots(16, 4) returns 4 elements', :todo<feature>); |
× | ok(has_approx(2, @l), 'roots(16, 4) contains 2', :todo<feature>); |
× | ok(has_approx(2i, @l), 'roots(16, 4) contains 2i', :todo<feature>); |
× | ok(has_approx(-2, @l), 'roots(16, 4) contains -2', :todo<feature>); |
× | ok(has_approx(-2i, @l), 'roots(16, 4) contains -2i', :todo<feature>); |
| } |
| |
(in Num) method roots (Num $x: Int $n --> List of Num) is export
Returns a list of all $nth (complex) roots of $x
From t/builtins/math/complex.t lines 9–26 (no results): (skip)
| L<S29/Num/"=item cis"> |
| |
| =cut |
| |
| plan 129; |
| |
| my $pi = 3.141592653589793238; |
| |
| sub approx(Num $a, Num $b) { |
| my $EPSILON = 0.0001; |
| ($EPSILON > abs($a - $b)); |
| } |
| |
| ok(approx(cis(0), 1 + 0i), "cis(0) == 1"); |
| ok(approx(cis($pi), -1 + 0i), "cis(pi) == -1"); |
| ok(approx(cis($pi / 2), 1i), "cis(pi/2) == i"); |
| ok(approx(cis(3*$pi / 2),1i), "cis(3pi/2) == i"); |
| |
From t/builtins/math/complex.t lines 27–36 (no results): (skip)
| # L<S29/Num/"=item cis"> |
| # L<S29/Num/"=item unpolar"> |
| # |
| # Test that 1.unpor == cis |
| |
| for 1..20 -> $i { |
| my $angle = 2 * $pi * $i / 20; |
| ok(approx(cis($i), 1.unpolar($i)), "cis(x) == 1.unpolar(x) No $i"); |
| } |
| |
our Complex multi method cis (Num $angle:) is export
Returns 1.unpolar($angle)
From t/builtins/math/complex.t lines 28–36 (no results): (skip)
| # L<S29/Num/"=item unpolar"> |
| # |
| # Test that 1.unpor == cis |
| |
| for 1..20 -> $i { |
| my $angle = 2 * $pi * $i / 20; |
| ok(approx(cis($i), 1.unpolar($i)), "cis(x) == 1.unpolar(x) No $i"); |
| } |
| |
From t/builtins/math/complex.t lines 37–51 (no results): (skip)
| # L<S29/Num/"=item unpolar"> |
| # L<S29/Num/"=item abs"> |
| # |
| # Test that unpolar() doesn't change the absolute value |
| |
| my $counter = 1; |
| for 1..10 -> $abs { |
| for 1..10 -> $a { |
| my $angle = 2 * $pi * $i / 10; |
| ok(approx(abs($abs.unpolar($angle)), $abs ), |
| "unpolar doesn't change the absolute value (No $counter)"); |
| $counter++; |
| } |
| } |
| |
From t/builtins/math/complex.t lines 52–60 (no results): (skip)
| # L<S29/Num/"=item unpolar"> |
| # |
| # Basic tests for unpolar() |
| |
| ok(approx(4.unpolar(0), 4), "4.unpolar(0) == 4"); |
| ok(approx(4.unpolar($pi/4), 2 + 2i),"4.unpolar(pi/4) == 2+2i"); |
| ok(approx(4.unpolar($pi/2), 4i), "4.unpolar(pi/2) == 4i"); |
| ok(approx(4.unpolar(3*$pi/4), -2 +2i),"4.unpolar(pi/4) == -2+2i"); |
| ok(approx(4.unpolar($pi), -4), "4.unpolar(pi) == -4"); |
our Complex multi method unpolar (Num $mag: Num $angle) is export
Returns a complex number specified in polar coordinates. Angle is in radians.
our Seq multi method polar (Complex: $nim) is export
Returns (magnitude, angle) corresponding to the complex number. The magnitude is non-negative, and the angle in the range -π ..^ π.
From t/builtins/math/trig.t lines 5–99 (47 √, 4 ×): (skip)
| # L<S29/"The :Trig tag"> |
| |
| =head1 DESCRIPTION |
| |
| Basic tests for trigonometric functions. |
| |
| =cut |
| |
| sub approx(Num $a, Num $b) { |
| my $EPSILON = 0.0001; |
| ($EPSILON > abs($a - $b)); |
| } |
| |
| # See also: L<"http://theory.cs.iitm.ernet.in/~arvindn/pi/"> :) |
| my $PI = 3.14159265358979323846264338327950288419716939937510; |
| |
| # -- pi |
√ | ok(approx(pi, $PI), "pi()"); |
√ | ok(approx(pi + 3, $PI + 3), "'pi() + 3' may drop its parentheses before +3"); |
| |
| # -- atan |
| # The basic form of atan (one argument) returns a value in ]-pi, pi[. |
| # Quadrants I, III |
√ | ok(approx(atan(1) / $PI * 180, 45)); |
√ | ok(approx(atan(1/3*sqrt(3)) / $PI * 180, 30)); |
√ | ok(approx(atan(sqrt(3)) / $PI * 180, 60)); |
| |
| # Quadrants II, IV |
√ | ok(approx(atan(-1) / $PI * 180, -45)); |
√ | ok(approx(atan(-1/3*sqrt(3)) / $PI * 180, -30)); |
√ | ok(approx(atan(-sqrt(3)) / $PI * 180, -60)); |
| |
| # S29: This second form of C<atan> computes the arctangent of $y/$x, and |
| # **takes the quadrant into account**. |
| # Quadrant I |
√ | ok(approx(atan(1, 1) / $PI * 180, 45)); |
√ | ok(approx(atan(1, sqrt(3)) / $PI * 180, 30)); |
√ | ok(approx(atan(1, 1/3*sqrt(3)) / $PI * 180, 60)); |
| |
| # Quadrant II |
√ | ok(approx(atan(1, -1) / $PI * 180, 135)); |
√ | ok(approx(atan(1, -1/3*sqrt(3)) / $PI * 180, 120)); |
√ | ok(approx(atan(1, -sqrt(3)) / $PI * 180, 150)); |
| |
| # Quadrant III |
√ | ok(approx(atan(-1, -1) / $PI * 180 + 360, 225)); |
√ | ok(approx(atan(-1, -sqrt(3)) / $PI * 180 + 360, 210)); |
√ | ok(approx(atan(-1, -1/3*sqrt(3)) / $PI * 180 + 360, 240)); |
| |
| # Quadrant IV |
√ | ok(approx(atan(-1, 1) / $PI * 180 + 360, 315)); |
√ | ok(approx(atan(-1, sqrt(3)) / $PI * 180 + 360, 330)); |
√ | ok(approx(atan(-1, 1/3*sqrt(3)) / $PI * 180 + 360, 300)); |
| |
| # -- sin, cos, tan |
| # sin |
√ | ok(approx(sin(0/4*$PI), 0)); |
√ | ok(approx(sin(1/4*$PI), 1/2*sqrt(2))); |
√ | ok(approx(sin(2/4*$PI), 1)); |
√ | ok(approx(sin(3/4*$PI), 1/2*sqrt(2))); |
√ | ok(approx(sin(4/4*$PI), 0)); |
√ | ok(approx(sin(5/4*$PI), -1/2*sqrt(2))); |
√ | ok(approx(sin(6/4*$PI), -1)); |
√ | ok(approx(sin(7/4*$PI), -1/2*sqrt(2))); |
√ | ok(approx(sin(8/4*$PI), 0)); |
| |
| # cos |
√ | ok(approx(cos(0/4*$PI), 1)); |
√ | ok(approx(cos(1/4*$PI), 1/2*sqrt(2))); |
√ | ok(approx(cos(2/4*$PI), 0)); |
√ | ok(approx(cos(3/4*$PI), -1/2*sqrt(2))); |
√ | ok(approx(cos(4/4*$PI), -1)); |
√ | ok(approx(cos(5/4*$PI), -1/2*sqrt(2))); |
√ | ok(approx(cos(6/4*$PI), 0)); |
√ | ok(approx(cos(7/4*$PI), 1/2*sqrt(2))); |
√ | ok(approx(cos(8/4*$PI), 1)); |
| |
| # tan |
√ | ok(approx(tan(0/4*$PI), 0)); |
√ | ok(approx(tan(1/4*$PI), 1)); |
√ | ok(approx(tan(3/4*$PI), -1)); |
√ | ok(approx(tan(4/4*$PI), 0)); |
√ | ok(approx(tan(5/4*$PI), 1)); |
√ | ok(approx(tan(7/4*$PI), -1)); |
√ | ok(approx(tan(8/4*$PI), 0)); |
| |
| # asin |
√ | ok(approx(try {asin(0)}, 0)); |
× | ok(approx(try {asin(1/2*sqrt(2))}, 1/4*$PI), :todo<feature>); |
× | ok(approx(try {asin(1)}, 2/4*$PI), :todo<feature>); |
| |
| # acos |
× | ok(approx(try {acos(0)}, 2/4*$PI), :todo<feature>); |
× | ok(approx(try {acos(1/2*sqrt(2))}, 1/4*$PI), :todo<feature>); |
√ | ok(approx(try {acos(1)}, 0/4*$PI)); |
From t/builtins/math/e.t lines 5–27 (no results): (skip)
| # L<S29/"The :Trig tag"> |
| |
| =head1 DESCRIPTION |
| |
| Basic tests for trigonometric functions. |
| |
| =cut |
| |
| sub approx(Num $a, Num $b) { |
| my $EPSILON = 0.0001; |
| ($EPSILON > abs($a - $b)); |
| } |
| |
| # See also: L<"http://en.wikipedia.org/wiki/E_%28mathematical_constant%29"> :) |
| my $e = 2.71828182845904523536; |
| |
| # -- pi |
| ok(approx(e , $e), "pi, as a bareword"); |
| ok(approx(e() , $e), "pi, as a sub"); |
| ok(approx(1 + e(), $e+1), "1+pi(), as a sub"); |
| ok(approx(e() + 1, $e+1), "pi()+1, as a sub"); |
| ok(approx(1 + e, $e+1), "1+pi, as a bareword"); |
| ok(approx(e + 1, $e+1), "pi+1, as a bareword"); |
The following are also defined in Num but not exported without a :Trig tag. (Which installs their names into Num::Trig, as it happens.)
Num multi method func ( Num $x: $base = 'radians' ) is export(:Trig)
where func is one of: sin, cos, tan, asin, acos, atan, sec, cosec, cotan, asec, acosec, acotan, sinh, cosh, tanh, asinh, acosh, atanh, sech, cosech, cotanh, asech, acosech, acotanh.
Performs the various trigonometric functions.
Option $base is used to declare how you measure your angles. Given the value of an arc representing a single full revolution.
$base Result ---- ------- /:i ^r/ Radians (2*pi) /:i ^d/ Degrees (360) /:i ^g/ Gradians (400) Num Units of 1 revolution.
Note that module currying can be used within a lexical scope to specify a consistent base so you don't have to supply it with every call:
my module Trig ::= Num::Trig.assuming(:base<degrees>);
This overrides the default of "radians".
our Num multi method atan2 ( Num $y: Num $y = 1 ) our Num multi atan2 ( Num $y, Num $x = 1 )
This second form of atan computes the arctangent of $y/$x, and takes the quadrant into account. Otherwise behaves as other trigonometric functions.
API document: Scalar
Scalar provides the basic tools for operating on undifferentiated scalar variables. All of the following are exported by default.
From t/builtins/bool/defined.t lines 5–72 (21 √, 0 ×): (skip)
| # L<S29/Scalar/"=item defined"> |
| |
| =pod |
| |
| Tests for the defined() builtin |
| |
| =cut |
| |
| |
| |
√ | ok(!defined(undef), 'undef is not defined'); |
| |
√ | ok(defined(1), 'numeric literal 1 is defined'); |
√ | ok(defined(""), 'empty string is defined'); |
√ | ok(defined("a"), '"a" is defined'); |
√ | ok(defined(0), 'numeric literal 0 is defined'); |
| |
| my $foo; |
√ | ok(!defined($foo), 'unassigned variable $foo is undefined'); |
| |
| $foo = 1; |
√ | ok(defined($foo), 'variable $foo is now defined (as numeric literal 1)'); |
| |
| $foo = ""; |
√ | ok(defined($foo), 'variable $foo is now defined (as a empty string)'); |
| |
| $foo = undef; |
√ | ok(!defined($foo), 'variable $foo is now undefined again'); |
| |
| $foo = "a"; |
√ | ok(defined($foo), 'variable $foo is now defined (as string "a")'); |
| |
| $foo = 0; |
√ | ok(defined($foo), 'variable $foo is now defined (as numeric literal 0)'); |
| |
| undefine($foo); |
√ | ok(!defined($foo), 'undef $foo works'); |
| |
| # try the invocant syntax |
| |
| my $foo; |
√ | ok(!$foo.defined, 'unassigned variable $foo is undefined'); |
| |
| $foo = 1; |
√ | ok($foo.defined, 'variable $foo is now defined (as numeric literal 1)'); |
| |
| $foo = ""; |
√ | ok($foo.defined, 'variable $foo is now defined (as a empty string)'); |
| |
| $foo = undef; |
√ | ok(!$foo.defined, 'variable $foo is now undefined again'); |
| |
| $foo = "a"; |
√ | ok($foo.defined, 'variable $foo is now defined (as string "a")'); |
| |
| $foo = 0; |
√ | ok($foo.defined, 'variable $foo is now defined (as numeric literal 0)'); |
| |
| undefine($foo); |
√ | ok(!$foo.defined, 'undef $foo works'); |
| |
| |
| # While porting a Perl 5 solution to QoTW regular #24, I noticed the following bug: |
| # my %a = (a => 1); |
| # defined %a{"b"}; # true! |
| my %a = (a => 1); |
√ | ok defined(%a{"a"}), "defined on a hash with parens (1)"; |
√ | ok !defined(%a{"b"}), "defined on a hash with parens (2)"; |
our Bool multi defined ( Any $thing ) our Bool multi defined ( Any $thing, ::role )
defined returns true if the parameter has a value and that value is not the undefined value (per undef), otherwise false is returned.
Same as Perl 5, only takes extra optional argument to ask if value is defined with respect to a particular role:
defined($x, SomeRole);
A value may be defined according to one role and undefined according to another. Without the extra argument, defaults to the definition of defined supplied by the type of the object.
From t/builtins/undef.t lines 54–195 (37 √, 5 ×): (skip)
| # L<S29/Scalar/"=item undefine"> |
| { |
| my @ary = "arg1"; |
| my $a = @ary.pop; |
√ | ok(defined($a), "pop from array"); |
| $a = @ary.pop; |
√ | ok(!defined($a), "pop from empty array"); |
| |
| @ary = "arg1"; |
| $a = @ary.shift; |
√ | ok(defined($a), "shift from array"); |
| $a = @ary.shift; |
√ | ok(!defined($a), "shift from empty array"); |
| |
| my %hash = ( bar => 'baz', quux => 'quuz' ); |
√ | ok(defined(%hash<bar>), "hash subscript"); |
√ | ok(!defined(%hash<bargho>), "non-existent hash subscript"); |
| |
| undefine %hash<bar>; |
√ | ok(!defined(%hash<bar>), "undefine hash subscript"); |
| |
| %hash<bar> = "baz"; |
| %hash.delete("bar"); |
√ | ok(!defined(%hash<bar>), "delete hash subscript"); |
| |
√ | ok(defined(@ary), "aggregate array defined"); |
√ | ok(defined(%hash), "aggregate hash defined"); |
| |
| undefine(@ary); |
× | ok(!defined(@ary), "undefine array",:todo<bug>); |
| |
| undefine(%hash); |
× | ok(!defined(%hash), "undefine hash",:todo<bug>); |
| |
| @ary = (1); |
√ | ok(defined(@ary), "define array again"); |
| %hash = (1,1); |
√ | ok(defined(%hash), "define hash again"); |
| } |
| |
| { |
| sub a_sub { "møøse" } |
| |
√ | ok(defined(&a_sub), "defined sub"); |
× | ok(eval('defined(%«$?PACKAGE\::»<&a_sub>)'), "defined sub (symbol table)", :todo<parsefail>); |
| |
× | ok(eval('!defined(&a_subwoofer)'), "undefined sub",:todo<feature>); |
× | ok(eval('!defined(%«$?PACKAGE\::»<&a_subwoofer>)'), "undefined sub (symbol table)", :todo<feature>); |
| } |
| |
| # TODO: find a read-only value to try and assign to, since we don't |
| # have rules right now to play around with (the p5 version used $1) |
| #eval { "constant" = "something else"; }; |
| #is($!, "Modification of a read", "readonly write yields exception"); |
| |
| # skipped tests for tied things |
| |
| # skipped test for attempt to undef a bareword -- no barewords here. |
| |
| # TODO: p5 "bugid 3096 |
| # undefing a hash may free objects with destructors that then try to |
| # modify the hash. To them, the hash should appear empty." |
| |
| |
| # Test LHS assignment to undef: |
| |
| my $interesting; |
| (undef, undef, $interesting) = (1,2,3); |
√ | is($interesting, 3, "Undef on LHS of list assignment"); |
| |
| (undef, $interesting, undef) = (1,2,3); |
√ | is($interesting, 2, "Undef on LHS of list assignment"); |
| |
| ($interesting, undef, undef) = (1,2,3); |
√ | is($interesting, 1, "Undef on LHS of list assignment"); |
| |
| sub two_elements() { (1,2) }; |
| (undef,$interesting) = two_elements(); |
√ | is($interesting, 2, "Undef on LHS of function assignment"); |
| |
| ($interesting, undef) = two_elements(); |
√ | is($interesting, 1, "Undef on LHS of function assignment"); |
| |
| =kwid |
| |
| Perl6-specific tests |
| |
| =cut |
| |
| { |
| # aggregate references |
| |
| my @ary = (<a b c d e>); |
| my $ary_r = @ary; # ref |
√ | isa_ok($ary_r, "Array"); |
√ | ok(defined($ary_r), "array reference"); |
| |
| undefine @ary; |
√ | ok(!+$ary_r, "undef array referent"); |
| |
√ | is(+$ary_r, 0, "dangling array reference"); |
| |
| my %hash = (1, 2, 3, 4); |
| my $hash_r = %hash; |
√ | isa_ok($hash_r, "Hash"); |
√ | ok(defined($hash_r), "hash reference"); |
| undefine %hash; |
√ | ok(defined($hash_r), "undefine hash referent:"); |
√ | is(+$hash_r.keys, 0, "dangling hash reference"); |
| } |
| |
| { |
| # types |
| # TODO: waiting on my Dog $spot; |
| |
| my Array $an_ary; |
√ | ok(!defined($an_ary), "my Array"); |
√ | ok(try { !defined($an_ary[0]) }, "my Array subscript - undef"); |
| try { $an_ary.push("blergh") }; |
√ | ok(try { defined($an_ary.pop) }, "push"); |
√ | ok(try { !defined($an_ary.pop) }, "comes to shove"); |
| |
| my Hash $a_hash; |
| |
√ | ok(!defined($a_hash), "my Hash"); |
√ | ok(try { !defined($a_hash<blergh>) }, "my Hash subscript - undef"); |
√ | ok(try { !defined($a_hash<blergh>) }, "my Hash subscript - undef, no autovivification happened"); |
| |
| $a_hash<blergh> = 1; |
√ | ok(defined($a_hash.delete('blergh')), "delete"); |
√ | ok(!defined($a_hash.delete("blergh")), " - once only"); |
| |
| class Dog {}; |
| my Dog $spot; |
| |
√ | ok(!defined($spot), "Unelaborated mutt"); |
| $spot .= new; |
√ | ok(defined $spot, " - now real"); |
| } |
| |
| # rules |
| # TODO. refer to S05 |
our multi undefine( Any $thing )
Takes any variable as a parameter and attempts to "remove" its definition. For simple scalar variables this means assigning the undefined value to the variable. For objects, this is equivalent to invoking their undefine method. For arrays, hashes and other complex data, this might require emptying the structures associated with the object.
In all cases, calling undefine on a variable should place the object in the same state as if it was just declared.
From t/builtins/undef.t lines 28–53 (9 √, 0 ×): (skip)
| # L<S29/Scalar/"=item undef"> |
√ | is(undef, undef, "undef is equal to undef"); |
√ | ok(!defined(undef), "undef is not defined"); |
| |
| { |
| my $a; |
√ | is($a, undef, "uninitialized lexicals are undef"); |
| |
√ | is($GLOBAL, undef, "uninitialized globals are undef"); |
| |
| $a += 1; # should not emit a warning. how to test that? |
√ | ok(defined($a), "initialized var is defined"); |
| |
| undefine $a; |
√ | ok(!defined($a), "undefine($a) does"); |
| |
| $a = "hi"; |
√ | ok(defined($a), "string"); |
| |
| my $b; |
| $a = $b; |
√ | ok(!defined($a), "assigning another undef lexical"); |
| |
| $a = $GLOBAL; |
√ | ok(!defined($a), "assigning another undef global"); |
| } |
constant Scalar Scalar::undef
Returns the undefined scalar object. undef has no value at all, but for historical compatibility, it will numify to 0 and stringify to the empty string, potentially generating a warning in doing so. There are two ways to determine if a value equal to undef: the defined function (or method) can be called or the // (or orelse) operator can be used.
undef is also considered to be false in a boolean context. Such a conversion does not generate a warning.
Perl 5's unary undef function is renamed undefine to avoid confusion with the value undef (which is always 0-ary now).
From t/builtins/container/cat.t lines 7–31 (4 √, 2 ×): (skip)
| # L<S29/Container/"=item cat"> |
| |
| =pod |
| |
| Tests of |
| |
| our Lazy multi Container::cat( *@@list ); |
| |
| =cut |
| |
√ | ok(cat() eqv (), 'cat null identity'); |
| |
√ | ok(cat(1) eqv (1,), 'cat scalar identity'); |
| |
√ | ok(cat(1..3) eqv 1..3, 'cat list identity'); |
| |
√ | ok(cat([1..3]) eqv 1..3, 'cat array identity'); |
| |
| # These below work. Just waiting on eqv. |
| |
× | ok(cat({'a'=>1,'b'=>2,'c'=>3}) eqv ('a'=>1, 'b'=>2, 'c'=>3), |
| 'cat hash identity', :todo<feature>, :depends<eqv>); |
| |
× | ok(cat((); 1; 2..4; [5..7], {'a'=>1,'b'=>2}) eqv (1..7, 'a'=>1, 'b'=>2), |
| 'basic cat', :todo<feature>, :depends<eqv>); |
our Cat multi cat( *@@list )
cat reads arrays serially rather than in parallel as zip does. It returns all of the elements of the containers that were passed to it like so:
cat(@a;@b;@c);
Typically, you could just write (@a,@b,@c), but sometimes it's nice to be explicit about that:
@foo := [[1,2,3],[4,5,6]]; say cat([;] @foo); # 1,2,3,4,5,6
In addition, a Cat in item context emulates the Str interface lazily.
From t/builtins/container/roundrobin.t lines 7–45 (4 √, 4 ×): (skip)
| # L<S29/Container/"=item roundrobin"> |
| |
| =pod |
| |
| Tests of |
| |
| our Lazy multi Container::roundrobin( Bool :$shortest, |
| Bool :$finite, *@@list ); |
| |
| =cut |
| |
√ | ok(roundrobin() eqv (), 'roundrobin null identity'); |
| |
√ | ok(roundrobin(1) eqv (1,), 'roundrobin scalar identity'); |
| |
√ | ok(roundrobin(1..3) eqv 1..3, 'roundrobin list identity'); |
| |
√ | ok(roundrobin([1..3]) eqv 1..3, 'roundrobin array identity'); |
| |
| # Next 2 work. Just waiting on eqv. |
| |
× | ok(roundrobin({'a'=>1,'b'=>2,'c'=>3}) eqv ('a'=>1,'b'=>2,'c'=>3), |
| 'roundrobin hash identity', :todo<feature>, depends<eqv>); |
| |
× | ok(roundrobin((); 1; 2..4; [5..7]; {'a'=>1,'b'=>2}) |
| eqv (1, 2, 5, 'a'=>1, 3, 6, 'b'=>2, 4, 7), 'basic roundrobin', |
| :todo<feature>, :depends<eqv>); |
| |
× | ok(roundrobin(:shortest, 1; 1..2; 1..3) eqv (1), 'roundrobin :shortest', |
| :todo<feature>); |
| |
× | flunk('roundrobin :finite', :todo<feature>, :depends<lazy roundrobin>); |
| |
| =begin lazy_roundrobin |
| |
| ok(roundrobin(:finite, 1; 1..2; 1..3) eqv (1), 'roundrobin :shortest', |
| :todo<feature>); |
| |
| =cut |
our List multi roundrobin( *@@list )
roundrobin is very similar to zip. The difference is that roundrobin will not stop on lists that run out of elements but simply skip any undefined value:
my @a = 1;
my @b = 1..2;
my @c = 1..3;
for roundrobin( @a; @b; @c ) -> $x { ... }
will get the following values for $x: 1, 1, 1, 2, 2, 3
From t/builtins/lists/zip.t lines 10–77 (5 √, 4 ×): (skip)
| L<S29/Container/"=item zip"> |
| |
| =cut |
| |
| plan 9; |
| |
| { |
| my @a = (0, 2, 4); |
| my @b = (1, 3, 5); |
| |
| my @e = (0 .. 5); |
| |
| my @z; @z = zip(@a; @b); |
| my @x; @x = (@a Z @b); |
| |
√ | is(~@z, ~@e, "simple zip"); |
√ | is(~@x, ~@e, "also with Z char"); |
| }; |
| |
| { |
| my @a = (0, 3); |
| my @b = (1, 4); |
| my @c = (2, 5); |
| |
| my @e = (0 .. 5); |
| |
| my @z; @z = zip(@a; @b; @c); |
| my @x; @x = (@a Z @b Z @c); |
| |
√ | is(~@z, ~@e, "zip of 3 arrays"); |
√ | is(~@x, ~@e, "also with Z char"); |
| }; |
| |
| { |
| my @a = (0, 4); |
| my @b = (2, 6); |
| my @c = (1, 3, 5, 7); |
| |
| # [((0, 2), 1), ((4, 6), 3), (undef, 5), (undef, 7)] |
| my $todo = 'Seq(Seq(0,2),1), Seq(Seq(0,2),1), Seq(undef,5), Seq(undef,7)'; |
| my @e = eval $todo; |
| |
| my @z; @z = zip(zip(@a; @b); @c); |
| my @x; @x = ((@a Z @b) Z @c); |
| |
× | is(~@z, ~@e, "zip of zipped arrays with other array", :todo<feature>, |
| :depends<Seq>); |
× | is(~@x, ~@e, "also as Z", :todo<feature>, :depends<Seq>); |
| }; |
| |
| { |
| my @a = (0, 2); |
| my @b = (1, 3, 5); |
| my @e = (0, 1, 2, 3); |
| |
| my @z = (@a Z @b); |
√ | is(@z, @e, "zip uses length of shortest"); |
| } |
| |
| { |
| my @a; |
| my @b; |
| |
| (@a Z @b) = (1, 2, 3, 4); |
| # XXX - The arrays below are most likely Seq's |
× | is(@a, [1, 3], "first half of two zipped arrays as lvalues", :todo); |
× | is(@b, [2, 4], "second half of the lvalue zip", :todo); |
| } |
our List of Capture multi zip ( *@@list ) our List of Capture multi infix:<Z> ( *@@list )
zip takes any number of arrays and returns one tuple for every index. This is easier to read in an example:
for zip(@a;@b;@c) -> $nth_a, $nth_b, $nth_c {
...
}
Mnemonic: the input arrays are "zipped" up like a zipper.
The zip function defaults to stopping as soon as any of its lists is exhausted. This behavior may be modified by conceptually extending any short list using *, which replicates the final element.
If all lists are potentially infinite, an evaluation in eager context will automatically fail as soon as it can be known that all sublists in the control of iterators of infinite extent, such as indefinite ranges or arbitrary replication. If it can be known at compile time, a compile-time error results.
Z is an infix equivalent for zip:
for @a Z @b Z @c -> $a, $b, $c {...}
In @@ context a List of Array is returned instead of flat list.
All these methods are defined in the Array role/class.
From t/builtins/hashes/delete.t lines 5–36 (4 √, 0 ×): (skip)
| # L<S29/Array/=item delete> |
| |
| =pod |
| |
| Test delete method of Spec Functions. |
| |
| our List multi method Hash::delete ( *@keys ) |
| our Scalar multi method Hash::delete ( $key ) is default |
| |
| Deletes the elements specified by C<$key> or C<$keys> from the invocant. |
| returns the value(s) that were associated to those keys. |
| |
| =cut |
| |
| |
| sub gen_hash { |
| my %h{'a'..'z'} = (1..26); |
| return %h; |
| } |
| |
| { |
| my %h1 = gen_hash; |
| my %h2 = gen_hash; |
| |
| my $b = %h1<b>; |
√ | is delete(%h1, <b>), $b, "Test for delete single key. (Indirect notation)"; |
√ | is %h2.delete(<b>), $b, "Test for delete single key. (Method call)"; |
| |
| my @cde = %h1<c d e>; |
√ | is delete(%h1, <c d e>), @cde, "test for delete multiple keys. (Indirect notation)"; |
√ | is %h2.delete(<c d e>), @cde, "test for delete multiple keys. (method call)"; |
| } |
From t/spec/S29-array/delete.t lines 12–67 (no results): (skip)
| # L<S29/"Array"/=item delete>
|
|
|
| # W/ positive indices:
|
| {
|
| my @array = <a b c d>;
|
| is ~@array, "a b c d", "basic sanity (1)";
|
| is ~@array.delete(2), "c",
|
| "deletion of an array element returned the right thing";
|
| # Note: The double space here is correct (it's the stringification of undef).
|
| is ~@array, "a b d", "deletion of an array element";
|
|
|
| is ~@array.delete(0, 3), "a d",
|
| "deletion of array elements returned the right things";
|
| is ~@array, " b ", "deletion of array elements (1)";
|
| is +@array, 3, "deletion of array elements (2)";
|
| }
|
|
|
| # W/ negative indices:
|
| {
|
| my @array = <a b c d>;
|
| is ~@array.delete(-2), "c",
|
| "deletion of array element accessed by an negative index returned the right thing";
|
| # @array is now ("a", "b", undef, "d") ==> double spaces
|
| is ~@array, "a b d", "deletion of an array element accessed by an negative index (1)";
|
| is +@array, 4, "deletion of an array element accessed by an negative index (2)";
|
|
|
| is ~@array.delete(-1), "d",
|
| "deletion of last array element returned the right thing";
|
| # @array is now ("a", "b", undef)
|
| is ~@array, "a b ", "deletion of last array element (1)";
|
| is +@array, 3, "deletion of last array element (2)";
|
| }
|
|
|
| # W/ multiple positive and negative indices:
|
| {
|
| my @array = <a b c d e f>;
|
| is ~@array.delete(2, -3, -1), "c d f",
|
| "deletion of array elements accessed by positive and negative indices returned right things";
|
| # @array is now ("a", "b", undef, undef, "e") ==> double spaces
|
| is ~@array, "a b e",
|
| "deletion of array elements accessed by positive and negative indices (1)";
|
| is +@array, 5,
|
| "deletion of array elements accessed by positive and negative indices (2)";
|
| }
|
|
|
| # Results taken from Perl 5
|
| {
|
| my @array = <a b c>;
|
| is ~@array.delete(2, -1), "c b",
|
| "deletion of the same array element accessed by different indices returned right things";
|
| is ~@array, "a",
|
| "deletion of the same array element accessed by different indices (1)";
|
| is +@array, 1,
|
| "deletion of the same array element accessed by different indices (2)";
|
| }
|
|
|
our List multi method delete (@array : *@indices ) is export
Sets elements specified by @indices in the invocant to a non-existent state, as if they never had a value. Deleted elements at the end of an Array shorten the length of the Array, unless doing so would violate an is shape() definition.
@indices is interpreted the same way as subscripting is in terms of slices and multidimensionality. See Synopsis 9 for details.
Returns the value(s) previously held in deleted locations.
An unary form is expected. See Hash::delete.
From t/spec/S29-array/exists.t lines 12–27 (no results): (skip)
| # L<S29/"Array"/=item exists>
|
|
|
| my @array = <a b c d>;
|
| ok @array.exists(0), "exists(positive index) on arrays (1)";
|
| ok @array.exists(1), "exists(positive index) on arrays (2)";
|
| ok @array.exists(2), "exists(positive index) on arrays (3)";
|
| ok @array.exists(3), "exists(positive index) on arrays (4)";
|
| ok !@array.exists(4), "exists(positive index) on arrays (5)";
|
| ok !@array.exists(42), "exists(positive index) on arrays (2)";
|
| ok @array.exists(-1), "exists(negative index) on arrays (1)";
|
| ok @array.exists(-2), "exists(negative index) on arrays (2)";
|
| ok @array.exists(-3), "exists(negative index) on arrays (3)";
|
| ok @array.exists(-4), "exists(negative index) on arrays (4)";
|
| ok !@array.exists(-5), "exists(negative index) on arrays (5)";
|
| ok !@array.exists(-42), "exists(negative index) on arrays (6)";
|
|
|
our Bool multi method exists (@array : Int *@indices ) is export
True if the specified Array element has been assigned to. This is not the same as being defined.
Supplying a different number of indices than invocant has dimensions is an error.
An unary form is expected. See Hash::delete.
From t/spec/S29-array/pop.t lines 4–84 (no results): (skip)
| # L<S29/"Array"/"=item pop">
|
|
|
| =kwid
|
|
|
| Pop tests
|
|
|
| =cut
|
|
|
| plan 27;
|
|
|
| { # pop() elements into variables
|
| my @pop = (1, 2, 3, 4);
|
|
|
| is(+@pop, 4, 'we have 4 elements in the array');
|
| my $a = pop(@pop);
|
| is($a, 4, 'pop(@pop) works');
|
|
|
| is(+@pop, 3, 'we have 3 elements in the array');
|
| my $a = pop @pop;
|
| is($a, 3, 'pop @pop works');
|
|
|
| is(+@pop, 2, 'we have 2 elements in the array');
|
| my $a = @pop.pop();
|
| is($a, 2, '@pop.pop() works');
|
|
|
| is(+@pop, 1, 'we have 1 element in the array');
|
| my $a = @pop.pop;
|
| is($a, 1, '@pop.pop works');
|
|
|
| is(+@pop, 0, 'we have no more element in the array');
|
| ok(!defined(pop(@pop)), 'after the array is exhausted pop() returns undef');
|
| }
|
|
|
| { # pop() elements inline
|
| my @pop = (1, 2, 3, 4);
|
|
|
| is(+@pop, 4, 'we have 4 elements in the array');
|
| is(pop(@pop), 4, 'inline pop(@pop) works');
|
|
|
| is(+@pop, 3, 'we have 3 elements in the array');
|
| is(pop @pop, 3, 'inline pop @pop works');
|
|
|
| is(+@pop, 2, 'we have 2 elements in the array');
|
| is(@pop.pop(), 2, 'inline @pop.pop() works');
|
|
|
| is(+@pop, 1, 'we have 1 element in the array');
|
| is(@pop.pop, 1, 'inline @pop.pop works');
|
|
|
| is(+@pop, 0, 'we have no more element in the array');
|
| ok(!defined(pop(@pop)), 'after the array is exhausted pop() returns undef');
|
| }
|
|
|
| # invocant syntax with inline arrays
|
| {
|
| is([1, 2, 3].pop, 3, 'this will return 3');
|
| ok(!defined([].pop), 'this will return undef');
|
| }
|
|
|
| # some edge cases
|
|
|
| {
|
| my @pop;
|
| ok(!defined(@pop.pop()), 'pop on an un-initalized array returns undef');
|
| }
|
|
|
| # testing some error cases
|
| {
|
| my @pop = 1 .. 5;
|
| dies_ok({ pop() }, 'pop() requires arguments');
|
| dies_ok({ pop(@pop, 10) }, 'pop() should not allow extra arguments');
|
| dies_ok({ @pop.pop(10) }, 'pop() should not allow extra arguments');
|
| dies_ok({ 42.pop }, '.pop should not work on scalars');
|
| }
|
|
|
| # Pop with Inf arrays (waiting on answers from perl6-compiler email)
|
| #{
|
| # my @push = 1 .. Inf;
|
| # # best not to uncomment this it just go on forever
|
| # todo_throws_ok { 'pop @push' }, '?? what should this error message be ??', 'cannot push onto a Inf array';
|
| #}
|
|
|
our Scalar multi method pop ( @array: ) is export
Remove the last element of @array and return it.
From t/spec/S29-array/push.t lines 4–130 (no results): (skip)
| # L<S29/"Array"/"=item push">
|
|
|
| =kwid
|
|
|
| Push tests
|
|
|
| =cut
|
|
|
| plan 42;
|
|
|
| # basic push tests
|
| {
|
| my @push = ();
|
|
|
| is(+@push, 0, 'we have an empty array');
|
|
|
| push(@push, 1);
|
| is(+@push, 1, 'we have 1 element in the array');
|
| is(@push[0], 1, 'we found the right element');
|
|
|
| push(@push, 2);
|
| is(+@push, 2, 'we have 2 elements in the array');
|
| is(@push[1], 2, 'we found the right element');
|
|
|
| push(@push, 3);
|
| is(+@push, 3, 'we have 3 element in the array');
|
| is(@push[2], 3, 'we found the right element');
|
|
|
| push(@push, 4);
|
| is(+@push, 4, 'we have 4 element in the array');
|
| is(@push[3], 4, 'we found the right element');
|
| }
|
|
|
| # try other variations on calling push()
|
| {
|
| my @push = ();
|
|
|
| my $val = 100;
|
|
|
| push @push, $val;
|
| is(+@push, 1, 'we have 1 element in the array');
|
| is(@push[0], $val, 'push @array, $val worked');
|
|
|
| @push.push(200);
|
| is(+@push, 2, 'we have 2 elements in the array');
|
| is(@push[1], 200, '@push.push(200) works');
|
|
|
| @push.push(400);
|
| is(+@push, 3, 'we have 3 elements in the array');
|
| is(@push[2], 400, '@push.push(400) works');
|
| }
|
|
|
| # try pushing more than one element
|
| {
|
| my @push = ();
|
|
|
| push @push, (1, 2, 3);
|
| is(+@push, 3, 'we have 3 elements in the array');
|
| is(@push[0], 1, 'got the expected element');
|
| is(@push[1], 2, 'got the expected element');
|
| is(@push[2], 3, 'got the expected element');
|
|
|
| my @val2 = (4, 5);
|
| push @push, @val2;
|
| is(+@push, 5, 'we have 5 elements in the array');
|
| is(@push[3], 4, 'got the expected element');
|
| is(@push[4], 5, 'got the expected element');
|
|
|
| push @push, 6, 7, 8; # push() should be slurpy
|
| is(+@push, 8, 'we have 8 elements in the array');
|
| is(@push[5], 6, 'got the expected element');
|
| is(@push[6], 7, 'got the expected element');
|
| is(@push[7], 8, 'got the expected element');
|
| }
|
|
|
| # now for the push() on an uninitialized array issue
|
| {
|
| my @push;
|
|
|
| push @push, 42;
|
| is(+@push, 1, 'we have 1 element in the array');
|
| is(@push[0], 42, 'got the element expected');
|
|
|
| @push.push(2000);
|
| is(+@push, 2, 'we have 1 element in the array');
|
| is(@push[0], 42, 'got the element expected');
|
| is(@push[1], 2000, 'got the element expected');
|
| }
|
|
|
| # testing some edge cases
|
| {
|
| my @push = 0 .. 5;
|
| is(+@push, 6, 'starting length is 6');
|
|
|
| push(@push);
|
| is(+@push, 6, 'length is still 6');
|
|
|
| @push.push();
|
| is(+@push, 6, 'length is still 6');
|
| }
|
|
|
| # testing some error cases
|
| {
|
| dies_ok({ push() }, 'push() requires arguments (1)');
|
| # This one is okay, as push will push 0 elems to a rw arrayref.
|
| lives_ok({ push([]) }, 'push() requires arguments (2)');
|
| dies_ok({ 42.push(3) }, '.push should not work on scalars');
|
| dies_ok({ my @r; @r.push<hi>; }, '.push<hi> should emit error.');
|
| }
|
|
|
| # Push with Inf arrays (waiting on answers to perl6-compiler email)
|
| #{
|
| # my @push = 1 .. Inf;
|
| # # best not to uncomment this it just go on forever
|
| # todo_throws_ok { 'push @push, 10' }, '?? what should this error message be ??', 'cannot push onto a Inf array';
|
| #}
|
|
|
| # nested arrayref
|
| {
|
| my @push;
|
| push @push, [ 21 .. 25 ];
|
|
|
| is(@push.elems, 1, 'nested arrayref, array length is 1');
|
| is(@push[0].elems, 5, 'nested arrayref, arrayref length is 5');
|
| is(@push[0][0], 21, 'nested arrayref, first value is 21');
|
| is(@push[0][-1], 25, 'nested arrayref, last value is 25');
|
| }
|
our Int multi method push ( @array: *@values ) is export
Add to the end of @array, all of the subsequent arguments.
From t/spec/S29-array/shift.t lines 4–85 (no results): (skip)
| # L<S29/"Array"/"=item shift">
|
|
|
| =kwid
|
|
|
| Shift tests
|
|
|
| =cut
|
|
|
| plan 27;
|
|
|
| {
|
|
|
| my @shift = (1, 2, 3, 4);
|
|
|
| is(+@shift, 4, 'we have 4 elements in our array');
|
| my $a = shift(@shift);
|
| is($a, 1, 'shift(@shift) works');
|
|
|
| is(+@shift, 3, 'we have 3 elements in our array');
|
| $a = shift @shift;
|
| is($a, 2, 'shift @shift works');
|
|
|
| is(+@shift, 2, 'we have 2 elements in our array');
|
| $a = @shift.shift();
|
| is($a, 3, '@shift.shift() works');
|
|
|
| is(+@shift, 1, 'we have 1 element in our array');
|
| $a = @shift.shift;
|
| is($a, 4, '@shift.shift() works');
|
|
|
| is(+@shift, 0, 'we have no elements in our array');
|
| ok(!defined(shift(@shift)), 'after the array is exhausted it give undef');
|
|
|
| }
|
|
|
| {
|
| my @shift = (1, 2, 3, 4);
|
|
|
| is(+@shift, 4, 'we have 4 elements in our array');
|
| is(shift(@shift), 1, 'inline shift(@shift) works');
|
|
|
| is(+@shift, 3, 'we have 3 elements in our array');
|
| is(shift @shift, 2, 'inline shift @shift works');
|
|
|
| is(+@shift, 2, 'we have 2 elements in our array');
|
| is(@shift.shift(), 3, 'inline @shift.shift() works');
|
|
|
| is(+@shift, 1, 'we have 1 elements in our array');
|
| is(@shift.shift, 4, 'inline @shift.shift works');
|
|
|
| is(+@shift, 0, 'we have no elements in our array');
|
| ok(!defined(shift(@shift)), 'again, the array is exhausted and we get undef');
|
| }
|
|
|
| # invocant syntax with inline arrays
|
| {
|
| is([1, 2, 3].shift, 1, 'this will return 1');
|
| ok(!defined([].shift), 'this will return undef');
|
| }
|
|
|
| # testing some edge cases
|
| {
|
| my @shift;
|
| ok(!defined(shift(@shift)), 'shift on an empty array returns undef');
|
| }
|
|
|
| # testing some error cases
|
| {
|
| my @shift = 1 .. 5;
|
| dies_ok({ shift() }, 'shift() requires arguments');
|
| dies_ok({ shift(@shift, 10) }, 'shift() should not allow extra arguments');
|
| dies_ok({ @shift.shift(10) }, 'shift() should not allow extra arguments');
|
| dies_ok({ 42.shift }, '.shift should not work on scalars');
|
| }
|
|
|
| # Push with Inf arrays (waiting on answers to perl6-compiler email)
|
| #{
|
| # my @shift = 1 .. Inf;
|
| # # best not to uncomment this it just go on forever
|
| # todo_throws_ok { 'shift(@shift)' }, '?? what should this error message be ??', 'cannot shift off of a Inf array';
|
| #}
|
|
|
our Scalar multi method shift ( @array: ) is export
Remove the first element from @array and return it.
From t/spec/S29-array/splice.t lines 4–140 (no results): (skip)
| # L<S29/"Array"/"=item splice">
|
|
|
| =head1 DESCRIPTION
|
|
|
| This test tests the C<splice> builtin, see S29 and Perl 5's perlfunc.
|
|
|
| Ported from the equivalent Perl 5 test.
|
|
|
| This test includes a test for the single argument form of
|
| C<splice>. Depending on whether the single argument form
|
| of C<splice> should survive or not, this test should be dropped.
|
|
|
| my @a = (1..10);
|
| splice @a;
|
|
|
| is equivalent to:
|
|
|
| my @a = (1..10);
|
| @a = ();
|
|
|
| =cut
|
|
|
| plan 33;
|
|
|
| my (@a,@b,@res);
|
|
|
| # Somehow, this doesn't propagate array context
|
| # to splice(). The intermediate array in the calls
|
| # should be removed later
|
|
|
| sub splice_ok (Array @got, Array @ref, Array @exp, Array @exp_ref, Str $comment) {
|
| is "[@got[]]", "[@exp[]]", "$comment - results match";
|
| is @ref, @exp_ref, "$comment - array got modified in-place";
|
|
|
| # Once we get Test::Builder, this will be better:
|
| #if ( (@got ~~ @exp) and (@ref ~~ @exp_ref)) {
|
| # flunk($comment);
|
| # if (@got !~~ @exp) {
|
| # diag "The returned result is wrong:";
|
| # diag " Expected: @exp";
|
| # diag " Got : @got";
|
| # };
|
| # if (@ref !~~ @exp_ref) {
|
| # diag "The modified array is wrong:";
|
| # diag " Expected: @exp_ref";
|
| # diag " Got : @exp";
|
| # };
|
| #} else {
|
| # ok($comment);
|
| #};
|
| };
|
|
|
| @a = (1..10);
|
| @b = splice(@a,+@a,0,11,12);
|
|
|
| is( @b, [], "push-via-splice result works" );
|
| is( @a, ([1..12]), "push-via-splice modification works");
|
|
|
| @a = ('red', 'green', 'blue');
|
| is( splice(@a, 1, 2), [qw<green blue>],
|
| "splice() in scalar context returns an array references");
|
|
|
| # Test the single arg form of splice (which should die IMO)
|
| @a = (1..10);
|
| @res = splice(@a);
|
| splice_ok( @res, @a, [1..10],[], "Single-arg splice returns the whole array" );
|
|
|
| @a = (1..10);
|
| @res = splice(@a,8,2);
|
| splice_ok( @res, @a, [9,10], [1..8], "3-arg positive indices work");
|
|
|
| @a = (1..12);
|
| splice_ok splice(@a,0,1), @a, [1], [2..12], "Simple 3-arg splice";
|
|
|
| @a = (1..10);
|
| @res = splice(@a,8);
|
| splice_ok @res, @a, [9,10], [1..8], "2-arg positive indices work";
|
|
|
| @a = (1..10);
|
| @res = splice(@a,-2,2);
|
| splice_ok @res, @a, [9,10], [1..8], "3-arg negative indices work";
|
|
|
| @a = (1..10);
|
| @res = splice(@a,-2);
|
| splice_ok @res, @a, [9,10], [1..8], "2-arg negative indices work";
|
|
|
| # to be converted into more descriptive tests
|
| @a = (2..10);
|
| splice_ok splice(@a,0,0,0,1), @a, [], [0..10], "Prepending values works";
|
|
|
| # Need to convert these
|
| # skip 5, "Need to convert more tests from Perl5";
|
| @a = (0..11);
|
| splice_ok splice(@a,5,1,5), @a, [5], [0..11], "Replacing an element with itself";
|
|
|
| @a = (0..11);
|
| splice_ok splice(@a, @a, 0, 12, 13), @a, [], [0..13], "Appending a array";
|
|
|
| @a = (0..13);
|
| @res = splice(@a, -@a, @a, 1, 2, 3);
|
| splice_ok @res, @a, [0..13], [1..3], "Replacing the array contents from right end";
|
|
|
| @a = (1, 2, 3);
|
| splice_ok splice(@a, 1, -1, 7, 7), @a, [2], [1,7,7,3], "Replacing a array into the middle";
|
|
|
| @a = (1,7,7,3);
|
| splice_ok splice(@a,-3,-2,2), @a, [7], [1,2,7,3], "Replacing negative count of elements";
|
|
|
| # Test the identity of calls to splice:
|
| # See also t/builtins/want.t, for the same test in a different
|
| # setting
|
| sub indirect_slurpy_context( *@got ) { @got };
|
|
|
|
|
| # splice4 gets "CxtItem _" or "CxtArray _" instead of "CxtSlurpy _"
|
| my @tmp = (1..10);
|
| @a = splice @tmp, 5, 3;
|
| @a = indirect_slurpy_context( @a );
|
| @tmp = (1..10);
|
| @b = indirect_slurpy_context( splice @tmp, 5, 3 );
|
| is( @b, @a, "Calling splice with immediate and indirect context returns consistent results");
|
| is( @a, [6,7,8], "Explicit call/assignment gives the expected results");
|
| is( @b, [6,7,8], "Implicit context gives the expected results"); # this is due to the method-fallback bug
|
|
|
| my @tmp = (1..10);
|
| @a = item splice @tmp, 5, 3;
|
| is( @a, [6..8], "Explicit scalar context returns an array reference");
|
|
|
| ## test some error conditions
|
|
|
| @a = splice([], 1);
|
| is +@a, 0, '... empty arrays are not fatal anymore';
|
| # But this should generate a warning, but unfortunately we can't test for
|
| # warnings yet.
|
|
|
| #?pugs: todo('bug', 1);
|
| dies_ok({ 42.splice }, '.splice should not work on scalars');
|
our List multi method splice( @array is rw: Int $offset = 0, Int $size?, *@values ) is export
splice fills many niches in array-management, but its fundamental behavior is to remove zero or more elements from an array and replace them with a new (and potentially empty) list. This operation can shorten or lengthen the target array.
$offset is the index of the array element to start with. It defaults to 0.
$size is the number of elements to remove from @array. It defaults to removing the rest of the array from $offset on.
The slurpy list of values (if any) is then inserted at $offset.
Calling splice with a traditional parameter list, you must define $offset and $size if you wish to pass a replacement list of values. To avoid having to pass these otherwise optional parameters, use the piping operator(s):
splice(@array,10) <== 1..*;
which replaces @array[10] and all subsequent elements with an infinite series starting at 1.
This behaves similarly to Perl 5's splice.
If @array is multidimensional, splice operates only on the first dimension, and works with Array References.
splice returns the list of deleted elements in list context, and a reference to a list of deleted elements in scalar context.
From t/spec/S29-array/unshift.t lines 4–137 (no results): (skip)
| # L<S29/"Array"/"=item unshift">
|
|
|
| =kwid
|
|
|
| Unshift tests
|
|
|
| =cut
|
|
|
| plan 53;
|
|
|
| # basic unshift tests
|
|
|
| {
|
| my @unshift = ();
|
|
|
| is(+@unshift, 0, 'we have an empty array');
|
|
|
| unshift(@unshift, 1);
|
| is(+@unshift, 1, 'we have 1 element in the array');
|
| is(@unshift[0], 1, 'we found the right element');
|
|
|
| unshift(@unshift, 2);
|
| is(+@unshift, 2, 'we have 2 elements in the array');
|
| is(@unshift[0], 2, 'we found the right element');
|
| is(@unshift[1], 1, 'we found the right element');
|
|
|
| unshift(@unshift, 3);
|
| is(+@unshift, 3, 'we have 3 element in the array');
|
| is(@unshift[0], 3, 'we found the right element');
|
| is(@unshift[1], 2, 'we found the right element');
|
| is(@unshift[2], 1, 'we found the right element');
|
|
|
| unshift(@unshift, 4);
|
| is(+@unshift, 4, 'we have 4 element in the array');
|
| is(@unshift[0], 4, 'we found the right element');
|
| is(@unshift[1], 3, 'we found the right element');
|
| is(@unshift[2], 2, 'we found the right element');
|
| is(@unshift[3], 1, 'we found the right element');
|
| }
|
|
|
| # try other variations on calling unshift()
|
|
|
| {
|
| my @unshift = ();
|
|
|
| my $val = 100;
|
|
|
| unshift @unshift, $val;
|
| is(+@unshift, 1, 'we have 1 element in the array');
|
| is(@unshift[0], $val, 'unshift @array, $val worked');
|
|
|
| @unshift.unshift(200);
|
| is(+@unshift, 2, 'we have 2 elements in the array');
|
| is(@unshift[0], 200, '@unshift.unshift(200) works');
|
| is(@unshift[1], $val, 'unshift @array, $val worked');
|
|
|
| @unshift.unshift(400);
|
| is(+@unshift, 3, 'we have 3 elements in the array');
|
| is(@unshift[0], 400, '@unshift.unshift(400) works');
|
| is(@unshift[1], 200, '@unshift.unshift(200) works');
|
| is(@unshift[2], $val, 'unshift @array, $val worked');
|
| }
|
|
|
| # try unshifting more than one element
|
|
|
| {
|
| my @unshift = ();
|
|
|
| unshift @unshift, (1, 2, 3);
|
| is(+@unshift, 3, 'we have 3 elements in the array');
|
| is(@unshift[0], 1, 'got the expected element');
|
| is(@unshift[1], 2, 'got the expected element');
|
| is(@unshift[2], 3, 'got the expected element');
|
|
|
| my @val2 = (4, 5);
|
| unshift @unshift, @val2;
|
| is(+@unshift, 5, 'we have 5 elements in the array');
|
| is(@unshift[0], 4, 'got the expected element');
|
| is(@unshift[1], 5, 'got the expected element');
|
| is(@unshift[2], 1, 'got the expected element');
|
| is(@unshift[3], 2, 'got the expected element');
|
| is(@unshift[4], 3, 'got the expected element');
|
|
|
| unshift @unshift, 6, 7, 8;
|
| is(+@unshift, 8, 'we have 8 elements in the array');
|
| is(@unshift[0], 6, 'got the expected element');
|
| is(@unshift[1], 7, 'got the expected element');
|
| is(@unshift[2], 8, 'got the expected element');
|
| is(@unshift[3], 4, 'got the expected element');
|
| is(@unshift[4], 5, 'got the expected element');
|
| is(@unshift[5], 1, 'got the expected element');
|
| is(@unshift[6], 2, 'got the expected element');
|
| is(@unshift[7], 3, 'got the expected element');
|
| }
|
|
|
| # now for the unshift() on an uninitialized array issue
|
|
|
| {
|
| my @unshift;
|
|
|
| unshift @unshift, 42;
|
| is(+@unshift, 1, 'we have 1 element in the array');
|
| is(@unshift[0], 42, 'got the element expected');
|
|
|
| unshift @unshift, 2000;
|
| is(+@unshift, 2, 'we have 1 element in the array');
|
| is(@unshift[0], 2000, 'got the element expected');
|
| is(@unshift[1], 42, 'got the element expected');
|
| }
|
|
|
| # testing some edge cases
|
| {
|
| my @unshift = 0 .. 5;
|
| is(+@unshift, 6, 'starting length is 6');
|
|
|
| unshift(@unshift);
|
| is(+@unshift, 6, 'length is still 6');
|
|
|
| @unshift.push();
|
| is(+@unshift, 6, 'length is still 6');
|
| }
|
|
|
| # testing some error cases
|
| {
|
| dies_ok({ unshift() }, 'unshift() requires arguments');
|
| dies_ok({ 42.unshift(3) }, '.unshift should not work on scalars');
|
| }
|
|
|
| # Push with Inf arrays (waiting on answers to perl6-compiler email)
|
| #{
|
| # my @unshift = 1 .. Inf;
|
| # # best not to uncomment this it just go on forever
|
| # todo_throws_ok { 'unshift @unshift, 10' }, '?? what should this error message be ??', 'cannot unshift onto a Inf array';
|
| #}
|
our Int multi method unshift ( @array: *@values ) is export
unshift adds the values onto the start of the @array.
From t/builtins/arrays_and_hashes/keys_values.t lines 15–19 (3 √, 0 ×): (skip)
| # L<S29/"Array"/=item keys> |
√ | is(~@array.keys, '0 1 2 3', '@arrays.keys works'); |
√ | is(~keys(@array), '0 1 2 3', 'keys(@array) works'); |
√ | is(+@array.keys, +@array, 'we have the same number of keys as elements in the array'); |
| |
From t/builtins/arrays_and_hashes/kv.t lines 13–28 (4 √, 0 ×): (skip)
| # L<S29/"Array"/=item kv> |
| |
| { # check the invocant form |
| my @array = <a b c d>; |
| my @kv = @array.kv; |
√ | is(+@kv, 8, '@array.kv returns the correct number of elems'); |
√ | is(~@kv, "0 a 1 b 2 c 3 d", '@array.kv has no inner list'); |
| } |
| |
| { # check the non-invocant form |
| my @array = <a b c d>; |
| my @kv = kv(@array); |
√ | is(+@kv, 8, 'kv(@array) returns the correct number of elems'); |
√ | is(~@kv, "0 a 1 b 2 c 3 d", 'kv(@array) has no inner list'); |
| } |
| |
From t/builtins/arrays_and_hashes/pairs.t lines 13–31 (8 √, 0 ×): (skip)
| # L<S29/"Array"/=item pairs> |
| { |
| my @array = <a b c>; |
| my @pairs; |
√ | ok((@pairs = @array.pairs), "basic pairs on arrays"); |
√ | is +@pairs, 3, "pairs on arrays returned the correct number of elems"; |
| if +@pairs != 3 { |
| skip 6, "skipped tests which depend on a test which failed"; |
| } else { |
√ | is @pairs[0].key, 0, "key of pair returned by array.pairs was correct (1)"; |
√ | is @pairs[1].key, 1, "key of pair returned by array.pairs was correct (2)"; |
√ | is @pairs[2].key, 2, "key of pair returned by array.pairs was correct (3)"; |
√ | is @pairs[0].value, "a", "value of pair returned by array.pairs was correct (1)"; |
√ | is @pairs[1].value, "b", "value of pair returned by array.pairs was correct (2)"; |
√ | is @pairs[2].value, "c", "value of pair returned by array.pairs was correct (3)"; |
| } |
| } |
| |
| |
From t/builtins/arrays_and_hashes/keys_values.t lines 20–26 (3 √, 0 ×): (skip)
| # L<S29/"Array"/=item values> |
√ | is(~@array.values, 'a b c d', '@array.values works'); |
√ | is(~values(@array), 'a b c d', 'values(@array) works'); |
√ | is(+@array.values, +@array, 'we have the same number of values as elements in the array'); |
| |
| my %hash = (a => 1, b => 2, c => 3, d => 4); |
| |
our List multi method keys ( @array: Matcher *@indextests ) is export our List multi method kv ( @array: Matcher *@indextests ) is export our List multi method pairs (@array: Matcher *@indextests ) is export our List multi method values ( @array: Matcher *@indextests ) is export
Iterates the elements of @array, in order.
If @indextests are provided, only elements whose indices match $index ~~ any(@indextests) are iterated.
What is returned at each element of the iteration varies with function. values returns the value of the associated element; kv returns a 2 element list in (index, value) order, pairs a Pair(index, value).
@array is considered single dimensional. If it is in fact multi-dimensional, the values returned will be array references to the sub array.
In Scalar context, they all return the count of elements that would have been iterated.
The following are defined in the List role/class:
our Cat multi cat ( @values )
Returns a Cat object, a concatenated version of the list that does the Str interface, but generates the string lazily to the extent permitted by the pattern of access to the string. Its two primary uses are matching against an array of strings and doing the equivalent of a join(''), except that join is always eager. However, a Cat in an interpolative context is also effectively eager, since the interpolator needs to know the string length. List context is lazy, though, so a cat of a cat is also lazy, and in fact, you just get a flat cat because cat in a list context is a no-op. The Cat interface also lets you interrogate the object at a particular string position without actually stringifying the element; the regex engine can make use of this to match a tree node, for instance, without serializing the entire subtree.
Accessing a filehandle as both a filehandle and as a Cat is undefined, because lazy objects are not required to be as lazy as possible, but may instead choose to precalculate values in semi-eager batches to maximize cache hits.
From t/builtins/lists/classify.t lines 4–28 (2 √, 9 ×): (skip)
| # L<S29/"List"/"=item classify"> |
| |
| plan 11; |
| |
| my @list = (1, 2, 3, 4); |
| my (@even,@odd); |
× | ok(eval(q"(:@even, :@odd) := classify { $_ % 2 ?? 'odd' !! 'even' } 1,2,3,4; "), :todo<feature> ); |
× | is_deeply(@even, [2,4], "got expected evens", :todo<feature>); |
× | is_deeply(@even, [1,3], "got expected odds", :todo<feature>); |
| |
| my %by_five; |
× | ok(eval(q" %by_five = classify { $_ * 5 } 1,2,3,4 "), :todo<feature>); |
| |
× | is( %by_five{5}, 1, :todo<feature>); |
× | is( %by_five{10}, 2, :todo<feature>); |
× | is( %by_five{15}, 3, :todo<feature>); |
× | is( %by_five{20}, 4, :todo<feature> ); |
| |
| |
| # .classify shouldn't work on non-arrays |
| { |
√ | dies_ok { 42.classify:{ $_ } }, "method form of classify should not work on numbers"; |
√ | dies_ok { "str".classify:{ $_ } }, "method form of classify should not work on strings"; |
× | is eval(q<<< ~(42,).classify:{ 1 } >>>), "42", "method form of classify should work on arrays", :todo<feature>; |
| } |
our List of Pair multi method classify ( @values: Matcher $test ) our List of Pair multi classify ( Matcher $test, *@values )
classify takes a list or array of values and returns a lazily evaluated list comprised of pairs whose values are arrays of values from the input list, and whose keys are the return value of the $test, when passed that value. For example:
@list = (1, 2, 3, 4);
(:@even, :@odd) := classify { $_ % 2 ?? 'odd' !! 'even' } @list;
In this example, @even will contain all even numbers from @list and @odd will contain all odd numbers from @list.
To simply transform a list into a hash of arrays:
%cars_by_color = classify { .color } @cars;
red_car_owners(%cars_by_color<red>.map:{.owner});
From t/builtins/lists/grep.t lines 4–61 (25 √, 2 ×): (skip)
| # L<S29/"List"/"=item grep"> |
| |
| =kwid |
| |
| built-in grep tests |
| |
| =cut |
| |
| plan 27; |
| |
| my @list = (1 .. 10); |
| |
| { |
| my @result = grep { ($_ % 2) }, @list; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], 1, 'got the value we expected'); |
√ | is(@result[1], 3, 'got the value we expected'); |
√ | is(@result[2], 5, 'got the value we expected'); |
√ | is(@result[3], 7, 'got the value we expected'); |
√ | is(@result[4], 9, 'got the value we expected'); |
| } |
| |
| { |
| my @result = @list.grep():{ ($_ % 2) }; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], 1, 'got the value we expected'); |
√ | is(@result[1], 3, 'got the value we expected'); |
√ | is(@result[2], 5, 'got the value we expected'); |
√ | is(@result[3], 7, 'got the value we expected'); |
√ | is(@result[4], 9, 'got the value we expected'); |
| } |
| |
| { |
| my @result = @list.grep:{ ($_ % 2) }; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], 1, 'got the value we expected'); |
√ | is(@result[1], 3, 'got the value we expected'); |
√ | is(@result[2], 5, 'got the value we expected'); |
√ | is(@result[3], 7, 'got the value we expected'); |
√ | is(@result[4], 9, 'got the value we expected'); |
| } |
| |
| { |
| my @result = grep { ($_ % 2) }: @list; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], 1, 'got the value we expected'); |
√ | is(@result[1], 3, 'got the value we expected'); |
√ | is(@result[2], 5, 'got the value we expected'); |
√ | is(@result[3], 7, 'got the value we expected'); |
√ | is(@result[4], 9, 'got the value we expected'); |
| } |
| |
| # .grep shouldn't work on non-arrays |
| { |
× | dies_ok { 42.grep:{ $_ } }, "method form of grep should not work on numbers", :todo<bug>; |
× | dies_ok { "str".grep:{ $_ } }, "method form of grep should not work on strings", :todo<bug>; |
√ | is ~(42,).grep:{ 1 }, "42", "method form of grep should work on arrays"; |
| } |
our List multi method grep ( @values: Matcher $test ) our List multi grep ( Matcher $test, *@values )
grep takes a list or array of values and returns a lazily evaluated list comprised of all of the values from the original list for which the $test smart-matches as true.
Here is an example of its use:
@friends = grep { .is_friend }, @coworkers;
This takes the array @coworkers, checks every element to see which ones return true for the .is_friend method, and returns the resulting list to store into @friends.
Note that, unlike in Perl 5, a comma is required after the Matcher in the multi form.
From t/builtins/lists/first.t lines 4–44 (8 √, 1 ×): (skip)
| # L<S29/"List"/"=item first"> |
| |
| =kwid |
| |
| built-in "first" tests |
| |
| =cut |
| |
| plan 9; |
| |
| my @list = (1 .. 10); |
| |
| { |
| my $result = first { ($_ % 2) }, @list; |
√ | ok($result ~~ Item, "first() returns an Item"); |
√ | is($result, 1, "returned value by first() is correct"); |
| } |
| |
| { |
| my $result = @list.first( { ($_ == 4)}); |
√ | ok($result ~~ Item, "method form of first returns an item"); |
√ | is($result, 4, "method form of first returns the expected item"); |
| } |
| |
| { |
| my $result = @list.first():{ ($_ == 4) }; |
√ | ok($result ~~ Item, "first():<block> returns an Item"); |
√ | is($result, 4, "first() returned the expected value"); |
| } |
| |
| { |
√ | is(@list.first( { ($_ == 11) }), undef, 'first returns undef unsuccessfull match'); |
| } |
| |
| { |
| my $count = 0; |
| my $matcher = sub (Num $x) { $count++; return $x % 2 }; |
√ | is(@list.first($matcher), 1, 'first() search for odd elements successfull'); |
× | is($count, 1, 'Matching closure in first() is only executed once'); |
| |
| } |
our Item multi method first ( @values: Matcher $test ) our Item multi first ( Matcher $test, *@values )
first works exactly like grep but returns only the first matching value.
From t/builtins/arrays_and_hashes/pick.t lines 15–44 (6 √, 5 ×): (skip)
| # L<S29/List/=item pick> |
| |
| my @array = <a b c d>; |
√ | ok ?(@array.pick eq any <a b c d>), "pick works on arrays"; |
| |
| my %hash = (a => 1); |
√ | is %hash.pick.key, "a", "pick works on hashes (1)"; |
√ | is %hash.pick.value, "1", "pick works on hashes (2)"; |
| |
| my $junc = (1|2|3); |
√ | ok ?(1|2|3 == $junc.pick), "pick works on junctions"; |
| |
| my @arr = <z z z>; |
| |
√ | is eval('@arr.pick(2)'), <z z>, 'method pick with $num < +@values'; |
√ | is eval('@arr.pick(4)'), <z z z>, 'method pick with $num > +@values'; |
× | is eval('@arr.pick(4, :repl)'), <z z z z>, 'method pick(:repl) with $num > +@values', :todo<feature>; |
| |
× | is eval('pick(2, @arr)'), <z z>, 'sub pick with $num < +@values', :todo<feature>; |
× | is eval('pick(4, @arr)'), <z z z>, 'sub pick with $num > +@values', :todo<feature>; |
× | is eval('pick(4, :repl, @arr)'), <z z z z>, 'sub pick(:repl) with $num > +@values', :todo<feature>; |
| |
| my $c = 0; |
| my @value = gather { |
| eval ' |
| for (0,1).pick(*, :repl) -> $v { take($v); leave if ++$c > 3; } |
| '; |
| } |
| |
× | ok +@value == $c && $c, 'pick(*, :repl) is lazy', :todo<feature>; |
our List multi method pick ( @values: Int $num = 1, Bool :$repl ) our List multi method pick ( @values: Whatever, Bool :$repl ) our List multi pick ( Int $num, Bool :$repl, *@values ) our List multi pick ( Whatever, Bool :$repl, *@values )
pick takes a list or array of values and returns a random selection of elements from the list (without replacement unless :repl is indicated). When selecting without replacement if * is specified as the number (or if the number of elements in the list is less than the specified number), all the available elements are returned in random order:
@team = @volunteers.pick(5);
@shuffled = @deck.pick(*);
When selecting with replacement the specified number of picks are provided. In this case * would provide an infinite list of random picks from @values:
@byte = (0,1).pick(8, :repl);
for (1..20).pick(*, :repl) -> $die_roll { ... }
From t/builtins/lists/join.t lines 5–110 (30 √, 1 ×): (skip)
| # L<S29/"List"/"=item join"> |
| |
| # test all variants of join() |
| |
√ | is(["a", "b", "c"].join("|"), "a|b|c", '[].join("|") works'); |
| |
| my @list = ("a", "b", "c"); |
| |
√ | is(@list.join("|"), "a|b|c", '@list.join("|") works'); |
| |
| my $joined2 = join("|", @list); |
√ | is($joined2, "a|b|c", 'join("|", @list) works'); |
| |
| my $joined3 = join("|", "a", "b", "c"); |
√ | is($joined3, "a|b|c", 'join("|", 1, 2, 3) works'); |
| |
| my $joined4 = join("|", [ "a", "b", "c" ]); |
√ | is($joined4, "a b c", 'join("|", []) should not join anything'); |
| |
| # join() with $sep as a variable |
| |
| my $sep = ", "; |
| |
√ | is(["a", "b", "c"].join($sep), "a, b, c", '[].join($sep) works'); |
| |
√ | is(@list.join($sep), "a, b, c", '@list.join($sep) works'); |
| |
| my $joined2a = join($sep, @list); |
√ | is($joined2a, "a, b, c", 'join($sep, @list) works'); |
| |
| my $joined3a = join($sep, "a", "b", "c"); |
√ | is($joined3a, "a, b, c", 'join($sep, "a", "b", "c") works'); |
| |
| my $joined4a = join($sep, [ "a", "b", "c" ]); |
√ | is($joined4a, "a b c", 'join($sep, []) works'); |
| |
| # join ... without parens |
| |
| my $joined2b = join $sep, @list; |
√ | is($joined2b, "a, b, c", 'join $sep, @list works'); |
| |
| my $joined2c = join ":", @list; |
√ | is($joined2c, "a:b:c", 'join ":", @list works'); |
| |
| my $joined3b = join $sep, "a", "b", "c"; |
√ | is($joined3b, "a, b, c", 'join $sep, "a", "b", "c" works'); |
| |
| my $joined3c = join ":", "a", "b", "c"; |
√ | is($joined3c, "a:b:c", 'join(":", "a", "b", "c") works'); |
| |
| my $joined4b = join $sep, [ "a", "b", "c" ]; |
√ | is($joined4b, "a b c", 'join $sep, [] should not join anything'); |
| |
| my $joined4c = join ":", [ "a", "b", "c" ]; |
√ | is($joined4c, "a b c", 'join ":", [] should not join anything'); |
| |
| # join() with empty string as seperator |
| |
√ | is(["a", "b", "c"].join(''), "abc", '[].join("") works'); |
| |
| my @list = ("a", "b", "c"); |
| |
√ | is(@list.join(''), "abc", '@list.join("") works'); |
| |
| my $joined2d = join('', @list); |
√ | is($joined2d, "abc", 'join("", @list) works'); |
| |
| my $joined3d = join('', "a", "b", "c"); |
√ | is($joined3d, "abc", 'join("", 1, 2, 3) works'); |
| |
| my $joined4d = join("", [ "a", "b", "c" ]); |
√ | is($joined4d, "a b c", 'join("", []) works'); |
| |
| # some odd edge cases |
| |
| my $undefined; |
| my @odd_list1 = (1, $undefined, 2, $undefined, 3); |
| |
| my $joined2e = join(':', @odd_list1); |
√ | is($joined2e, "1::2::3", 'join(":", @odd_list1) works'); |
| |
| my @odd_list2 = (1, undef, 2, undef, 3); |
| |
| my $joined2f = join(':', @odd_list2); |
√ | is($joined2f, "1::2::3", 'join(":", @odd_list2) works'); |
| |
| # should these even be tests ??? |
| |
| my $joined1d = ("a", "b", "c").join(''); |
√ | is($joined1d, "abc", '().join("") should dwim'); |
| |
| my $joined1 = ("a", "b", "c").join("|"); |
√ | is($joined1, "a|b|c", '().join("|") should dwim'); |
| |
| my $joined1a = ("a", "b", "c").join($sep); |
√ | is($joined1a, "a, b, c", '().join($sep) should dwim'); |
| |
√ | is(join("!", "hi"), "hi", "&join works with one-element lists (1)"); |
√ | is(join("!", <hi>), "hi", "&join works with one-element lists (2)"); |
√ | is(("hi",).join("!"), "hi", "&join works with one-element lists (3)"); |
| |
| # some error cases |
| |
√ | dies_ok({ join() }, 'join() must have arguments'); |
| # Similar as with .kv: (42).kv should die, but (42,).kv should work. |
× | dies_ok({ "hi".join("!") }, "join() should not work on strings", :todo<bug>); |
our Str multi method join ( $separator: @values ) our Str multi join ( Str $separator = ' ', *@values )
join returns a single string comprised of all of the elements of @values, separated by $separator.
Given an empty list, join returns the empty string.
The separator defaults to a single space. To join with no separator, you can use the [~] reduce operator. The cat function also effectively does a concatenation with no separator.
From t/builtins/lists/topic_in_map.t lines 5–15 (5 √, 0 ×): (skip)
| # L<S29/"List"/"=item map"> |
| |
| # Note: int is only an example, say and all other builtins which default to $_ |
| # don't work, either. |
√ | is ~((1,2,3).map:{ int $_ }), "1 2 3", "dependency for following test (1)"; |
√ | $_ = 4; is .int, 4, "dependency for following test (2)"; |
√ | is ~((1,2,3).map:{ .int }), "1 2 3", 'int() should default to $_ inside map, too'; |
| |
| # This works... |
√ | is ~(({1},{2},{3}).map:{ $_; $_() }), "1 2 3", 'lone $_ in map should work (1)'; |
√ | is ~(({1},{2},{3}).map:{ $_() }), "1 2 3", 'lone $_ in map should work (2)'; |
From t/builtins/lists/empty_list_in_map.t lines 5–58 (6 √, 1 ×): (skip)
| # L<S29/"List"/"=item map"> |
| |
| # Test was primarily aimed at PIL2JS, which did not pass this test (fixed now). |
| { |
| my @array = <a b c d>; |
| my @result = map { (), }, @array; |
| |
√ | is +@result, 0, "map works with the map body returning an empty list"; |
| } |
| |
| { |
| my @array = <a b c d>; |
| my @empty = (); |
| my @result = map { @empty }, @array; |
| |
√ | is +@result, 0, "map works with the map body returning an empty array"; |
| } |
| |
| { |
| my @array = <a b c d>; |
| my @result = map { [] }, @array; |
| |
√ | is +@result, 4, "map works with the map body returning an empty arrayref"; |
| } |
| |
| { |
| my @array = <a b c d>; |
| my $empty = []; |
| my @result = map { $empty }, @array; |
| |
× | is +@result, 4, "map works with the map body returning an empty arrayref variable", :todo<bug>; |
| } |
| |
| { |
| my @array = <a b c d>; |
| my @result = map { undef }, @array; |
| |
√ | is +@result, 4, "map works with the map body returning undef"; |
| } |
| |
| { |
| my @array = <a b c d>; |
| my $undef = undef; |
| my @result = map { $undef }, @array; |
| |
√ | is +@result, 4, "map works with the map body returning an undefined variable"; |
| } |
| |
| { |
| my @array = <a b c d>; |
| my @result = map { () }, @array; |
| |
√ | is +@result, 0, "map works with the map body returning ()"; |
| } |
From t/builtins/lists/map.t lines 5–143 (54 √, 2 ×): (skip)
| # L<S29/"List"/"=item map"> |
| |
| =kwid |
| |
| built-in map tests |
| |
| =cut |
| |
| |
| my @list = (1 .. 5); |
| |
| { |
| my @result = map { $_ * 2 }, @list; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], 2, 'got the value we expected'); |
√ | is(@result[1], 4, 'got the value we expected'); |
√ | is(@result[2], 6, 'got the value we expected'); |
√ | is(@result[3], 8, 'got the value we expected'); |
√ | is(@result[4], 10, 'got the value we expected'); |
| } |
| |
| { |
| my @result = @list.map():{ $_ * 2 }; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], 2, 'got the value we expected'); |
√ | is(@result[1], 4, 'got the value we expected'); |
√ | is(@result[2], 6, 'got the value we expected'); |
√ | is(@result[3], 8, 'got the value we expected'); |
√ | is(@result[4], 10, 'got the value we expected'); |
| } |
| |
| { |
| my @result = @list.map:{ $_ * 2 }; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], 2, 'got the value we expected'); |
√ | is(@result[1], 4, 'got the value we expected'); |
√ | is(@result[2], 6, 'got the value we expected'); |
√ | is(@result[3], 8, 'got the value we expected'); |
√ | is(@result[4], 10, 'got the value we expected'); |
| } |
| |
| { |
| my @result = map { $_ * 2 }: @list; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], 2, 'got the value we expected'); |
√ | is(@result[1], 4, 'got the value we expected'); |
√ | is(@result[2], 6, 'got the value we expected'); |
√ | is(@result[3], 8, 'got the value we expected'); |
√ | is(@result[4], 10, 'got the value we expected'); |
| } |
| |
| # Testing map that returns an array |
| { |
| my @result = map { ($_, $_ * 2) }, @list; |
√ | is(+@result, 10, 'we got a list back'); |
√ | is(@result[0], 1, 'got the value we expected'); |
√ | is(@result[1], 2, 'got the value we expected'); |
√ | is(@result[2], 2, 'got the value we expected'); |
√ | is(@result[3], 4, 'got the value we expected'); |
√ | is(@result[4], 3, 'got the value we expected'); |
√ | is(@result[5], 6, 'got the value we expected'); |
√ | is(@result[6], 4, 'got the value we expected'); |
√ | is(@result[7], 8, 'got the value we expected'); |
√ | is(@result[8], 5, 'got the value we expected'); |
√ | is(@result[9], 10, 'got the value we expected'); |
| } |
| |
| # Testing multiple statements in the closure |
| { |
| my @result = map { |
| my $fullpath = "fish/$_"; |
| $fullpath; |
| }, @list; |
√ | is(+@result, 5, 'we got a list back'); |
√ | is(@result[0], "fish/1", 'got the value we expected'); |
√ | is(@result[1], "fish/2", 'got the value we expected'); |
√ | is(@result[2], "fish/3", 'got the value we expected'); |
√ | is(@result[3], "fish/4", 'got the value we expected'); |
√ | is(@result[4], "fish/5", 'got the value we expected'); |
| } |
| |
| { |
| my @list = 1 .. 5; |
√ | is +(map {;$_ => 1 }, @list), 5, |
| 'heuristic for block - looks like a closure'; |
| |
| my %result = map {; $_ => ($_*2) }, @list; |
√ | isa_ok(%result, 'Hash'); |
√ | is(%result<1>, 2, 'got the value we expected'); |
√ | is(%result<2>, 4, 'got the value we expected'); |
√ | is(%result<3>, 6, 'got the value we expected'); |
√ | is(%result<4>, 8, 'got the value we expected'); |
√ | is(%result<5>, 10, 'got the value we expected'); |
| } |
| |
| # map with n-ary functions |
| { |
√ | is ~(1,2,3,4).map:{ $^a + $^b }, "3 7", "map() works with 2-ary functions"; |
√ | is ~(1,2,3,4).map:{ $^a + $^b + $^c }, "6 4", "map() works with 3-ary functions"; |
√ | is ~(1,2,3,4).map:{ $^a + $^b + $^c + $^d }, "10", "map() works with 4-ary functions"; |
√ | is ~(1,2,3,4).map:{ $^a+$^b+$^c+$^d+$^e }, "10", "map() works with 5-ary functions"; |
| } |
| |
| # .map shouldn't work on non-arrays |
| { |
× | dies_ok { 42.map:{ $_ } }, "method form of map should not work on numbers", :todo<bug>; |
× | dies_ok { "str".map:{ $_ } }, "method form of map should not work on strings", :todo<bug>; |
√ | is ~(42,).map:{ $_ }, "42", "method form of map should work on arrays"; |
| } |
| |
| =pod |
| |
| Test that a constant list can have C<map> applied to it. |
| |
| ("foo","bar").map:{ $_.substr(1,1) } |
| |
| should be equivalent to |
| |
| my @val = ("foo","bar"); |
| @val = map { substr($_,1,1) }, @val; |
| |
| =cut |
| |
| { |
| my @expected = ("foo","bar"); |
| @expected = map { substr($_,1,1) }: @expected; |
| |
√ | is(("foo","bar").map:{ $_.substr(1,1) }, @expected, "map of constant list works"); |
| } |
| |
| { |
| my @a = (1, 2, 3); |
| my @b = map { hash {"v"=>$_, "d" => $_*2} }, @a; |
| is(+@b,3, "should be 3 elemens"); |
| |
| my @c = map { {"v"=>$_, "d" => $_*2} }, @a; |
| is(+@c,3, "should be 3 elemens without the hash keyword as well", :todo); |
| } |
| |
From t/builtins/lists/map_with_signature.t lines 5–15 (4 √, 0 ×): (skip)
| # L<S29/"List"/"=item map"> |
| |
| my @a=(1,4,2,5,3,6); |
| my @ret=map -> $a,$b {$a+$b}, @a; |
| # should be (5,7,9), rigt now it is (1,4,2,5,3,6): map doesn't look at the signature |
| |
√ | is(@ret.elems,3,'map took 2 elements at a time'); |
√ | is(@ret[0],5,'first element ok'); |
√ | is(@ret[1],7,'second element ok'); |
√ | is(@ret[2],9,'third element ok'); |
| |
From t/builtins/lists/map_function_return_values.t lines 5–14 (2 √, 0 ×): (skip)
| # L<S29/"List"/"=item map"> |
| |
| my $text = "abc"; |
| my %ret; |
| |
| %ret = map { $_ => uc $_; }, split "", $text; |
√ | is ~%ret.kv, "a A b B c C", "=> works in a map block"; |
| |
| %ret = map { $_, uc $_ }, split "", $text; |
√ | is ~%ret.kv, "a A b B c C", "map called with function return values works"; |
From t/builtins/lists/flattening_in_map.t lines 5–14 (3 √, 0 ×): (skip)
| # L<S29/"List"/"=item map"> |
| |
| my @foo = [1, 2, 3].map:{ [100+$_, 200+$_] }; |
| # @foo should be: [ [101,201], [102,202], [103,203] ] |
| # It is: [ 101,201, 102,202, 103,203 ] |
| # (At least I *think* Pugs' current behaviour is wrong. If it isn't, but I am |
| # -- how do I construct an AoA then?) |
√ | is +@foo, 3, "map should't flatten our arrayref (1)"; |
√ | is +@foo[0], 2, "map should't flatten our arrayref (2)"; |
√ | is ~@foo[0], "101 201", "map should't flatten our arrayref (3)"; |
our List of Capture multi method map ( @values: Code *&expression ) our List of Capture multi map ( Code $expression, *@values )
map returns a lazily evaluated list which is comprised of the return value of the expression, evaluated once for every one of the @values that are passed in.
Here is an example of its use:
@addresses = map { %addresses_by_name<$_> }, @names;
Here we take an array of names, and look each name up in %addresses_by_name in order to build the corresponding list of addresses.
If the expression returns no values or multiple values, then the resulting list may not be the same length as the number of values that were passed. For example:
@factors = map { prime_factors($_) }, @composites;
The actual return value is a multislice containing one slice per map iteration. In most contexts these slices are flattened into a single list.
From t/builtins/lists/reduce.t lines 16–53 (9 √, 2 ×): (skip)
| # L<S29/List/=item reduce> |
| |
| { |
| my @array = <5 -3 7 0 1 -9>; |
| my $sum = 5 + -3 + 7 + 0 + 1 + -9; # laziness :) |
| |
√ | is((reduce { $^a + $^b }, 0, @array), $sum, "basic reduce works (1)"); |
√ | is((reduce { $^a + $^b }: 100, @array), 100 + $sum, "basic reduce works (2)"); |
√ | is(({ $^a * $^b }.reduce: 1,2,3,4,5), 120, "basic reduce works (3)"); |
| } |
| |
| # Reduce with n-ary functions |
| { |
| my @array = <1 2 3 4 5 6 7 8>; |
| my $result = (((1 + 2 * 3) + 4 * 5) + 6 * 7) + 8 * undef; |
| |
√ | is @array.reduce:{ $^a + $^b * $^c }, $result, "n-ary reduce() works"; |
| } |
| |
| # .reduce shouldn't work on non-arrays |
| { |
× | dies_ok { 42.reduce:{ $^a + $^b } }, "method form of reduce should not work on numbers", :todo<bug>; |
× | dies_ok { "str".reduce:{ $^a + $^b } }, "method form of reduce should not work on strings", :todo<bug>; |
√ | is (42,).reduce:{ $^a + $^b }, 42, "method form of reduce should work on arrays"; |
| } |
| |
| { |
| my $hash = {a => {b => {c => 42}}}; |
| my @reftypes; |
| sub foo (Hash $hash, String $key) { |
| push @reftypes, $hash.WHAT; |
| $hash.{$key}; |
| } |
√ | is((reduce(&foo, $hash, <a b c>)), 42, 'reduce(&foo) (foo ~~ .{}) works three levels deep'); |
√ | is(@reftypes[0], "Hash", "first application of reduced hash subscript passed in a Hash"); |
√ | is(@reftypes[1], "Hash", "second application of reduced hash subscript passed in a Hash"); |
√ | is(@reftypes[2], "Hash", "third application of reduced hash subscript passed in a Hash"); |
| } |
our Item multi method reduce ( @values: Code *&expression )
our Item multi reduce ( Code $expression ;; *@values ) {
my $res;
for @values -> $cur {
FIRST {$res = $cur; next;}
$res = &$expression($res, $cur);
}
$res;
}
From t/spec/S29-list/reverse.t lines 4–34 (no results): (skip)
| # L<S29/List/"=item reverse">
|
|
|
| =pod
|
|
|
| Basic test for the reverse() builtin with a string (Str).
|
|
|
| =cut
|
|
|
| plan 44;
|
|
|
| # As a function :
|
| is( reverse('Pugs'), 'sguP', "as a function");
|
|
|
| # As a method :
|
| is( "".reverse, "", "empty string" );
|
| is( 'Hello World !'.reverse, '! dlroW olleH', "literal" );
|
|
|
| # On a variable ?
|
| my Str $a = 'Hello World !';
|
| is( $a.reverse, '! dlroW olleH', "with a Str variable" );
|
| is( $a, 'Hello World !', "reverse should not be in-place" );
|
| is( $a .= reverse, '! dlroW olleH', "after a .=reverse" );
|
|
|
| # Multiple iterations (don't work in 6.2.12) :
|
| is( 'Hello World !'.reverse.reverse, 'Hello World !',
|
| "two reverse in a row." );
|
|
|
| # Reverse with unicode :
|
| is( '䀻«'.reverse, '«»€ä', "some unicode characters" );
|
|
|
|
|
From t/spec/S29-list/reverse.t lines 35–149 (no results): (skip)
| # L<S29/"List"/"=item reverse">
|
|
|
| =kwid
|
|
|
| Tests for "reverse" builtin with lists.
|
|
|
| NOTE: "reverse" is no longer context-sensitive. See S29.
|
|
|
| =cut
|
|
|
|
|
| my @a = reverse(1, 2, 3, 4);
|
| my @e = (4, 3, 2, 1);
|
|
|
| is(@a, @e, "list was reversed");
|
|
|
| my $a = reverse("foo");
|
| is($a, "oof", "string was reversed");
|
|
|
| @a = item(reverse("foo"));
|
| is(@a[0], "oof", 'the string was reversed');
|
| @a = list(reverse("foo"));
|
| is(@a[0], "oof", 'the string was reversed even under list context');
|
|
|
| @a = reverse(~("foo", "bar"));
|
| is(@a[0], "rab oof", 'the stringified array was reversed (stringwise)');
|
| @a = list reverse "foo", "bar";
|
| is(+@a, 2, 'the reversed list has two elements');
|
| is(@a[0], "bar", 'the list was reversed properly');
|
|
|
| is(@a[1], "foo", 'the list was reversed properly');
|
|
|
| {
|
| my @cxt_log;
|
|
|
| class Foo {
|
| my @.n;
|
| method foo () {
|
| push @cxt_log, want();
|
| (1, 2, 3)
|
| }
|
| method bar () {
|
| push @cxt_log, want();
|
| return @!n = do {
|
| push @cxt_log, want();
|
| reverse self.foo;
|
| }
|
| }
|
| }
|
|
|
| my @n = do {
|
| push @cxt_log, want();
|
| Foo.new.bar;
|
| };
|
|
|
| #?pugs: todo('bug', 1);
|
| is(~@cxt_log, ~("List (Any)" xx 4), "contexts were passed correctly around masak's bug");
|
| is(+@n, 3, "list context reverse in masak's bug");
|
| is(~@n, "3 2 1", "elements seem reversed");
|
| }
|
|
|
| {
|
| my @a = "foo";
|
| my @b = @a.reverse;
|
| isa_ok(@b, 'List');
|
| my $b = @a.reverse;
|
| isa_ok($b, 'List');
|
| is(@b[0], "foo", 'our list is reversed properly');
|
| is($b, "foo", 'in scalar context it is still a list');
|
| is(@a[0], "foo", "original array left untouched");
|
| @a .= reverse;
|
| is(@a[0], "foo", 'in place reversal works');
|
| }
|
|
|
| {
|
| my @a = ("foo", "bar");
|
| my @b = @a.reverse;
|
| isa_ok(@b, 'List');
|
| my $b = @a.reverse;
|
| isa_ok($b, 'List');
|
| is(@b[0], "bar", 'our array is reversed');
|
| is(@b[1], "foo", 'our array is reversed');
|
|
|
| is($b, "bar foo", 'in scalar context it is still a list');
|
|
|
| is(@a[0], "foo", "original array left untouched");
|
| is(@a[1], "bar", "original array left untouched");
|
|
|
| @a .= reverse;
|
| is(@a[0], "bar", 'in place reversal works');
|
| is(@a[1], "foo", 'in place reversal works');
|
| }
|
|
|
| {
|
| my $a = "foo";
|
| my @b = $a.reverse;
|
| isa_ok(@b, 'Array');
|
| my $b = $a.reverse;
|
| isa_ok($b, 'Str');
|
|
|
| is(@b[0], "oof", 'string in the array has been reversed');
|
| is($b, "oof", 'string has been reversed');
|
| is($a, "foo", "original scalar left untouched");
|
| $a .= reverse;
|
| is($a, "oof", 'in place reversal works on strings');
|
| }
|
|
|
| {
|
| my $a = "foo".reverse;
|
| my @b = "foo".reverse;
|
| isa_ok($a, 'Str');
|
| isa_ok(@b, 'Array');
|
| is($a, "oof", 'string literal reversal works in scalar context');
|
| is(@b[0], "oof", 'string literal reversal works in list context');
|
| }
|
role Hash {
our Hash multi method reverse ( %hash: ) is export {
(my %result){%hash.values} = %hash.keys;
%result;
}
}
our List multi method reverse ( @values: ) is export
our List multi reverse ( *@values ) {
gather {
1 while take pop @values;
}
}
role Str {
our Str multi method reverse ( $str: ) is export {
$str.split('').reverse.join;
}
}
From t/builtins/lists/sort.t lines 5–156 (19 √, 2 ×): (skip)
| # L<S29/"List"/"=item sort"> |
| |
| { |
| my @a = (4, 5, 3, 2, 5, 1); |
| my @e = (1 .. 5, 5); |
| |
| my @s = sort(@a); |
√ | is(@s, @e, 'array of numbers was sorted'); |
| } |
| |
| { |
| my @a = (4, 5, 3, 2, 5, 1); |
| my @e = (1 .. 5, 5); |
| |
| my @s = sort @a; |
√ | is(@s, @e, 'array of numbers was sorted (w/out parans)'); |
| } |
| |
| { |
| my @a = (4, 5, 3, 2, 5, 1); |
| my @e = (1 .. 5, 5); |
| |
| my @s = @a.sort; |
√ | is(@s, @e, 'array of numbers was sorted (using invocant form)'); |
| } |
| |
| { |
| my @a = (2, 45, 6, 1, 3); |
| my @e = (1, 2, 3, 6, 45); |
| |
| my @s = sort { $^a <=> $^b }, @a; |
√ | is(@s, @e, '... with explicit spaceship'); |
| } |
| |
| { |
| my @a = (2, 45, 6, 1, 3); |
| my @e = (1, 2, 3, 6, 45); |
| |
| my @s = sort { $^a <=> $^b }: @a; |
√ | is(@s, @e, '... with closure as indirect invocant'); |
| } |
| |
| { |
| my @a = (2, 45, 6, 1, 3); |
| my @e = (1, 2, 3, 6, 45); |
| |
| my @s = { $^a <=> $^b }.sort: @a; |
√ | is(@s, @e, '... with closure as direct invocant'); |
| } |
| |
| { |
| my @a = (2, 45, 6, 1, 3); |
| my @e = (1, 2, 3, 6, 45); |
| |
| my @s = @a.sort:{ $^a <=> $^b }; |
√ | is(@s, @e, '... with explicit spaceship (using invocant form)'); |
| } |
| |
| { |
| my @a = (2, 45, 6, 1, 3); |
| my @e = (45, 6, 3, 2, 1); |
| |
| my @s = sort { $^b <=> $^a }, @a; |
√ | is(@s, @e, '... reverse sort with explicit spaceship'); |
| } |
| |
| { |
| my @a = (2, 45, 6, 1, 3); |
| my @e = (45, 6, 3, 2, 1); |
| |
| my @s = @a.sort:{ $^b <=> $^a }; |
√ | is(@s, @e, '... reverse sort with explicit spaceship (using invocant form)'); |
| } |
| |
| { |
| my @a = <foo bar gorch baz>; |
| my @e = <bar baz foo gorch>; |
| |
| my @s = sort(@a); |
√ | is(@s, @e, 'array of strings was sorted'); |
| } |
| |
| { |
| my @a = <foo bar gorch baz>; |
| my @e = <bar baz foo gorch>; |
| |
| my @s = sort @a; |
√ | is(@s, @e, 'array of strings was sorted (w/out parans)'); |
| } |
| |
| { |
| my @a = <foo bar gorch baz>; |
| my @e = <bar baz foo gorch>; |
| |
| my @s = @a.sort; |
√ | is(@s, @e, 'array of strings was sorted (using invocant form)'); |
| } |
| |
| { |
| my @a = <daa boo gaa aaa>; |
| my @e = <aaa boo daa gaa>; |
| |
| my @s = sort { $^a cmp $^b }, @a; |
√ | is(@s, @e, '... with explicit cmp'); |
| } |
| |
| { |
| my @a = <daa boo gaa aaa>; |
| my @e = <aaa boo daa gaa>; |
| |
| my @s = @a.sort:{ $^a cmp $^b }; |
√ | is(@s, @e, '... with explicit cmp (using invocant form)'); |
| } |
| |
| { |
| my %a = (4 => 'a', 1 => 'b', 2 => 'c', 5 => 'd', 3 => 'e'); |
| my @e = (4, 1, 2, 5, 3); |
| |
| my @s = sort { %a{$^a} cmp %a{$^b} }, %a.keys; |
√ | is(@s, @e, '... sort keys by string value'); |
| } |
| |
| { |
| my %a = (4 => 'a', 1 => 'b', 2 => 'c', 5 => 'd', 3 => 'e'); |
| my @e = (4, 1, 2, 5, 3); |
| |
| my @s = %a.keys.sort:{ %a{$^a} cmp %a{$^b} }; |
√ | is(@s, @e, '... sort keys by string value (using invocant form)'); |
| } |
| |
| { |
| my %a = ('a' => 4, 'b' => 1, 'c' => 2, 'd' => 5, 'e' => 3); |
| my @e = <b c e a d>; |
| |
| my @s = sort { %a{$^a} <=> %a{$^b} }, %a.keys; |
√ | is(@s, @e, '... sort keys by numeric value'); |
| } |
| |
| { |
| my %a = ('a' => 4, 'b' => 1, 'c' => 2, 'd' => 5, 'e' => 3); |
| my @e = <b c e a d>; |
| |
| my @s = %a.keys.sort:{ %a{$^a} <=> %a{$^b} }; |
√ | is(@s, @e, '... sort keys by numeric value (using invocant form)'); |
| } |
| |
| # .sort shouldn't work on non-arrays |
| { |
× | dies_ok { 42.sort:{ 0 } }, "method form of sort should not work on numbers", :todo<bug>; |
× | dies_ok { "str".sort:{ 0 } }, "method form of sort should not work on strings", :todo<bug>; |
√ | is ~(42,).sort:{ 0 }, "42", "method form of sort should work on arrays"; |
| } |
From t/unspecced/sort.t lines 30–512 (no results): (skip)
| # L<S29/"List"/"=item sort"> |
| |
| my $prelude_sort = q:to'END_PRELUDE_SORT'; |
| subset KeyExtractor of Code where { .sig === :(Any --> Any) }; |
| subset Comparator of Code where { .sig === :(Any, Any --> Int) }; |
| subset OrderingPair |
| of Pair where { .key ~~ KeyExtractor && .value ~~ Comparator }; |
| subset Ordering |
| of Signature | KeyExtractor | Comparator | OrderingPair; |
| |
| module Prelude::Sort { |
| our Order |
| sub qby_cmp (Code @qby, $a, $b) |
| { |
| my $result = Order::Same; |
| my &return_ifn0 ::= -> $v { if $v { $result = $v; leave LOOP; } }; |
| |
| LOOP: for @by -> $cmpr { |
| return_ifn0 $cmpr($a, $b); |
| } |
| |
| $result; |
| } |
| |
| our bool |
| sub in_order (Code @qby, *$x, *@xs) |
| { |
| my $result = 1; |
| my $y := $x; |
| |
| for @xs -> $z { |
| if by_cmp(@qby, $y, $z) > 0 { |
| $result = 0; |
| last; |
| } |
| |
| $y := $z; |
| } |
| |
| $result; |
| } |
| |
| our Array of Code |
| sub qualify_by (Ordering @by) |
| { |
| my Any sub keyex (KeyExtractor $ex, Any $v) is cached |
| { $ex($v); } |
| |
| my Array sub sigkex (Signature $sig is copy, Any $v) is cached |
| { $sig := $v; @$sig; } |
| |
| gather { |
| for @by -> $criterion { |
| when Signature { |
| my Signature $sig := $crierion; |
| my Array &kex := &sigkex; |
| |
| my $cmpr -> $a, $b { |
| my $value; |
| |
| for zip(@$a; @$b; @$sig) -> $x, $y, ::T { |
| my $u; |
| my $v; |
| |
| if ( ::T ~~ canonicalized ) { |
| $u = ::T.canonicalized.($x); |
| $v = ::T.canonicalized.($y); |
| } |
| else { |
| $u := $x; |
| $v := $y; |
| } |
| |
| last if $value = $u cmp $v; |
| } |
| |
| $value; |
| } |
| |
| if ( $sig ~~ descending ) { |
| $cmpr = -> $a, $b { $cmpr($b, $a) }; |
| } |
| |
| take( -> $a, $b { |
| $cmpr(kex($sig, $a), kex($sig, $b)) |
| }); |
| } |
| |
| when KeyExtractor { |
| my KeyExtractor $ex := $criterion; |
| my &kex := &keyex; |
| |
| my $cmpr = &cmp; |
| |
| if ( $ex ~~ canonicalized ) { |
| $cmpr = -> $a is copy, $b is copy { |
| $a = $ex.canonicalized.($a); |
| $b = $ex.canonicalized.($b); |
| $cmpr($a, $b) |
| }; |
| } |
| |
| if ( $ex ~~ descending ) { |
| $cmpr = -> $a, $b { $cmpr($b, $a) }; |
| } |
| |
| take( -> $a, $b { $cmpr(kex($ex, $a), kex($ex, $b)) } ); |
| } |
| |
| when Comparator { |
| my Comparator $cmpr = $criterion; |
| |
| if ( $criterion ~~ insensitive ) { |
| $cmpr = -> $a, $b { |
| $a = $criterion.canonicalized.($a); |
| $b = $criterion.canonicalized.($b); |
| $cmpr($a, $b) |
| }; |
| } |
| |
| if ( $criterion ~~ descending ) { |
| $cmpr = -> $a, $b { $cmpr($b, $a) }; |
| } |
| |
| take($cmpr); |
| } |
| |
| when Pair { |
| my OrderingPair $scp := $criterion; |
| my &kex := &keyex; |
| |
| my KeyExtractor $ex = $scp.key; |
| my Comparator $cmpr = $scp.value; |
| |
| if ( $pair ~~ canonicalized ) { |
| $cmpr = -> $a, $b { |
| $a = $pair.canonicalized.($a); |
| $b = $pair.canonicalized.($b); |
| $cmpr($a, $b) |
| }; |
| } |
| |
| if ( $pair ~~ descending ) { |
| $cmpr = -> $a, $b { $cmpr($b, $a) }; |
| } |
| |
| take( -> $a, $b { $cmpr(kex($ex, $a), kex($ex, $b)) } ); |
| } |
| } |
| } |
| } |
| |
| # mergesort() -- |
| # O(N*log(N)) time |
| # O(N*log(N)) space |
| # stable |
| |
| our Array |
| sub mergesort (@values is rw, Ordering @by? = list(&infix:<cmp>), |
| Bit $inplace?) |
| { |
| my @result; |
| |
| my @qby = qualify_by(@by); |
| |
| if $inplace { |
| inplace_mergesort(@values, 0 => +@values, @qby); |
| @result := @values; |
| } |
| else { |
| my @copy = @values; |
| inplace_mergesort(@copy, 0 => +@copy, @qby); |
| @result := @copy; |
| } |
| |
| @result; |
| } |
| |
| our Pair |
| sub inplace_mergesort (@values is rw, Pair $span, Code @qby) |
| { |
| my $result = $span; |
| |
| unless ( $span.value - $span.key == 1 || in_order(@qby, @values) ) { |
| my $mid = $span.key + int( ($span.value - $span.key)/ 2 ); |
| |
| $result = merge( |
| @values, |
| inplace_mergesort(@values, $span.key => $mid, @qby), |
| inplace_mergesort(@values, $mid => $span.value, @qby), |
| @qby |
| ); |
| } |
| |
| $result; |
| } |
| |
| our Pair |
| sub merge (@values is rw, Pair $lspan, Pair $rspan, Code @qby) |
| { |
| # copy @left to a scratch area |
| my @scratch = @values[$lspan.key ..^ $lspan.value]; |
| |
| # merge @scratch and @right into and until @left is full |
| my $lc = $lspan.key; |
| my $rc = $rspan.key; |
| my $sc = 0; |
| |
| while ( $lc < $lspan.value ) { |
| @values[$lc++] = by_cmp(@qby, @scratch[$sc], @values[$rc]) <= 0 |
| ?? @scratch[$sc++] |
| !! @values[$rc++]; |
| } |
| |
| # at this point @left is full. start populating @right |
| # until @scratch or @right is empty |
| my $ri = $rspan.key; |
| |
| while ( $sc < +@scratch && $rc < $rspan.value ) { |
| @values[$ri++] = by_cmp(@qby, @scratch[$sc], @values[$rc]) <= 0 |
| ?? @scratch[$sc++] |
| !! @values[$rc++]; |
| } |
| |
| # anything remaining in @right is in the correct place. |
| # anything remaining in @scratch needs to be filled into @right |
| @values[$ri..^$rspan.value] = @scratch[$sc..^+@scratch]; |
| |
| # return the merged span |
| $lspan.key => $rspan.value; |
| } |
| } |
| |
| our Array multi Array::p6sort( @values is rw, *&by, Bit $inplace? ) |
| { |
| Prelude::Sort::mergesort(@values, list(&by), $inplace); |
| } |
| |
| our Array multi Array::p6sort( @values is rw, Ordering @by, Bit $inplace? ) |
| { |
| Prelude::Sort::mergesort(@values, @by, $inplace); |
| } |
| |
| our Array multi Array::p6sort( @values is rw, Ordering $by = &infix:<cmp>, |
| Bit $inplace? ) |
| { |
| Array::sort(@values, $by, $inplace); |
| } |
| |
| our List multi List::p6sort( Ordering @by, *@values ) |
| { |
| my @result = Prelude::Sort::mergesort(@values, @by); |
| @result[]; |
| } |
| |
| our List multi List::p6sort( Ordering $by = &infix:<cmp>, *@values ) |
| { |
| my @result = Prelude::Sort::mergesort(@values, list($by)); |
| @result[]; |
| } |
| END_PRELUDE_SORT |
| |
| ok(eval($prelude_sort), 'prelude sort parses', :todo<sort>, |
| :depends<subset and argument list return signatures>); |
| |
| ## tests |
| |
| ## sample() -- return a random sample of the input |
| sub sample (:$count, :$resample, *@data) |
| { |
| my $max = $count ?? $count !! +@data; |
| |
| return gather { |
| if ! ( $resample ) { |
| my @copy = @data; |
| |
| loop (my $i = 0; $i < $max; ++$i ) { |
| take( @copy.splice(int rand(+@copy), 1) ); |
| } |
| } |
| else { |
| loop (my $i = 0; $i < $max; ++$i ) { |
| take( @data[rand(+@data)] ); |
| } |
| } |
| } |
| } |
| |
| my @num = sample 1..26; |
| my @str = sample 'a'..'z'; |
| my @num_as_str = sample( '' >>~<< @num); |
| |
| my @sorted_num = 1..26; |
| my @sorted_str = 'a'..'z'; |
| my @sorted_num_as_str = |
| <1 10 11 12 13 14 15 16 17 18 19 2 20 21 22 23 24 25 26 3 4 5 6 7 8 9>; |
| |
| class Thingy { |
| has $.name; |
| } |
| |
| my @sorted_things = map { Thingy.new( :name($_) ) }, |
| ( reverse('N'..'Z'), reverse('a'..'m') ); |
| |
| my @unsorted_things = sample(@sorted_things); |
| |
| { |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort @str;'), 'parse of p6sort', |
| :todo<feature>); |
| |
| ok(@sorted eqv @sorted_str, 'string ascending; default cmp', |
| :todo, :depends<p6sort>); |
| } |
| |
| { |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort { $^a <=> $^b }, @num;'), 'parse of p6sort', |
| :todo<feature>); |
| |
| ok(@sorted eqv @sorted_num, 'number ascending; Comparator', |
| :todo, :depends<p6sort>); |
| } |
| |
| { |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort { lc $^b.name cmp lc $^a.name }, @unsorted_things;'), |
| 'parse of p6sort', :todo<feature>); |
| |
| ok(@sorted eqv reverse(@sorted_things), 'string descending; Comparator', |
| :todo, :depends<p6sort>); |
| } |
| |
| { |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort { $^b.name cmp $^a.name } is insensitive, @str;'), |
| 'parse trait on block closure', |
| :todo<feature>, |
| :depends<traits on block closures>); |
| |
| |
| ok(@sorted eqv reverse(@sorted_str), |
| 'string descending; Comparator is insensitive', |
| :todo, :depends<p6sort>); |
| } |
| |
| { |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort { $^a.name cmp $^b.name } is descending is insensitive, @str;'), |
| 'parse trait on block closure', |
| :todo<feature>, |
| :depends<traits on block closures>); |
| |
| ok(@sorted eqv reverse(@sorted_str), |
| 'string descending; Comparator is descending is insensitive', |
| :todo, :depends<p6sort>); |
| } |
| |
| # TODO: Modtimewise numerically ascending... |
| # |
| # my @files = sample { ... }; |
| # my @sorted_files = qx( ls -t @files[] ); |
| |
| { |
| # my @sorted = p6sort { $^a.:M <=> $^b.:M }, @files; |
| # |
| # ok(@sorted eqv @sorted_files, 'number ascending; Comparator', |
| # :todo<sort>); |
| |
| } |
| |
| sub fuzzy_cmp($x, $y) returns Int |
| { |
| if ( 10 >= $x < 20 && 10 >= $y < 20 ) { |
| return $y <=> $x; |
| } |
| |
| return $x <=> $y; |
| } |
| |
| { |
| my @answer = 5..9, reverse(10..19), 20..24; |
| my @unsorted = sample(@answer); |
| |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort &fuzzy_cmp, @unsorted;'), |
| 'parse of p6sort', :todo<feature>); |
| |
| ok(@sorted eqv @answer, 'number fuzzy; Comparator', :todo, |
| :depends<sort>); |
| } |
| |
| { |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort { + $^elem }, @num_as_str;'), |
| 'parse of p6sort', :todo<feature>); |
| |
| ok(@sorted eqv @sorted_num, |
| 'number ascending; KeyExtractor uses context', |
| :todo, :depends<p6sort>); |
| |
| ok(eval('@sorted = p6sort { + $_ }, @num_as_str;'), |
| 'parse of p6sort', :todo<feature>); |
| |
| ok(@sorted eqv @sorted_num, |
| 'number ascending; KeyExtractor uses $_', |
| :todo, :depends<p6sort>); |
| } |
| |
| class Thingy { |
| has $.name; |
| } |
| |
| my @sorted_things = map { Thingy.new( :name($_) ) }, |
| ( reverse('N'..'Z'), reverse('a'..'m') ); |
| |
| my @unsorted_things = sample(@sorted_things); |
| |
| { |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort { ~ $^elem.name } is descending is insensitive, @unsorted_things;'), |
| 'parse trait on block closure', |
| :todo<feature>, |
| :depends<traits on block closures>); |
| |
| ok(@sorted eqv @sorted_things, |
| 'string descending; KeyExtractor is descending is insensitive', |
| :todo, :depends<p6sort>); |
| |
| ok(eval('@sorted = p6sort { lc $^elem.name } is descending, @unsorted_things;'), |
| 'parse trait on block closure', |
| :todo<feature>, |
| :depends<traits on block closures>); |
| |
| ok(@sorted eqv @sorted_things, |
| 'string descending; KeyExtractor is descending uses context', |
| :todo, :depends<p6sort>); |
| |
| ok(eval('@sorted = p6sort { lc .name } is descending, @unsorted_things;'), |
| 'parse trait on block closure', |
| :todo<feature>, |
| :depends<traits on block closures>); |
| |
| ok(@sorted eqv @sorted_things, |
| 'string descending; KeyExtractor is descending uses dot', |
| :todo, :depends<p6sort>); |
| } |
| |
| { |
| # my @sorted = p6sort { .:M } @files; |
| # |
| # ok(@sorted eqv @sorted_files, 'number ascending; KeyExtractor', |
| # :todo<sort>); |
| } |
| |
| sub get_key ($elem) { return $elem.name; } |
| |
| { |
| my @sorted; |
| |
| ok(eval('@sorted = p6sort &get_key, @unsorted_things;'), |
| 'parse of p6sort', :todo<feature>); |
| |
| ok(@sorted eqv @sorted_things, |
| 'string ascending; KeyExtractor via sub', |
| :todo, :depends<p6sort>); |
| } |
| |
| my @numstr = sample( 1..3, 'A'..'C', 'x'..'z', 10..12 ); |
| my @sorted_di_numstr = list(<z y x>, <C B A>, reverse(1..3, 10..12)), |
| |
| { |
| my @sorted; |
| |
| # Not sure you can have traits on objects but |
From t/unspecced/sort.t lines 513–583 (0 √, 1 ×): (skip)
| # L<S29/List/=item sort> |
| # says that any Ordering can have `descending` and `canonicalized($how)` traits. |
| ok(eval('@sorted = p6sort ( { $_ } => { |
| given $^a { |
| when Num { |
| given $^b { |
| when Num { $^a <=> $^b } |
| default { $^a cmp $^b } |
| } |
| } |
| default { $^a cmp $^b } |
| } |
| }) is descending is canonicalized({$^v ~~ Str ?? lc($v) !! $v}), |
| @numstr;'), |
| 'parse trait on object', |
| :todo<feature>, |
| :depends<traits on objects>); |
| |
| ok(@sorted eqv @sorted_di_numstr, |
| 'Num|Str fuzzy; Pair is descending is insensitive', |
| :todo, :depends<p6sort>); |
| |
| # @sorted = p6sort { $_ ~~ :M } => { $^b cmp $^a }, @files; |
| # |
| # ok(@sorted eqv @sorted_modtime_cmp_files, |
| # 'string descending; Pair uses cmp', |
| # :todo<sort>); |
| # |
| # @sorted = p6sort { $_ ~~ :M } => &fuzzy_cmp, @files; |
| # |
| # ok(@sorted eqv @sorted_modtime_fuzzy_files, |
| # 'number fuzzy; Pair', |
| # :todo<sort>); |
| # |
| # @sorted = p6sort ( { $_ ~~ :M } => { $^a cmp $^b } ) is descending, @files; |
× | # |
| # ok(@sorted eqv @sorted_modtime_cmp_files, |
| # 'string descending; Pair is descending', |
| # :todo<sort>); |
| } |
| |
| { |
| # Need to think about this one to create a meaningful dataset. |
| # |
| # # Numerically ascending |
| # # or else namewise stringifically descending case-insensitive |
| # # or else modtimewise numerically ascending |
| # # or else namewise fuzz-ifically |
| # # or else fuzz-ifically... |
| # @sorted = p6sort [ {+ $^elem}, |
| # {$^b.name cmp $^a.name} is insensitive, |
| # {.TEST(:M)}, |
| # {.name}=>&fuzzy_cmp, |
| # &fuzzy_cmp, |
| # ], |
| # @unsorted; |
| # |
| # ok(@sorted eqv @sorted_whacky, 'obj whacky; @by', :todo<sort>); |
| } |
| |
| my @inplace = @str; |
| |
| { |
| ok(@inplace !eqv @sorted_str, 'sampled data differs from answer'); |
| |
| ok(eval('@inplace.p6sort(:inplace);', 'parse of p6sort with optional $inplace'), |
| :todo<feature>); |
| |
| ok(@inplace eqv @sorted_str, 'inplace sort on array', :todo, |
| :depends<p6sort>); |
| } |
our Array multi method sort( @values: *&by ) our Array multi method sort( @values: Ordering @by ) our Array multi method sort( @values: Ordering $by = &infix:<cmp> ) our List multi sort( Ordering @by, *@values ) our List multi sort( Ordering $by = &infix:<cmp>, *@values )
Returns @values sorted, using criteria $by or @by for comparisons. @by differs from $by in that each criterion is applied, in order, until a non-zero (tie) result is achieved.
Ordering is as described in "Type Declarations". Any Ordering may receive either or both of the mixins descending and canon(Code $how) to reverse the order of sort, or to adjust the case, sign, or other order sensitivity of cmp. (Mixins are applied to values using but.) If a Signature is used as an Ordering then sort-specific traits such as is canon($how) are allowed on the positional elements.
If all criteria are exhausted when comparing two elements, sort should return them in the same relative order they had in @values.
To sort an array in place use the .=sort mutator form.
See http://www.nntp.perl.org/group/perl.perl6.language/16578 for more details and examples (with is insensitive meaning is canonicalized(&lc).)
From t/builtins/lists/minmax.t lines 13–67 (22 √, 2 ×): (skip)
| L<S29/"List"/"=item min"> |
| L<S29/"List"/"=item max"> |
| =cut |
| |
| my @array = <5 -3 7 0 1 -9>; |
| |
| # Tests for C<min>: |
√ | is @array.min, -9, "basic method form of min works"; |
√ | is min(@array), -9, "basic subroutine form of min works"; |
| |
√ | is @array.min:{ $^a <=> $^b }, -9, |
| "method form of min with identity comparison block works"; |
√ | isnt @array.min:{ $^a <=> $^b }, 7, |
| "bug -- method form of min with identity comparison block returning max"; |
| |
√ | is min({ $^a <=> $^b }, @array), -9, |
| "subroutine form of min with identity comparison block works"; |
√ | isnt min({ $^a <=> $^b }, @array), 7, |
| "bug -- subroutine form of min with identity comparison block returning max"; |
| |
√ | is @array.min:{ abs $^a <=> abs $^b }, 0, |
| "method form of min taking a comparision block works"; |
√ | is min({ abs $^a <=> abs $^b }, @array), 0, |
| "subroutine form of min taking a comparision block works"; |
| |
| # Tests for C<max>: |
√ | is @array.max, 7, "basic method form of max works"; |
√ | is max(@array), 7, "basic subroutine form of max works"; |
| |
√ | is @array.max:{ $^a <=> $^b }, 7, |
| "method form of max with identity comparison block works"; |
√ | isnt @array.max:{ $^a <=> $^b }, -9, |
| "bug -- method form of max with identity comparison block returning min"; |
| |
√ | is max({ $^a <=> $^b }, @array), 7, |
| "subroutine form of max with identity comparison block works"; |
√ | isnt max({ $^a <=> $^b }, @array), -9, |
| "bug -- subroutine form of max with identity comparison block returning min"; |
| |
√ | is @array.max:{ abs $^a <=> abs $^b }, -9, |
| "method form of max taking a comparision block works"; |
√ | is max({ abs $^a <=> abs $^b }, @array), -9, |
| "subroutine form of max taking a comparision block works"; |
| |
| # Error cases: |
× | dies_ok { 42.max }, ".max should not work on scalars", :todo<bug>; |
× | dies_ok { 42.min }, ".min should not work on scalars", :todo<bug>; |
√ | is (42,).max, 42, ".max should work on one-elem arrays"; |
√ | is (42,).max, 42, ".max should work on one-elem arrays"; |
| |
| # Tests with literals: |
√ | is (1,2,3).max, 3, "method form of max with literals works"; |
√ | is (1,2,3).min, 1, "method form of min with literals works"; |
√ | is max(1,2,3), 3, "subroutine form of max with literals works"; |
√ | is min(1,2,3), 1, "subroutine form of min with literals works"; |
our Array multi method min( @values: *&by ) our Array multi method min( @values: Ordering @by ) our Array multi method min( @values: Ordering $by = &infix:<cmp> ) our List multi min( Ordering @by, *@values ) our List multi min( Ordering $by = &infix:<cmp>, *@values )
Returns the earliest (i.e., lowest index) minimum element of @values , using criteria $by or @by for comparisons. @by differs from $by in that each criterion is applied, in order, until a non-zero (tie) result is achieved.
Ordering is as described in "Type Declarations". Any Ordering may receive the mixin canonicalized(Code $how) to adjust the case, sign, or other order sensitivity of cmp. (Mixins are applied to values using but.) If a Signature is used as an Ordering then sort-specific traits such as is canonicalized($how) are allowed on the positional elements.
From t/builtins/lists/minmax.t lines 14–67 (22 √, 2 ×): (skip)
| L<S29/"List"/"=item max"> |
| =cut |
| |
| my @array = <5 -3 7 0 1 -9>; |
| |
| # Tests for C<min>: |
√ | is @array.min, -9, "basic method form of min works"; |
√ | is min(@array), -9, "basic subroutine form of min works"; |
| |
√ | is @array.min:{ $^a <=> $^b }, -9, |
| "method form of min with identity comparison block works"; |
√ | isnt @array.min:{ $^a <=> $^b }, 7, |
| "bug -- method form of min with identity comparison block returning max"; |
| |
√ | is min({ $^a <=> $^b }, @array), -9, |
| "subroutine form of min with identity comparison block works"; |
√ | isnt min({ $^a <=> $^b }, @array), 7, |
| "bug -- subroutine form of min with identity comparison block returning max"; |
| |
√ | is @array.min:{ abs $^a <=> abs $^b }, 0, |
| "method form of min taking a comparision block works"; |
√ | is min({ abs $^a <=> abs $^b }, @array), 0, |
| "subroutine form of min taking a comparision block works"; |
| |
| # Tests for C<max>: |
√ | is @array.max, 7, "basic method form of max works"; |
√ | is max(@array), 7, "basic subroutine form of max works"; |
| |
√ | is @array.max:{ $^a <=> $^b }, 7, |
| "method form of max with identity comparison block works"; |
√ | isnt @array.max:{ $^a <=> $^b }, -9, |
| "bug -- method form of max with identity comparison block returning min"; |
| |
√ | is max({ $^a <=> $^b }, @array), 7, |
| "subroutine form of max with identity comparison block works"; |
√ | isnt max({ $^a <=> $^b }, @array), -9, |
| "bug -- subroutine form of max with identity comparison block returning min"; |
| |
√ | is @array.max:{ abs $^a <=> abs $^b }, -9, |
| "method form of max taking a comparision block works"; |
√ | is max({ abs $^a <=> abs $^b }, @array), -9, |
| "subroutine form of max taking a comparision block works"; |
| |
| # Error cases: |
× | dies_ok { 42.max }, ".max should not work on scalars", :todo<bug>; |
× | dies_ok { 42.min }, ".min should not work on scalars", :todo<bug>; |
√ | is (42,).max, 42, ".max should work on one-elem arrays"; |
√ | is (42,).max, 42, ".max should work on one-elem arrays"; |
| |
| # Tests with literals: |
√ | is (1,2,3).max, 3, "method form of max with literals works"; |
√ | is (1,2,3).min, 1, "method form of min with literals works"; |
√ | is max(1,2,3), 3, "subroutine form of max with literals works"; |
√ | is min(1,2,3), 1, "subroutine form of min with literals works"; |
our Array multi method max( @values: *&by ) our Array multi method max( @values: Ordering @by ) our Array multi method max( @values: Ordering $by = &infix:<cmp> ) our List multi max( Ordering @by, *@values ) our List multi max( Ordering $by = &infix:<cmp>, *@values )
Returns the earliest (i.e., lowest index) maximum element of @values , using criteria $by or @by for comparisons. @by differs from $by in that each criterion is applied, in order, until a non-zero (tie) result is achieved.
Ordering is as described in "Type Declarations". Any Ordering may receive the mixin canonicalized(Code $how) to adjust the case, sign, or other order sensitivity of cmp. (Mixins are applied to values using but.) If a Signature is used as an Ordering then sort-specific traits such as is canonicalized($how) are allowed on the positional elements.
From t/builtins/hashes/isa.t lines 5–18 (2 √, 0 ×): (skip)
| # L<S29/"Hash"> |
| # there's probably a better smart link |
| |
| =kwid |
| |
| Isa tests |
| |
| =cut |
| |
| |
| { my %hash = <1 2 3 4>; |
√ | isa_ok(%hash, 'Hash'); |
√ | isa_ok(%hash, 'List'); |
| } |
The following are defined in the Hash role.
From t/spec/S29-hash/delete.t lines 6–22 (no results): (skip)
| # L<S29/"Hash"/=item delete>
|
| my %hash = (a => 1, b => 2, c => 3, d => 4);
|
| is +%hash, 4, "basic sanity (2)";
|
| is ~%hash.delete("a"), "1",
|
| "deletion of a hash element returned the right value";
|
| is +%hash, 3, "deletion of a hash element";
|
| is ~%hash.delete("c", "d"), "3 4",
|
| "deletion of hash elements returned the right values";
|
| is +%hash, 1, "deletion of hash elements";
|
| ok !defined(%hash{"a"}), "deleted hash elements are really deleted";
|
|
|
| {
|
| my $a = 1;
|
| try { delete $a; };
|
| like($!, rx:P5/Argument is not a Hash or Array element or slice/, "expected message for mis-use of delete");
|
| }
|
|
|
our List method :delete ( %hash: *@keys ) our Scalar method :delete ( %hash: $key ) is default
Deletes the elements specified by $key or $keys from the invocant. returns the value(s) that were associated to those keys:
@deleted = %foo.:delete{ @keys }
From t/builtins/hashes/exists.t lines 5–32 (8 √, 0 ×): (skip)
| # L<S29/"Hash"/"=item exists"> |
| |
| sub gen_hash { |
| my %h{'a'..'z'} = (1..26); |
| return %h; |
| }; |
| |
| { |
| my %h1 = gen_hash; |
| my %h2 = gen_hash; |
| |
| my $b = %h1<b>; |
√ | is (exists %h1, 'a'), 1, "Test existance for singe key. (Indirect notation)"; |
√ | is (%h1.exists('a')), 1, "Test existance for singe key. (method call)"; |
| }; |
| |
| { |
| my %h; |
| %h<none> = 0; |
| %h<one> = 1; |
| %h<nothing> = undef; |
√ | is %h.exists('none'), 1, "Existance of single key with 0 as value: none"; |
√ | is %h.exists('one'), 1, "Existance of single key: one"; |
√ | is %h.exists('nothing'), 1, "Existance of single key with undef as value: nothing"; |
√ | is defined(%h<none>), 1, "Defined 0 value for key: none"; |
√ | is defined(%h<one>), 1, "Defined 1 value for key: one"; |
√ | is defined(%h<nothing>), '', "NOT Defined value for key: nothing"; |
| } |
From t/spec/S29-hash/exists.t lines 12–47 (no results): (skip)
| # L<S29/"Hash"/=item exists>
|
| my %hash = (a => 1, b => 2, c => 3, d => 4);
|
| ok %hash.exists("a"), "exists on hashes (1)";
|
| ok !%hash.exists("42"), "exists on hashes (2)";
|
|
|
| # This next group added by Darren Duncan following discovery while debugging ext/Locale-KeyedText:
|
| # Not an exists() test per se, but asserts that elements shouldn't be added to
|
| # (exist in) a hash just because there was an attempt to read nonexistent elements.
|
| {
|
| sub foo( $any ) {}
|
| sub bar( $any is copy ) {}
|
|
|
| my $empty_hash = hash();
|
| is( $empty_hash.pairs.sort.join( ',' ), '', "empty hash stays same when read from (1)" );
|
| $empty_hash{'z'};
|
| is( $empty_hash.pairs.sort.join( ',' ), '', "empty hash stays same when read from (2)" );
|
| bar( $empty_hash{'y'} );
|
| is( $empty_hash.pairs.sort.join( ',' ), '', "empty hash stays same when read from (3)" );
|
| my $ref = \( $empty_hash{'z'} );
|
| is( $empty_hash.pairs.sort.join( ',' ), '', "taking a reference to a hash element does not auto-vivify the element");
|
| foo( $empty_hash{'x'} );
|
| is( $empty_hash.pairs.sort.join( ',' ), '', "empty hash stays same when read from (4)", :todo<bug> );
|
|
|
| my $popul_hash = hash(('a'=>'b'),('c'=>'d'));
|
| my sub popul_hash_contents () {
|
| $popul_hash.pairs.sort.map:{ $_.key ~ ":" ~ $_.value }.join( ',' );
|
| }
|
|
|
| is( popul_hash_contents, "a:b,c:d", "populated hash stays same when read from (1)" );
|
| $popul_hash{'z'};
|
| is( popul_hash_contents, "a:b,c:d", "populated hash stays same when read from (2)" );
|
| bar( $popul_hash{'y'} );
|
| is( popul_hash_contents, "a:b,c:d", "populated hash stays same when read from (3)" );
|
| foo( $popul_hash{'x'} );
|
| is( popul_hash_contents, "a:b,c:d", "populated hash stays same when read from (4)", :todo<bug> );
|
| }
|
our Bool method :exists ( %hash: $key )
True if invocant has an element whose key matches $key, false otherwise.
See also Code::exists to determine if a function has been declared. (Use defined() to determine whether the function body is defined. A body of ... counts as undefined.)
From t/builtins/arrays_and_hashes/keys_values.t lines 27–31 (3 √, 0 ×): (skip)
| # L<S29/"Hash"/=item keys> |
√ | is(~%hash.keys.sort, "a b c d", '%hash.keys works'); |
√ | is(~sort(keys(%hash)), "a b c d", 'keys(%hash) on hashes'); |
√ | is(+%hash.keys, +%hash, 'we have the same number of keys as elements in the hash'); |
| |
From t/builtins/lists/one_elem_list_kv.t lines 5–19 (1 √, 4 ×): (skip)
| # L<S29/"Hash"/"=item kv"> |
| |
| # (1,).kv works correctly |
| my @a = (); |
| @a = try { (1,).kv }; |
× | is(@a[0],0, "first element is 0", :todo<bug>); |
× | is(@a[1],1, "second element is 1", :todo<bug>); |
| |
| # ('a',).kv works correctly |
| @a = try { ('a',).kv }; |
× | is(@a[0],0, "first element is 0", :todo<bug>); |
× | is(@a[1],'a', "second element is 'a'", :todo<bug>); |
| |
| # Check that (42).kv does *not* work, as this it the same as $some_int.kv: |
√ | dies_ok { (42).kv }, "(42).kv should not and does not work"; |
From t/builtins/arrays_and_hashes/kv.t lines 29–142 (20 √, 6 ×): (skip)
| # L<S29/"Hash"/=item kv> |
| { # check the invocant form |
| my %hash = (a => 1, b => 2, c => 3, d => 4); |
| my @kv = %hash.kv; |
√ | is(+@kv, 8, '%hash.kv returns the correct number of elems'); |
√ | is(~@kv.sort, "1 2 3 4 a b c d", '%hash.kv has no inner list'); |
| } |
| |
| { # check the non-invocant form |
| my %hash = (a => 1, b => 2, c => 3, d => 4); |
| my @kv = kv(%hash); |
√ | is(+@kv, 8, 'kv(%hash) returns the correct number of elems'); |
√ | is(~@kv.sort, "1 2 3 4 a b c d", 'kv(%hash) has no inner list'); |
| } |
| |
| # See "Questions about $pair.kv" thread on perl-6 lang |
| { |
| my $pair = (a => 1); |
| my @kv = $pair.kv; |
√ | is(+@kv, 2, '$pair.kv returned one elem'); |
√ | is(+@kv, 2, '$pair.kv inner list has two elems'); |
√ | is(~@kv, "a 1", '$pair.kv inner list matched expectation'); |
| } |
| |
| { |
| my $sub = sub (Hash $hash) { $hash.kv }; |
| my %hash = (a => 1, b => 2); |
√ | is ~kv(%hash).sort, "1 2 a b", ".kv works with normal hashes (sanity check)"; |
√ | is ~$sub(%hash).sort, "1 2 a b", ".kv works with constant hash references"; |
| } |
| |
| { |
| # "%$hash" is not idiomatic Perl, but should work nevertheless. |
| my $sub = sub (Hash $hash) { %$hash.kv }; |
| my %hash = (a => 1, b => 2); |
√ | is ~kv(%hash).sort, "1 2 a b", ".kv works with normal hashes (sanity check)"; |
√ | is ~$sub(%hash).sort, "1 2 a b", ".kv works with dereferenced constant hash references"; |
| } |
| |
| # test3 and test4 illustrate a bug |
| |
| sub test1{ |
| my $pair = boo=>'baz'; |
| my $type = $pair.WHAT; |
| for $pair.kv->$key,$value{ |
√ | is($key, 'boo', "test1: $type \$pair got the right \$key"); |
√ | is($value, 'baz', "test1: $type \$pair got the right \$value"); |
| } |
| } |
| test1; |
| |
| sub test2{ |
| my %pair = boo=>'baz'; |
| my $type = %pair.WHAT; |
| my $elems= +%pair; |
| for %pair.kv->$key,$value{ |
√ | is($key, 'boo', "test2: $elems-elem $type \%pair got the right \$key"); |
√ | is($value, 'baz', "test2: $elems-elem $type \%pair got the right \$value"); |
| } |
| } |
| test2; |
| |
| my %hash = ('foo' => 'baz'); |
| sub test3 (Hash %h){ |
| for %h.kv -> $key,$value { |
√ | is($key, 'foo', "test3: from {+%h}-elem {%h.WHAT} \%h got the right \$key"); |
√ | is($value, 'baz', "test3: from {+%h}-elem {%h.WHAT} \%h got the right \$value"); |
| } |
| } |
| test3 %hash; |
| |
| sub test4 (Hash %h){ |
| for 0..%h.kv.end -> $idx { |
√ | is(%h.kv[$idx], %hash.kv[$idx], "test4: elem $idx of {%h.kv.elems}-elem {%h.kv.WHAT} \%hash.kv correctly accessed"); |
| } |
| } |
| test4 %hash; |
| |
| # sanity |
| for %hash.kv -> $key,$value { |
√ | is($key, 'foo', "for(): from {+%hash}-elem {%hash.WHAT} \%hash got the right \$key"); |
√ | is($value, 'baz', "for(): from {+%hash}-elem {%hash.WHAT} \%hash got the right \$value"); |
| } |
| |
| # The things returned by .kv should be aliases |
| { |
| my %hash = (:a(1), :b(2), :c(3)); |
| |
× | lives_ok { for %hash.kv -> $key, $value is rw { |
| $value += 100; |
| } }, 'aliases returned by %hash.kv should be rw (1)', :todo<feature>; |
| |
× | is %hash<b>, 102, 'aliases returned by %hash.kv should be rw (2)', :todo<feature>; |
| } |
| |
| { |
| my @array = (17, 23, 42); |
| |
× | lives_ok { for @array.kv -> $key, $value is rw { |
| $value += 100; |
| } }, 'aliases returned by @array.kv should be rw (1)', :todo<feature>; |
| |
× | is @array[1], 123, 'aliases returned by @array.kv should be rw (2)', :todo<feature>; |
| } |
| |
| { |
| my $pair = (a => 42); |
| |
× | lives_ok { for $pair.kv -> $key, $value is rw { |
| $value += 100; |
| } }, 'aliases returned by $pair.kv should be rw (1)', :todo<feature>; |
| |
× | is $pair.value, 142, 'aliases returned by $pair.kv should be rw (2)', :todo<feature>; |
| } |
From t/builtins/arrays_and_hashes/pairs.t lines 32–104 (16 √, 6 ×): (skip)
| # L<S29/"Hash"/=item pairs> |
| { |
| my %hash = (a => 1, b => 2, c => 3); |
| my @pairs; |
√ | ok((@pairs = %hash.pairs.sort), "sorted pairs on hashes"); |
√ | is +@pairs, 3, "pairs on hashes returned the correct number of elems"; |
| if +@pairs != 3 { |
| skip 6, "skipped tests which depend on a test which failed"; |
| } else { |
√ | is @pairs[0].key, "a", "value of pair returned by hash.pairs was correct (1)"; |
√ | is @pairs[1].key, "b", "value of pair returned by hash.pairs was correct (2)"; |
√ | is @pairs[2].key, "c", "value of pair returned by hash.pairs was correct (3)"; |
√ | is @pairs[0].value, 1, "key of pair returned by hash.pairs was correct (1)"; |
√ | is @pairs[1].value, 2, "key of pair returned by hash.pairs was correct (2)"; |
√ | is @pairs[2].value, 3, "key of pair returned by hash.pairs was correct (3)"; |
| } |
| } |
| |
| # Following stated by Larry on p6l |
| { |
| my $pair = (a => 1); |
| my @pairs; |
√ | ok((@pairs = $pair.pairs), "pairs on a pair"); |
√ | is +@pairs, 1, "pairs on a pair returned one elem"; |
| if +@pairs != 1 { |
| skip 2, "skipped tests which depend on a test which failed"; |
| } else { |
√ | is @pairs[0].key, "a", "key of pair returned by pair.pairs"; |
√ | is @pairs[0].value, 1, "value of pair returned by pair.pairs"; |
| } |
| } |
| |
| # This next group added by Darren Duncan following discovery while debugging ext/Locale-KeyedText: |
| { |
| my $hash_of_2_pairs = {'a'=>'b','c'=>'d'}; |
| my $hash_of_1_pair = {'a'=>'b'}; |
× | is( $hash_of_2_pairs.pairs.sort.join( ',' ), "a\tb,c\td", "pairs() on 2-elem hash, 1-depth joined", :todo<feature> ); |
× | is( $hash_of_1_pair.pairs.sort.join( ',' ), "a\tb", "pairs() on 1-elem hash, 1-depth joined", :todo<feature> ); |
√ | is( $hash_of_2_pairs.pairs.sort.map:{ .key~'='~.value }.join( ',' ), 'a=b,c=d', |
| "pairs() on 2-elem hash, 2-depth joined" ); |
√ | is( try { $hash_of_1_pair.pairs.sort.map:{ .key~'='~.value }.join( ',' ) }, 'a=b', |
| "pairs() on 1-elem hash, 2-depth joined" ); |
| } |
| |
| { |
| my %hash = (:a(1), :b(2), :c(3)); |
| |
√ | lives_ok { for %hash.pairs -> $pair { |
| $pair.value += 100; |
| } }, 'aliases returned by %hash.pairs should be rw (1)'; |
| |
√ | is %hash<b>, 102, 'aliases returned by %hash.pairs should be rw (2)'; |
| } |
| |
| { |
| my @array = (17, 23, 42); |
| |
× | lives_ok { for @array.pairs -> $pair { |
| $pair.value += 100; |
| } }, 'aliases returned by @array.pairs should be rw (1)', :todo<bug>; |
| |
× | is @array[1], 123, 'aliases returned by @array.pairs should be rw (2)', :todo<bug>; |
| } |
| |
| { |
| my $pair = (a => 42); |
| |
× | lives_ok { for $pair.pairs -> $p { |
| $p.value += 100; |
| } }, 'aliases returned by $pair.value should be rw (1)', :todo<bug>; |
| |
× | is $pair.value, 142, 'aliases returned by $pair.kv should be rw (2)', :todo<bug>; |
| } |
From t/builtins/arrays_and_hashes/keys_values.t lines 32–45 (9 √, 0 ×): (skip)
| # L<S29/"Hash"/=item values> |
√ | is(~%hash.values.sort, "1 2 3 4", '%hash.values works'); |
√ | is(~sort(values(%hash)), "1 2 3 4", 'values(%hash) works'); |
√ | is(+%hash.values, +%hash, 'we have the same number of keys as elements in the hash'); |
| |
| # keys and values on Pairs |
| my $pair = (a => 42); |
√ | is(~$pair.keys, "a", '$pair.keys works'); |
√ | is(~keys($pair), "a", 'keys($pair) works'); |
√ | is(+$pair.keys, 1, 'we have one key'); |
| |
√ | is(~$pair.values, 42, '$pair.values works'); |
√ | is(~values($pair), 42, 'values($pair) works'); |
√ | is(+$pair.values, 1, 'we have one value'); |
multi Int|List keys ( %hash ; Matcher *@keytests ) multi Int|List kv ( %hash ; Matcher *@keytests ) multi Int|(List of Pair) pairs (%hash ; Matcher *@keytests ) multi Int|List values ( %hash ; Matcher *@keytests )
Iterates the elements of %hash in no apparent order, but the order will be the same between successive calls to these functions, as long as %hash doesn't change.
If @keytests are provided, only elements whose keys evaluate $key ~~ any(@keytests) as true are iterated.
What is returned at each element of the iteration varies with function. keys only returns the key; values the value; kv returns both as a 2 element list in (key, value) order, pairs a Pair(key, value).
Note that kv %hash returns the same as zip(keys %hash; values %hash)
In Scalar context, they all return the count of elements that would have been iterated.
The lvalue form of keys is not longer supported. Use the .buckets property instead.
General notes about strings:
A Str can exist at several Unicode levels at once. Which level you interact with typically depends on what your current lexical context has declared the "working Unicode level to be". Default is Grapheme. [Default can't be CharLingua because we don't go into "language" mode unless there's a specific language declaration saying either exactly what language we're going into or, in the absence of that, how to find the exact language somewhere in the enviroment.]
Attempting to use a string at a level higher it can support is handled without warning. The current highest supported level of the string is simply mapped Char for Char to the new higher level. However, attempting to stuff something of a higher level a lower-level string is an error (for example, attempting to store Kanji in a Byte string). An explicit conversion function must be used to tell it how you want it encoded.
Attempting to use a string at a level lower than what it supports is not allowed.
If a function takes a Str and returns a Str, the returned Str will support the same levels as the input, unless specified otherwise.
The following are all provided by the Str role:
From t/spec/S29-str/p5chop.t lines 4–24 (no results): (skip)
| # L<S29/Str/"=item p5chop">
|
|
|
| plan 6;
|
|
|
| # TODO: tests with "wide" unicode characters
|
|
|
| # test with scalar argument
|
|
|
| my $test = "abcdefg";
|
|
|
| is(p5chop($test), 'g', "p5chop returns the last character");
|
| is($test, "abcdef", "p5chop removes last character");
|
| is(p5chop($test), 'f', "repeated call to p5chop returns the last character each time");
|
| is($test, "abcde", "repeated call to p5chop removes last character");
|
|
|
| # array test
|
|
|
| my @t = <abc def gih>;
|
|
|
| is(p5chop(@t), 'h', 'p5chop(@list) returns the last removed char');
|
| is(@t, <ab de gi>, 'p5chop(@list) removes the last char of each string');
|
our Char multi method p5chop ( Str $string is rw: ) is export(:P5) my Char multi p5chop ( Str *@strings is rw ) is export(:P5)
Trims the last character from $string, and returns it. Called with a list, it chops each item in turn, and returns the last character chopped.
From t/spec/S29-str/chop.t lines 4–49 (no results): (skip)
| # L<S29/Str/"=item chop">
|
|
|
| plan 2;
|
|
|
| #
|
| # Tests already covered by the specs
|
| #
|
|
|
| my $str = "foo";
|
| is(chop($str), "fo", "o removed");
|
| is($str, "foo", "original string unchanged");
|
|
|
| # See L<"http://use.perl.org/~autrijus/journal/25351">:
|
| # &chomp and &wrap are now nondestructive; chomp returns the chomped part,
|
| # which can be defined by the filehandle that obtains the default string at
|
| # the first place. To get destructive behaviour, use the .= form.
|
|
|
| =begin more-discussion-needed
|
|
|
| XXX: chop(@array) should return an array of chopped strings?
|
| XXX: chop(%has) should return a hash of chopped strings?
|
|
|
| { # chop serveral things
|
| my ($a, $b) = ("bar", "gorch");
|
| #?pugs: todo('', 3);
|
| # FIXME: is(eval 'chop($a, $b)', "h", "two chars removed, second returned");
|
| is($a, "ba", "first string");
|
| is($b, "gorc", "second string");
|
| };
|
|
|
| { # chop elements of array
|
| my @array = ("fizz", "buzz");
|
| is(chop(@array), "z", "two chars removed second returned");
|
| #?pugs: todo('unspecified', 2);
|
| is(@array[0], "fiz", "first elem");
|
| is(@array[1], "buz", "second elem");
|
| };
|
|
|
| { # chop a hash
|
| my %hash = ( "key", "value", "other", "blah");
|
|
|
| #?pugs: todo('', 3);
|
| # FIXME: is(chop(%hash), "h"|"e", "chopping hash returns last char of either value");
|
| is(%hash<key>, "valu", "first value chopped");
|
| is(%hash<other>, "bla", "second value chopped");
|
| };
|
our Str multi method chop ( Str $string: ) is export
Returns string with one Char removed from the end.
From t/spec/S29-str/p5chomp.t lines 6–24 (no results): (skip)
| L<S29/Str/"=item p5chomp">
|
|
|
| =cut
|
|
|
| plan 6;
|
|
|
| my $string = "abc";
|
|
|
| is(p5chomp($string), 0, 'p5chomp leaves strings untouched that don\'t end in \n');
|
| is($string, "abc", 'p5chomp did not change "abc"');
|
|
|
| $string = "abc\n\n";
|
|
|
| is(p5chomp($string), 1, 'p5chomp removes one \n even if the string ends in \n\n');
|
| is($string, "abc\n", 'p5chomp removed one \n');
|
|
|
| my @s = "abc", "def\n", "gh\n";
|
| is(p5chomp(@s), 2, 'p5chomp on lists returns the number of removed \ns');
|
| is(@s, <abc def gh>, 'p5chomp on lists works');
|
our Int multi method p5chomp ( Str $string is rw: ) is export(:P5) my Int multi p5chomp ( Str *@strings is rw ) is export(:P5)
Related to p5chop, only removes trailing chars that match /\n/. In either case, it returns the number of chars removed.
From t/spec/S29-str/chomp.t lines 13–124 (no results): (skip)
| # L<S29/"Str"/=item chomp>
|
|
|
| # Also see L<"http://use.perl.org/~autrijus/journal/25351">
|
| # &chomp and &wrap are now nondestructive; chomp returns the chomped part,
|
| # which can be defined by the filehandle that obtains the default string at
|
| # the first place. To get destructive behaviour, use the .= form.
|
|
|
| {
|
| my $foo = "foo\n";
|
| chomp($foo);
|
| is($foo, "foo\n", 'our variable was not yet chomped');
|
| $foo .= chomp;
|
| is($foo, 'foo', 'our variable is chomped correctly');
|
| $foo .= chomp;
|
| is($foo, 'foo', 'our variable is chomped again with no effect');
|
| }
|
|
|
| {
|
| my $foo = "foo\n\n";
|
| $foo .= chomp;
|
| is($foo, "foo\n", 'our variable is chomped correctly');
|
| $foo .= chomp;
|
| is($foo, 'foo', 'our variable is chomped again correctly');
|
| $foo .= chomp;
|
| is($foo, 'foo', 'our variable is chomped again with no effect');
|
| }
|
|
|
| {
|
| my $foo = "foo\nbar\n";
|
| $foo .= chomp;
|
| is($foo, "foo\nbar", 'our variable is chomped correctly');
|
| $foo .= chomp;
|
| is($foo, "foo\nbar", 'our variable is chomped again with no effect');
|
| }
|
|
|
| {
|
| my $foo = "foo\n ";
|
| $foo .= chomp;
|
| is($foo, "foo\n ", 'our variable is chomped with no effect');
|
| }
|
|
|
| {
|
| my $foo = "foo\n";
|
| #?pugs: todo('chomp(...).newline marked as todo', 1);
|
| my $chomped_foo = try { chomp($foo).newline };
|
| is($chomped_foo, "\n", 'chomp(...).newline returns the chomped value');
|
| is($foo, "foo\n", 'and our variable was not chomped');
|
| }
|
|
|
| {
|
| my $foo = "foo\n";
|
| $foo .= chomp;
|
| #?pugs: todo('$foo .= chomp; $foo.newline marked as todo', 1);
|
| my $chomped_foo = try { $foo.newline };
|
| is($chomped_foo, "\n", 'chomp(...).newline returns the chomped value');
|
| is($foo, "foo", 'and our variable was chomped');
|
| }
|
|
|
| {
|
| my $foo = "foo\n\n";
|
| my $chomped = $foo.chomp;
|
| is($foo, "foo\n\n", ".chomp has no effect on the original string");
|
| is($chomped, "foo\n", ".chomp returns correctly chomped value");
|
|
|
| # $chomped.chomp.newline
|
|
|
| $chomped = $chomped.chomp;
|
| is($chomped, "foo", ".chomp returns correctly chomped value again");
|
| }
|
|
|
| # chomp in list context
|
| {
|
| is_deeply(chomp(()), [], "chomp on empty list");
|
| is_deeply(chomp(("abc\n")), ("abc"), "one element list");
|
| is_deeply(chomp(("abc\n", "bcd\n")), ("abc", "bcd"), "two element list");
|
| is_deeply(("abc\n", "bcd\n").chomp, ("abc", "bcd"), "two element list");
|
| }
|
| {
|
| my @foo = ();
|
| my @bar = chomp @foo;
|
| is_deeply(@bar, @foo, "chomp empty array");
|
| }
|
| {
|
| my @foo = ("abc\n");
|
| my @bar = chomp @foo;
|
| my @baz = ("abc");
|
| is_deeply(@bar, @baz, "chomp array with one element");
|
| }
|
| {
|
| my @foo = ("abc\n", "bcd\n");
|
| my @bar = chomp @foo;
|
| my @baz = ("abc", "bcd");
|
| is_deeply(@bar, @baz, "chomp array with 2 elements");
|
|
|
|
|
| @bar = @foo.chomp;
|
| is_deeply(@bar, @baz, "chomp array with 2 elements");
|
|
|
| my @morgo = ("abc\n\n", "bcd\n\n");
|
| my @hapci = chomp @morgo;
|
| is_deeply(@hapci, @foo, "chomp array with 2 elements with duplicate newlines");
|
|
|
| my @szundi = @morgo.chomp;
|
| is_deeply(@szundi, @foo, "chomp array with 2 elements with duplicate newlines");
|
| }
|
|
|
| =pod
|
|
|
| Basic tests for the chomp() builtin working on an array of strings
|
|
|
| =cut
|
|
|
From t/spec/S29-str/chomp.t lines 125–150 (no results): (skip)
| # L<S29/Str/=item chomp>
|
|
|
| # Also see L<"http://use.perl.org/~autrijus/journal/25351">
|
| # &chomp and &wrap are now nondestructive; chomp returns the chomped part,
|
| # which can be defined by the filehandle that obtains the default string at
|
| # the first place. To get destructive behaviour, use the .= form.
|
| # Since currently the behaviour with regards to arrays is not defined, I'm
|
| # assuming the correct behaviour is an extension of the behaviour for
|
| # a single string.
|
|
|
| {
|
| my @foo = ("foo\n","bar\n","baz\n");
|
| chomp(@foo);
|
| is(@foo[0], "foo\n", '1st element was not yet chomped');
|
| is(@foo[1], "bar\n", '2nd element was not yet chomped');
|
| is(@foo[2], "baz\n", '3rd element was not yet chomped');
|
| @foo .= chomp;
|
| is(@foo[0], 'foo', '1st element chomped correctly');
|
| is(@foo[1], 'bar', '2nd element chomped correctly');
|
| is(@foo[2], 'baz', '3rd element chomped correctly');
|
| @foo .= chomp;
|
| is(@foo[0], 'foo', '1st element is chomped again with no effect');
|
| is(@foo[1], 'bar', '2nd element is chomped again with no effect');
|
| is(@foo[2], 'baz', '3rd element is chomped again with no effect');
|
| }
|
|
|
our Str multi method chomp ( Str $string: ) is export
Returns string with one newline removed from the end. An arbitrary terminator can be removed if the input filehandle has marked the string for where the "newline" begins. (Presumably this is stored as a property of the string.) Otherwise a standard newline is removed.
Note: Most users should just let their I/O handles autochomp instead. (Autochomping is the default.)
From t/spec/S29-str/lc.t lines 7–27 (no results): (skip)
| # L<S29/Str/lc>
|
|
|
| is(lc("hello world"), "hello world", "lowercasing string which is already lowercase");
|
| is(lc("Hello World"), "hello world", "simple lc test");
|
| is(lc(""), "", "empty string");
|
| is(lc("ÅÄÖ"), "åäö", "some finnish non-ascii chars");
|
| is(lc("ÄÖÜ"), "äöü", "lc of German Umlauts");
|
| is(lc("ÓÒÚÙ"), "óòúù", "accented chars");
|
| is(lc('A'..'C'), "a b c", "lowercasing char-range");
|
|
|
| $_ = "Hello World";
|
| my $x = .lc;
|
| is($x, "hello world", 'lc uses $_ as default');
|
|
|
| { # test invocant syntax for lc
|
| my $x = "Hello World";
|
| is($x.lc, "hello world", '$x.lc works');
|
| is("Hello World".lc, "hello world", '"Hello World".lc works');
|
| }
|
|
|
| is("ÁÉÍÖÜÓŰŐÚ".lc, "áéíöüóűőú", ".lc on Hungarian vowels");
|
our Str multi method lc ( Str $string: ) is export
Returns the input string after converting each character to its lowercase form, if uppercase.
From t/spec/S29-str/lcfirst.t lines 7–24 (no results): (skip)
| # L<S29/Str/lcfirst>
|
|
|
| is lcfirst("HELLO WORLD"), "hELLO WORLD", "simple";
|
| is lcfirst(""), "", "empty string";
|
| is lcfirst("ÜÜÜÜ"), "üÜÜÜ", "umlaut";
|
| is lcfirst("ÓÓÓÓŃ"), "óÓÓÓŃ", "accented chars";
|
|
|
| is "HELLO WORLD".lcfirst, "hELLO WORLD", "simple.lcfirst";
|
|
|
| my $str = "Some String";
|
| is $str.lcfirst, "some String", "simple.lcfirst on scalar variable";
|
| is "Other String".lcfirst, "other String", ".lcfirst on literal string";
|
|
|
| $_ = "HELLO WORLD";
|
| my $x = .lcfirst;
|
| is $x, "hELLO WORLD", 'lcfirst uses $_ as default'
|
|
|
|
|
our Str multi method lcfirst ( Str $string: ) is export
Like lc, but only affects the first character.
From t/spec/S29-str/uc.t lines 8–32 (no results): (skip)
| # L<S29/"Str"/=item uc>
|
|
|
| is(uc("Hello World"), "HELLO WORLD", "simple");
|
| is(uc(""), "", "empty string");
|
| is(uc("åäö"), "ÅÄÖ", "some finnish non-ascii chars");
|
| is(uc("äöü"), "ÄÖÜ", "uc of German Umlauts");
|
| is(uc("óòúù"), "ÓÒÚÙ", "accented chars");
|
| is(uc(lc('HELL..')), 'HELL..', "uc/lc test");
|
|
|
| # given does not return proper value yet
|
| $_ = "Hello World";
|
| my $x = .uc;
|
| is $x, "HELLO WORLD", 'uc uses the default $_';
|
|
|
| {
|
| my $x = "Hello World";
|
| is $x.uc, "HELLO WORLD", '$x.uc works';
|
| is "Hello World".uc, "HELLO WORLD", '"Hello World".uc works';
|
| }
|
|
|
| # Bug: GERMAN SHARP S ("ß") should uc() to "SS", but it doesn't
|
| # Compare with: perl -we 'use utf8; print uc "ß"'
|
| is(uc("ß"), "SS", "uc() of non-ascii chars may result in two chars");
|
|
|
| is("áéíöüóűőú".uc, "ÁÉÍÖÜÓŰŐÚ", ".uc on Hungarian vowels");
|
our Str multi method uc ( Str $string: ) is export
Returns the input string after converting each character to its uppercase form, if lowercase. This is not a Unicode "titlecase" operation, but a full "uppercase".
From t/spec/S29-str/ucfirst.t lines 7–12 (no results): (skip)
| # L<S29/Str/ucfirst>
|
|
|
| is ucfirst("hello world"), "Hello world", "simple";
|
| is ucfirst(""), "", "empty string";
|
| is ucfirst("üüüü"), "Üüüü", "umlaut";
|
| is ucfirst("óóóó"), "Óóóó", "accented chars";
|
our Str multi method ucfirst ( Str $string: ) is export
Performs a Unicode "titlecase" operation on the first character of the string.
our Str multi method normalize ( Str $string: Bool :$canonical = Bool::True, Bool :$recompose = Bool::False ) is export
Performs a Unicode "normalization" operation on the string. This involves decomposing the string into its most basic combining elements, and potentially re-composing it. Full detail on the process of decomposing and re-composing strings in a normalized form is covered in the Unicode specification Sections 3.7, Decomposition and 3.11, Canonical Ordering Behavior of the Unicode Standard, 4.0. Additional named parameters are reserved for future Unicode expansion.
For everyday use there are aliases that map to the Unicode Standard Annex #15: Unicode Normalization Forms document's names for the various modes of normalization:
our Str multi method nfd ( Str $string: ) is export {
$string.normalize(:cononical, :!recompose);
}
our Str multi method nfc ( Str $string: ) is export {
$string.normalize(:canonical, :recompose);
}
our Str multi method nfkd ( Str $string: ) is export {
$string.normalize(:!canonical, :!recompose);
}
our Str multi method nfkc ( Str $string: ) is export {
$string.normalize(:!canonical, :recompose);
}
Decomposing a string can be used to compare Unicode strings in a binary form, providing that they use the same encoding. Without decomposing first, two Unicode strings may contain the same text, but not the same byte-for-byte data, even in the same encoding. The decomposition of a string is performed according to tables in the Unicode standard, and should be compatible with decompositions performed by any system.
The :canonical flag controls the use of "compatibility decompositions". For example, in canonical mode, "fi" is left unaffected because it is not a composition. However, in compatibility mode, it will be replaced with "fi". Decomposed sequences will be ordered in a canonical way in either mode.
The :recompose flag controls the re-composition of decomposed forms. That is, a combining sequence will be re-composed into the canonical composite where possible.
These de-compositions and re-compositions are performed recursively, until there is no further work to be done.
Note that this function is really only applicable when dealing with codepoint strings. Grapheme strings are normally processed at a higher abstraction level that is independent of normalization, and are lazily normalized into the desired normalization when transferred to lexical scopes or handles that care.
From t/spec/S29-str/samecase.t lines 4–30 (no results): (skip)
| # L<S29/Str/"=item samecase">
|
|
|
| =pod
|
|
|
| Basic test for the samecase() builtin with a string (Str).
|
|
|
| =cut
|
|
|
| plan 8;
|
|
|
| # As a function
|
| is( samecase('Perl6', 'abcdE'), 'perl6', 'as a function');
|
|
|
| # As a method
|
| is( ''.samecase(''), '', 'empty string' );
|
| is( 'Hello World !'.samecase('AbCdEfGhIjKlMnOpQrStUvWxYz'), 'HeLlO WoRlD !', 'literal');
|
|
|
| # On a variable
|
| my Str $a = 'Just another Perl6 hacker';
|
| is( $a.samecase('XXXXXXXXXXXXXXXXXXXXXXXXX'), 'JUST ANOTHER PERL6 HACKER', 'with a Str variable' );
|
| is( $a.samecase('äääääääääääääääääääääääää'), 'just another perl6 hacker', 'with a Str variable and <unicode> arg');
|
| is( $a, 'Just another Perl6 hacker', 'samecase should not be in-place' );
|
| is( $a .= samecase('aaaaaaaaaaaaaaaaaaaaaaaa'), 'just another perl6 hacker', 'after a .= samecase(...)' );
|
|
|
| # samecase with unicode
|
| is( '䀻«'.samecase('xXxX'), '䀻«', 'some unicode characters' );
|
|
|
our Str multi method samecase ( Str $string: Str $pattern ) is export
Has the effect of making the case of the string match the case pattern in $pattern. (Used by s:ii/// internally, see S05.)
our Str multi method samebase ( Str $string: Str $pattern ) is export
Has the effect of making the case of the string match the accent pattern in $pattern. (Used by s:bb/// internally, see S05.)
From t/spec/S29-str/capitalize.t lines 7–27 (no results): (skip)
| # L<S29/Str/capitalize>
|
|
|
| is capitalize(""), "", "capitalize('') works";
|
| is capitalize("puGS Is cOOl!"), "Pugs Is Cool!", "capitalize('...') works";
|
| is "puGS Is cOOl!".capitalize, "Pugs Is Cool!", "'...'.capitalize works";
|
|
|
| my $a = "";
|
| is capitalize($a), "", "capitalize empty string";
|
| $a = "puGS Is cOOl!";
|
| is capitalize($a), "Pugs Is Cool!", "capitalize string works";
|
| is $a, "puGS Is cOOl!", "original string not touched";
|
| is $a.capitalize, "Pugs Is Cool!", "capitalize string works";
|
| is $a, "puGS Is cOOl!", "original string not touched";
|
| is "ab cD Ef".capitalize, "Ab Cd Ef", "works on ordinary string";
|
|
|
|
|
| $_ = "puGS Is cOOl!";
|
| is .capitalize, "Pugs Is Cool!", 'capitalize() uses \$_ as default';
|
|
|
| # Non-ASCII chars:
|
| is capitalize("äöü abcä"), "Äöü Abcä", "capitalize() works on non-ASCII chars";
|
our Str multi method capitalize ( Str $string: ) is export
Has the effect of first doing an lc on the entire string, then performing a s:g/(\w+)/{ucfirst $1}/ on it.
From t/spec/S29-str/length.t lines 5–23 (no results): (skip)
| # L<S29/Str/=item length>
|
|
|
| =kwid
|
|
|
| Various length tests (though "length" should not be used)
|
|
|
| This does not adequately test .chars, which is language dependent
|
| and needs more careful tests.
|
|
|
| L<"http://www.unicode.org/unicode/reports/tr11/">
|
|
|
| =cut
|
|
|
| plan 54;
|
|
|
| eval_dies_ok('"moose".length', 'Str.length properly not implemented');
|
|
|
| # string literals, for sanity
|
|
|
This word is banned in Perl 6. You must specify units.
From t/spec/S29-str/length.t lines 33–61 (no results): (skip)
| # L<S29/Str/=item chars>
|
|
|
| # Precedence tests
|
| ok (chars "abcdef" > 4), "chars() has the right precedence (1)";
|
| is (chars("abcdef" > 4)), 0, "chars() has the right precedence (2)";
|
|
|
| # and the real tests.
|
|
|
| # Please add test strings in your favorite script, especially if
|
| # it is boustrophedonic or otherwise interesting.
|
| my @stringy = <@stringy>;
|
| my @data = (
|
| # string octets codepoints grapheme chars
|
| "", 0, 0, 0, 0,
|
| "moose", 5, 5, 5, 5,
|
| "C:\\Program Files", 16, 16, 16, 16,
|
| ~@stringy, 8, 8, 8, 8,
|
| "\x020ac \\x020ac", 11, 9, 9, 9,
|
| "בדיקה", 10, 5, 5, 5,
|
| "בדיקה 123", 14, 9, 9, 9,
|
| "rántottcsirke", 14, 13, 13, 13,
|
| "aáeéiíoóöőuúüű", 23, 14, 14, 14,
|
| "AÁEÉIÍOÓÖŐUÚÜŰ", 23, 14, 14, 14,
|
| "»«", 4, 2, 2, 2,
|
| ">><<", 4, 4, 4, 4,
|
|
|
| );
|
| #:map { my %hash; %hash<string bytes codes graphs> = $_; \%hash };
|
|
|
From t/spec/S29-str/length.t lines 63–73 (no results): (skip)
| # L<S29/Str/=item chars>
|
| # L<S29/Str/=item codes>
|
| # L<S29/Str/=item graphs>
|
|
|
| for @data -> $string, $bytes, $codes, $graphs, $chars {
|
| is($string.bytes, $bytes, "'{$string}'.bytes");
|
| is($string.chars, $chars, "'{$string}'.chars");
|
| is($string.codes, $codes, "'{$string}'.codes");
|
| is($string.graphs, $graphs, "'{$string}'.graphs");
|
| }
|
|
|
our Int multi method chars ( Str $string: ) is export
Returns the number of characters in the string in the current (lexically scoped) idea of what a normal character is, usually graphemes.
From t/spec/S29-str/length.t lines 65–73 (no results): (skip)
| # L<S29/Str/=item graphs>
|
|
|
| for @data -> $string, $bytes, $codes, $graphs, $chars {
|
| is($string.bytes, $bytes, "'{$string}'.bytes");
|
| is($string.chars, $chars, "'{$string}'.chars");
|
| is($string.codes, $codes, "'{$string}'.codes");
|
| is($string.graphs, $graphs, "'{$string}'.graphs");
|
| }
|
|
|
our Int multi method codes ( Str $string: ) is export
Returns the number of graphemes in the string in a language-independent way.
From t/spec/S29-str/length.t lines 64–73 (no results): (skip)
| # L<S29/Str/=item codes>
|
| # L<S29/Str/=item graphs>
|
|
|
| for @data -> $string, $bytes, $codes, $graphs, $chars {
|
| is($string.bytes, $bytes, "'{$string}'.bytes");
|
| is($string.chars, $chars, "'{$string}'.chars");
|
| is($string.codes, $codes, "'{$string}'.codes");
|
| is($string.graphs, $graphs, "'{$string}'.graphs");
|
| }
|
|
|
our Int multi method codes ( Str $string: $nf = $?NF) is export
Returns the number of codepoints in the string if it were canonicalized the specified way. Do not confuse codepoints with UTF-16 encoding. Characters above U+FFFF count as a single codepoint.
From t/spec/S29-str/length.t lines 24–32 (no results): (skip)
| # L<S29/Str/=item bytes>
|
|
|
| is("".bytes, 0, "empty string");
|
| is("moose".bytes, 5, "moose");
|
| my $x = undef;
|
| ok(!(try { $x.bytes }), "undef.bytes fail()s");
|
| # See thread "undef.chars" on p6l started by Ingo Blechschmidt:
|
| # L<"http://www.nntp.perl.org/group/perl.perl6.language/22595">
|
|
|
From t/spec/S29-str/length.t lines 62–73 (no results): (skip)
| # L<S29/Str/=item bytes>
|
| # L<S29/Str/=item chars>
|
| # L<S29/Str/=item codes>
|
| # L<S29/Str/=item graphs>
|
|
|
| for @data -> $string, $bytes, $codes, $graphs, $chars {
|
| is($string.bytes, $bytes, "'{$string}'.bytes");
|
| is($string.chars, $chars, "'{$string}'.chars");
|
| is($string.codes, $codes, "'{$string}'.codes");
|
| is($string.graphs, $graphs, "'{$string}'.graphs");
|
| }
|
|
|
our Int multi method bytes ( Str $string: $nf = $?NF, $enc = $?ENC) is export
Returns the number of bytes in the string if it were encoded in the specified way. Note the inequality:
.bytes("C","UTF-16") * 2 >= .codes("C")
This is caused by the possibility of surrogate pairs, which are counted as one codepoint. However, this problem does not arise for UTF-32:
.bytes("C","UTF-32") * 4 == .codes("C")
From t/spec/S29-str/index.t lines 4–67 (no results): (skip)
| # L<S29/Str/"=item index">
|
|
|
| plan 31;
|
|
|
| # Simple - with just a single char
|
|
|
| is(index("Hello World", "H"), 0, "One char, at beginning");
|
| is(index("Hello World", "l"), 2, "One char, in the middle");
|
| is(index("Hello World", "d"), 10, "One char, in the end");
|
| is(index("Hello World", "x"), -1, "One char, no match");
|
|
|
| is(index("Hello World", "l", 0), 2, "One char, find first match, pos = 0");
|
| is(index("Hello World", "l", 2), 2, "- 1. match again, pos @ match");
|
| is(index("Hello World", "l", 3), 3, "- 2. match");
|
| is(index("Hello World", "l", 4), 9, "- 3. match");
|
| is(index("Hello World", "l", 10), -1, "- no more matches");
|
|
|
| # Simple - with a string
|
|
|
| is(index("Hello World", "Hello"), 0, "Substr, at beginning");
|
| is(index("Hello World", "o W"), 4, "Substr, in the middle");
|
| is(index("Hello World", "World"), 6, "Substr, at the end");
|
| is(index("Hello World", "low"), -1, "Substr, no match");
|
| is(index("Hello World", "Hello World"), 0, "Substr eq Str");
|
|
|
| # Empty strings
|
|
|
| is(index("Hello World", ""), 0, "Substr is empty");
|
| is(index("", ""), 0, "Both strings are empty");
|
| is(index("", "Hello"), -1, "Only main-string is empty");
|
| is(index("Hello", "", 3), 3, "Substr is empty, pos within str");
|
| is(index("Hello", "", 5), 5, "Substr is empty, pos at end of str");
|
| is(index("Hello", "", 999), 5, "Substr is empty, pos > length of str");
|
|
|
| # More difficult strings
|
|
|
| is(index("ababcabcd", "abcd"), 5, "Start-of-substr matches several times");
|
|
|
| is(index("uuúuúuùù", "úuù"), 4, "Accented chars");
|
| is(index("Ümlaut", "Ü"), 0, "Umlaut");
|
|
|
|
|
| # call directly with the .notation
|
|
|
| is("Hello".index("l"), 2, ".index on string");
|
|
|
| # work on variables
|
|
|
| my $a = "word";
|
| is($a.index("o"), 1, ".index on scalar variable");
|
|
|
| my @a = <Hello World>;
|
| is(index(@a[0], "l"), 2, "on array element");
|
| is(@a[0].index("l"), 2, ".index on array element");
|
|
|
| # index on junctions, maybe this should be moved to t/junctions/ ?
|
|
|
| my $j = ("Hello"|"World");
|
| ok(index($j, "l") == 2, "index on junction");
|
| ok(index($j, "l") == 3, "index on junction");
|
| ok($j.index("l") == 2, ".index on junction");
|
| ok($j.index("l") == 3, ".index on junction");
|
|
|
|
|
our StrPos multi method index( Str $string: Str $substring, StrPos $pos = StrPos(0) ) is export
index searches for the first occurrence of $substring in $string, starting at $pos.
The value returned is always a StrPos object. If the substring is found, then the StrPos represents the position of the first character of the substring. If the substring is not found, a bare StrPos containing no position is returned. This prototype StrPos evaluates to false because it's really a kind of undef. Do not evaluate as a number, because instead of returning -1 it will return 0 and issue a warning.
our Str multi pack( Str::Encoding $encoding, Pair *@items ) our Str multi pack( Str::Encoding $encoding, Str $template, *@items ) our buf8 multi pack( Pair *@items ) our buf8 multi pack( Str $template, *@items )
pack takes a list of pairs and formats the values according to the specification of the keys. Alternately, it takes a string $template and formats the rest of its arguments according to the specifications in the template string. The result is a sequence of bytes.
An optional $encoding can be used to specify the character encoding to use in interpreting the result as a Str, otherwise the return value will simply be a buf containing the bytes generated by the template(s) and value(s). Note that no guarantee is made in terms of the final, internal representation of the string, only that the generated sequence of bytes will be interpreted as a string in the given encoding, and a string containing those graphemes will be returned. If the sequence of bytes represents an invalid string according to $encoding, an exception is generated.
Templates are strings of the form:
grammar Str::PackTemplate {
regex template { [ <group> | <specifier> <count>? ]* }
token group { \( <template> \) }
token specifier { <[aAZbBhHcCsSiIlLnNvVqQjJfdFDpPuUwxX\@]> \!? }
token count { \* |
\[ [ \d+ | <specifier> ] \] |
\d+ }
}
In the pairwise mode, each key must contain a single <group> or <specifier>, and the values must be either scalar arguments or arrays.
[ Note: Need more documentation and need to figure out what Perl 5 things no longer make sense. Does Perl 6 need any extra formatting
features? -ajs ]
[I think pack formats should be human readable but compiled to an internal form for efficiency. I also think that compact classes should be able to express their serialization in pack form if asked for it with .packformat or some such. -law]
There is no pos function in Perl 6 because that would not allow a string to be shared among threads. Generally you want to use $/.to for that now, or keep your own position variable as a lexical.
From t/spec/S29-str/quotemeta.t lines 35–136 (no results): (skip)
| # L<S29/Str/quotemeta>
|
|
|
| is(quotemeta("HeLLo World-72_1"), "HeLLo\\ World\\-72_1", "simple quotemeta test");
|
| is(quotemeta(""), "", "empty string");
|
|
|
| $_ = "HeLLo World-72_1";
|
| my $x = .quotemeta;
|
| is($x, "HeLLo\\ World\\-72_1", 'quotemeta uses $_ as default');
|
|
|
| { # test invocant syntax for quotemeta
|
| my $x = "HeLLo World-72_1";
|
| is($x.quotemeta, "HeLLo\\ World\\-72_1", '$x.quotemeta works');
|
| is("HeLLo World-72_1".quotemeta, "HeLLo\\ World\\-72_1", '"HeLLo World-72_1".quotemeta works');
|
| }
|
|
|
|
|
| if (%Config<ebcdic> eq 'define') {
|
| $_ = (129 .. 233).map({ chr($_); }).join('');
|
| is($_.chars, 96, "quotemeta starting string");
|
|
|
| # 105 characters - 52 letters = 53 backslashes
|
| # 105 characters + 53 backslashes = 158 characters
|
| $_ = quotemeta $_;
|
| is($_.chars, 158, "quotemeta string");
|
| # 53 backslashed characters + 1 "original" backslash
|
| is($_.split('').grep({ $_ eq "\x5c" }).elems, 54, "count backslashes");
|
| }
|
| else {
|
| $_ = (0 .. 255).map({ chr($_); }).join('');
|
| is($_.chars, 256, "quotemeta starting string");
|
|
|
| # Original test in Perl 5.9.3:
|
| # 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
|
| # 96 characters + 33 backslashes = 129 characters
|
| #
|
| # Then added remaining 32 + 128, all escaped:
|
| # 129 + (32 + 128) * 2 = 449
|
| #
|
| # Total backslashed chars are 33 + 32 + 128 = 193
|
| # Total backslashes are 1 + 193 = 194
|
| $_ = quotemeta $_;
|
| is($_.chars, 449, "quotemeta string");
|
| # 33 backslashed characters + 1 "original" backslash
|
| is($_.split('').grep({ $_ eq "\x5c" }).elems, 194, "count backslashes");
|
| }
|
|
|
| # Current quotemeta implementation mimics that for Perl 5, avoiding
|
| # to escape Unicode characters beyond 256th
|
| is(quotemeta("\x[263a]"), "\x[263a]", "quotemeta Unicode");
|
| is(quotemeta("\x[263a]").chars, 1, "quotemeta Unicode length");
|
|
|
| =begin from_perl5
|
|
|
|
|
| plan tests => 22;
|
|
|
| if ($Config{ebcdic} eq 'define') {
|
| $_ = join "", map chr($_), 129..233;
|
|
|
| # 105 characters - 52 letters = 53 backslashes
|
| # 105 characters + 53 backslashes = 158 characters
|
| $_ = quotemeta $_;
|
| is(length($_), 158, "quotemeta string");
|
| # 104 non-backslash characters
|
| is(tr/\\//cd, 104, "tr count non-backslashed");
|
| } else { # some ASCII descendant, then.
|
| $_ = join "", map chr($_), 32..127;
|
|
|
| # 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
|
| # 96 characters + 33 backslashes = 129 characters
|
| $_ = quotemeta $_;
|
| is(length($_), 129, "quotemeta string");
|
| # 95 non-backslash characters
|
| is(tr/\\//cd, 95, "tr count non-backslashed");
|
| }
|
|
|
| is(length(quotemeta ""), 0, "quotemeta empty string");
|
|
|
| is("aA\UbB\LcC\EdD", "aABBccdD", 'aA\UbB\LcC\EdD');
|
| is("aA\LbB\UcC\EdD", "aAbbCCdD", 'aA\LbB\UcC\EdD');
|
| is("\L\upERL", "Perl", '\L\upERL');
|
| is("\u\LpERL", "Perl", '\u\LpERL');
|
| is("\U\lPerl", "pERL", '\U\lPerl');
|
| is("\l\UPerl", "pERL", '\l\UPerl');
|
| is("\u\LpE\Q#X#\ER\EL", "Pe\\#x\\#rL", '\u\LpE\Q#X#\ER\EL');
|
| is("\l\UPe\Q!x!\Er\El", "pE\\!X\\!Rl", '\l\UPe\Q!x!\Er\El');
|
| is("\Q\u\LpE.X.R\EL\E.", "Pe\\.x\\.rL.", '\Q\u\LpE.X.R\EL\E.');
|
| is("\Q\l\UPe*x*r\El\E*", "pE\\*X\\*Rl*", '\Q\l\UPe*x*r\El\E*');
|
| is("\U\lPerl\E\E\E\E", "pERL", '\U\lPerl\E\E\E\E');
|
| is("\l\UPerl\E\E\E\E", "pERL", '\l\UPerl\E\E\E\E');
|
|
|
| is(quotemeta("\x{263a}"), "\x{263a}", "quotemeta Unicode");
|
| is(length(quotemeta("\x{263a}")), 1, "quotemeta Unicode length");
|
|
|
| $a = "foo|bar";
|
| is("a\Q\Ec$a", "acfoo|bar", '\Q\E');
|
| is("a\L\Ec$a", "acfoo|bar", '\L\E');
|
| is("a\l\Ec$a", "acfoo|bar", '\l\E');
|
| is("a\U\Ec$a", "acfoo|bar", '\U\E');
|
| is("a\u\Ec$a", "acfoo|bar", '\u\E');
|
|
|
| =end from_perl5
|
our Str multi method quotemeta ( Str $string: ) is export
Returns the input string with all non-"word" characters back-slashed. That is, all characters not matching "/[A-Za-z_0-9]/" will be preceded by a backslash in the returned string, regardless of any locale settings.
From t/spec/S29-str/rindex.t lines 4–61 (no results): (skip)
| # L<S29/Str/"=item rindex">
|
|
|
| plan 31;
|
|
|
| # Simple - with just a single char
|
|
|
| is(rindex("Hello World", "H"), 0, "One char, at beginning");
|
| is(rindex("Hello World", "l"), 9, "One char, in the middle");
|
| is(rindex("Hello World", "d"), 10, "One char, in the end");
|
| is(rindex("Hello World", "x"), -1, "One char, no match");
|
|
|
| is(rindex("Hello World", "l", 10), 9, "One char, first match, pos @ end");
|
| is(rindex("Hello World", "l", 9), 9, "- 1. match again, pos @ match");
|
| is(rindex("Hello World", "l", 8), 3, "- 2. match");
|
| is(rindex("Hello World", "l", 2), 2, "- 3. match");
|
| is(rindex("Hello World", "l", 1), -1, "- no more matches");
|
|
|
| # Simple - with a string
|
|
|
| is(rindex("Hello World", "Hello"), 0, "Substr, at beginning");
|
| is(rindex("Hello World", "o W"), 4, "Substr, in the middle");
|
| is(rindex("Hello World", "World"), 6, "Substr, at the end");
|
| is(rindex("Hello World", "low"), -1, "Substr, no match");
|
| is(rindex("Hello World", "Hello World"), 0, "Substr eq Str");
|
|
|
| # Empty strings
|
|
|
| is(rindex("Hello World", ""), 11, "Substr is empty");
|
| is(rindex("", ""), 0, "Both strings are empty");
|
| is(rindex("", "Hello"), -1, "Only main-string is empty");
|
| is(rindex("Hello", "", 3), 3, "Substr is empty, pos within str");
|
| is(rindex("Hello", "", 5), 5, "Substr is empty, pos at end of str");
|
| is(rindex("Hello", "", 999), 5, "Substr is empty, pos > length of str");
|
|
|
| # More difficult strings
|
|
|
| is(rindex("abcdabcab", "abcd"), 0, "Start-of-substr matches several times");
|
|
|
| is(rindex("uuúuúuùù", "úuù"), 4, "Accented chars");
|
| is(rindex("Ümlaut", "Ü"), 0, "Umlaut");
|
|
|
| is(rindex("what are these « » unicode characters for ?", "uni"), 19, "over unicode characters");
|
|
|
| # .rindex use
|
| is("Hello World".rindex("l"), 9, ".rindex on string");
|
| is("Hello World".rindex(''), 11, ".rindex('') on string gives string length in bytes");
|
|
|
| # on scalar variable
|
| my $s = "Hello World";
|
| is(rindex($s, "o"), 7, "rindex on scalar variable");
|
| is($s.rindex("o"), 7, ".rindex on scalar variable");
|
|
|
| is(rindex(uc($s), "O"), 7, "rindex on uc");
|
| is($s.uc.rindex("O"), 7, ".uc.rindex ");
|
|
|
| # ideas for deeper chained . calls ?
|
| is($s.lc.ucfirst.rindex("w"), 6, ".lc.ucfirst.rindex");
|
|
|
our StrPos multi method rindex( Str $string: Str $substring, StrPos $pos? ) is export
Returns the position of the last $substring in $string. If $pos is specified, then the search starts at that location in $string, and works backwards. See index for more detail.
From t/spec/S29-str/split.t lines 5–137 (no results): (skip)
| # L<S29/Str/"=item split">
|
|
|
| # XXX - this needs to be updated when Str.split(Str) works again
|
| # this test really wants is_deeply()
|
| # and got it, except for a couple of cases that fail because of Match objects
|
| # being returned -- Aankhen
|
| plan 27;
|
|
|
| # split on an empty string
|
|
|
| my %ords = (
|
| 1 => 'first',
|
| 2 => 'second',
|
| 3 => 'third',
|
| 4 => 'fourth',
|
| 5 => 'fifth',
|
| 6 => 'sixth',
|
| 7 => 'seventh',
|
| 8 => 'eighth',
|
| 9 => 'ninth',
|
| );
|
|
|
| sub split_test(@splitted, @expected, Str $desc) {
|
| is +@splitted, +@expected,
|
| "split created the correct value amount for: $desc";
|
| is @splitted[$_], @expected[$_],
|
| "the %ords{$_ + 1} value matched for: $desc"
|
| for 0 .. @splitted.end;
|
| is_deeply [~<< @splitted], [~<< @expected], "values match";
|
| }
|
|
|
| is_deeply split("", "forty-two"),
|
| qw/f o r t y - t w o/,
|
| q{split "", Str};
|
|
|
| # split on a space
|
| is_deeply split(' ', 'split this string'),
|
| qw/split this string/,
|
| q{split ' ', Str};
|
|
|
| # split on a single character delimiter
|
| is_deeply split('$', 'try$this$string'),
|
| qw/try this string/,
|
| q{split '$', Str};
|
|
|
| # split on a multi-character delimiter
|
| is_deeply split(', ', "comma, separated, values"),
|
| qw/comma separated values/,
|
| q{split ', ', Str};
|
|
|
| # split on a variable delimiter
|
|
|
| my $delimiter = '::';
|
| is_deeply split($delimiter, "Perl6::Pugs::Test"),
|
| qw/Perl6 Pugs Test/,
|
| q{split $delimiter, Str};
|
|
|
| # split with a reg-exp
|
| is_deeply split(rx:Perl5 {,}, "split,me"),
|
| qw/split me/,
|
| q/split rx:Perl5 {,}, Str/;
|
|
|
| # split on multiple space characters
|
| is_deeply split(rx:Perl5 {\s+}, "Hello World Goodbye Mars"),
|
| qw/Hello World Goodbye Mars/,
|
| q/split rx:Perl5 {\s+}, Str/;
|
|
|
| is_deeply split(rx:Perl5 {(\s+)}, "Hello test"),
|
| ('Hello', ("Hello test" ~~ rx:Perl5 {(\s+)}), 'test'),
|
| q/split rx:Perl5 {(\s+)}, Str/;
|
|
|
| is_deeply "to be || ! to be".split(' '),
|
| qw/to be || ! to be/,
|
| q/Str.split(' ')/;
|
|
|
| is_deeply "this will be split".split(rx:Perl5 { }),
|
| qw/this will be split/,
|
| q/Str.split(rx:Perl5 { })/;
|
|
|
| # split on multiple space characters
|
| diag "here";
|
| is_deeply split(rx:Perl5 {\s+}, "Hello World Goodbye Mars", 3),
|
| ( qw/Hello World/, "Goodbye Mars" ),
|
| q/split rx:Perl5 {\s+}, Str, limit/;
|
|
|
| is_deeply split(" ", "Hello World Goodbye Mars", 3),
|
| ( qw/Hello World/, " Goodbye Mars" ),
|
| q/split " ", Str, limit/;
|
|
|
| is_deeply "Hello World Goodbye Mars".split(rx:Perl5 {\s+}, 3),
|
| ( qw/Hello World/, "Goodbye Mars" ),
|
| q/Str.split(rx:Perl5 {\s+}, limit)/;
|
|
|
| is_deeply "Hello World Goodbye Mars".split(" ", 3),
|
| ( qw/Hello World/, " Goodbye Mars" ),
|
| q/Str.split(" ", limit)/;
|
|
|
| is_deeply "Word".split("", 3), qw/W o rd/,
|
| q/Str.split("", limit)/;
|
|
|
| # XXX: Here Pugs emulates p5 default awk field splitting behaviour.
|
| is_deeply " abc def ".split(), qw/abc def/,
|
| q/Str.split()/;
|
| # ... yet how do you do this with p6 function form of split?
|
| # Note that split(' ', $x) special casing of ' ' pattern (a la p5)
|
| # is not implemented in Pugs. Should it be?
|
|
|
| # This one returns an empty list
|
| is_deeply "".split(), (),
|
| q/"".split()/;
|
|
|
| # ... yet this one does not (different to p5).
|
| # blessed by $Larry at Message-ID: <20060118191046.GB32562@wall.org>
|
| split_test "".split(':'), (""),
|
| q/"".split(':')/;
|
|
|
| # using /.../
|
| is_deeply "a.b".split(/\./), <a b>,
|
| q{"a.b".split(/\./)};
|
|
|
| is_deeply "abcd".split(/<null>/), <a b c d>,
|
| q{"abcd".split(/<null>/)};
|
|
|
| {
|
| ' ' ~~ /(\s)/;
|
|
|
| if $0 eq ' ' {
|
| is_deeply "foo bar baz".split(/<prior>/), <foo bar baz>,
|
| q{"foo bar baz".split(/<prior>/)};
|
| } else {
|
| skip q{' ' ~~ /\s/ did not result in ' '};
|
| }
|
| }
|
our List multi method split ( Str $input: Str $delimiter, Int $limit = * ) is export our List multi method split ( Str $input: Rule $delimiter, Int $limit = * ) is export
String delimiters must not be treated as rules but as constants. The default is no longer ' ' since that would be interpreted as a constant. P5's split(' ') will translate to comb. Null trailing fields are no longer trimmed by default.
The split function no longer has a default delimiter nor a default invocant. In general you should use comb to split on whitespace now, or to break into individual characters. See below.
As with Perl 5's split, if there is a capture in the pattern it is returned in alternation with the split values. Unlike with Perl 5, multiple such captures are returned in a single Match object. Also unlike Perl 5, the string to be split is always the invocant or first argument. A warning should be issued if the string appears to be a short constant string and the delimiter does not.
You may also split lists and filehandles. $*ARGS.split(/\n[\h*\n]+/) splits on paragraphs, for instance. Lists and filehandles are automatically fed through cat in order to pretend to be string. The resulting Cat is lazy. Accessing a filehandle as both a filehandle and as a Cat is undefined.
From t/spec/S29-str/comb.t lines 7–45 (no results): (skip)
| # L<S29/Str/=item comb>
|
|
|
| # comb Str
|
| is "".comb, (), 'comb on empty string';
|
| is "a bc d".comb, <a bc d>, 'default matcher and limit';
|
|
|
| #?pugs: todo('feature', 1);
|
| is "a bc d".comb(:limit(2)), <a bc>, 'default matcher with supplied limit';
|
|
|
| is_deeply @('split this string'.comb).map:{ "$_" },
|
| <split this string>,
|
| q{Str.comb};
|
|
|
| is "a ab bc ad ba".comb(m:Perl5/\ba\S*/), <a ab ad>,
|
| 'match for any a* words';
|
| is "a ab bc ad ba".comb(m:Perl5/\S*a\S*/), <a ab ad ba>,
|
| 'match for any *a* words';
|
|
|
| #?pugs: todo('feature', 1);
|
| is eval('"a ab bc ad ba".comb(m:Perl5/\S*a\S*/, 2)'), <a ab>,
|
| 'matcher and limit';
|
|
|
| is_deeply "forty-two".comb(/./),
|
| qw/f o r t y - t w o/,
|
| q{Str.comb(/./)};
|
|
|
| is_deeply "forty two".comb(/./),
|
| (qw/f o r t y/, ' ', qw/t w o/),
|
| q{Str.comb(/./)};
|
|
|
| # comb a list
|
|
|
| #?pugs: todo('feature', 1);
|
| is eval('(<a ab>, <bc ad ba>).comb(m:Perl5/\S*a\S*/)'), <a ab ad ba>,
|
| 'comb a list';
|
|
|
| # needed: comb a filehandle
|
|
|
| # needed: captures in pattern return Match objects
|
our List multi method comb ( Str $input: Rule $matcher = /\S+/, Int $limit = * ) is export
The comb function looks through a string for the interesting bits, ignoring the parts that don't match. In other words, it's a version of split where you specify what you want, not what you don't want. By default it pulls out all the words. Saying
$string.comb(/pat/, $n)
is equivalent to
$string.match(rx:global:x(0..$n):c/pat/)
You may also comb lists and filehandles. +$*IN.comb counts the words on standard input, for instance. comb($thing, /./) returns a list of Char from anything that can give you a Str. Lists and filehandles are automatically fed through cat in order to pretend to be string. This Cat is also lazy.
If there are captures in the pattern, a list of Match objects (one per match) is returned instead of strings. The unmatched portions are never returned. If the function is combing a lazy structure, the return values may also be lazy. (Strings are not lazy, however.)
our Str multi method sprintf ( Str $format: *@args ) is export
This function is mostly identical to the C library sprintf function.
From t/spec/S29-str/sprintf.t lines 7–22 (no results): (skip)
| # L<S29/Str/"identical to" "C library sprintf">
|
|
|
| is sprintf("Hi"), "Hi", "sprintf() works with zero args";
|
| is sprintf("%03d", 3), "003", "sprintf() works with one arg";
|
| is sprintf("%03d %02d", 3, 1), "003 01", "sprintf() works with two args";
|
| is sprintf("%d %d %d", 3,1,4), "3 1 4", "sprintf() works with three args";
|
| is sprintf("%d%d%d%d", 3,1,4,1), "3141", "sprintf() works with four args";
|
|
|
| ok(eval('sprintf("%b",1)'), 'eval of sprintf() with %b');
|
|
|
| is sprintf("%04b",3), '0011', '0-padded sprintf() with %b';
|
| is sprintf("%4b",3), ' 11', '" "-padded sprintf() with %b';
|
| is sprintf("%b",30), '11110', 'longer string, no padding';
|
| is sprintf("%2b",30), '11110', 'padding specified, not needed';
|
| is sprintf("%03b",7), '111', '0 padding, longer string';
|
| is sprintf("%b %b",3,3), '11 11', 'two args %b';
|
The $format is scanned for % characters. Any % introduces a format token. Format tokens have the following grammar:
grammar Str::SprintfFormat {
regex format_token { '%': <index>? <precision>? <modifier>? <directive> }
token index { \d+ '$' }
token precision { <flags>? <vector>? <precision_count> }
token flags { <[ \x20 + 0 \# \- ]>+ }
token precision_count { [ <[1..9]>\d* | '*' ]? [ '.' [ \d* | '*' ] ]? }
token vector { '*'? v }
token modifier { < ll l h m V q L > }
token directive { < % c s d u o x e f g X E G b p n i D U O F > }
}
Directives guide the use (if any) of the arguments. When a directive (other than %) are used, they indicate how the next argument passed is to be formatted into the string.
The directives are:
% a literal percent sign c a character with the given codepoint s a string d a signed integer, in decimal u an unsigned integer, in decimal o an unsigned integer, in octal x an unsigned integer, in hexadecimal e a floating-point number, in scientific notation f a floating-point number, in fixed decimal notation g a floating-point number, in %e or %f notation X like x, but using upper-case letters E like e, but using an upper-case "E" G like g, but with an upper-case "E" (if applicable) b an unsigned integer, in binary C special: invokes the arg as code, see below
Compatibility:
i a synonym for %d D a synonym for %ld U a synonym for %lu O a synonym for %lo F a synonym for %f
Perl 5 compatibility:
n produces a runtime exception (see below) p produces a runtime exception
The special format directive, %C invokes the target argument as code, passing it the result string that has been generated thus far and the argument array.
Here's an example of its use:
sprintf "%d%C is %d digits long",
$num,
sub($s,@args is rw) {@args[2]=$s.elems},
0;
The special directive, %n does not work in Perl 6 because of the difference in parameter passing conventions, but the example above simulates its effect using %C.
Modifiers change the meaning of format directives. The most important being support for complex numbers (a basic type in Perl). Here are all of the modifiers and what they modify:
h interpret integer as native "short" (typically int16) l interpret integer as native "long" (typically int32 or int64) ll interpret integer as native "long long" (typically int64) L interpret integer as native "long long" (typically uint64) q interpret integer as native "quads" (typically int64 or larger) m interpret value as a complex number
The m modifier works with d,u,o,x,F,E,G,X,E and G format directives, and the directive applies to both the real and imaginary parts of the complex number.
Examples:
sprintf "%ld a big number, %lld a bigger number, %mf complexity\n",
4294967295, 4294967296, 1+2i);
From t/spec/S29-str/substr.t lines 7–115 (no results): (skip)
| # L<S29/Str/=item substr>
|
|
|
| { # read only
|
| my $str = "foobar";
|
|
|
| is(substr($str, 0, 1), "f", "first char");
|
| is(substr($str, -1), "r", "last char");
|
| is(substr($str, -4, 2), "ob", "counted from the end");
|
| is(substr($str, 1, 2), "oo", "arbitrary middle");
|
| is(substr($str, 3), "bar", "length omitted");
|
| is(substr($str, 3, 10), "bar", "length goes past end");
|
| is(substr($str, 20, 5), undef, "substr outside of string");
|
| is(substr($str, -100, 10), undef, "... on the negative side");
|
|
|
| is(substr($str, 0, -2), "foob", "from beginning, with negative length");
|
| is(substr($str, 2, -2), "ob", "in middle, with negative length");
|
| is(substr($str, 3, -3), "", "negative length - gives empty string");
|
|
|
| is($str, "foobar", "original string still not changed");
|
| };
|
|
|
| #?pugs: skip('more discussion needed', 4);
|
| { # replacement
|
| my $str = "foobar";
|
|
|
| substr($str, 2, 1, "i");
|
| is($str, "foibar", "fourth arg to substr replaced part");
|
|
|
| substr($str, -1, 1, "blah");
|
| is($str, "foibablah", "longer replacement expands string");
|
|
|
| substr($str, 1, 3, "");
|
| is($str, "fablah", "shorter replacement shrunk it");
|
|
|
| substr($str, 1, -1, "aye");
|
| is($str, "fayeh", "replacement with negative length");
|
| };
|
|
|
| # as lvalue, XXX: not sure this should work, as that'd be action at distance:
|
| # my $substr = \substr($str, ...);
|
| # ...;
|
| # some_func $substr; # manipulates $substr
|
| # # $str altered!
|
| # But one could think that's the wanted behaviour, so I leave the test in.
|
| {
|
| my $str = "gorch ding";
|
|
|
| substr($str, 0, 5) = "gloop";
|
| is($str, "gloop ding", "lvalue assignment modified original string");
|
|
|
| my $r = \substr($str, 0, 5);
|
| ok(~WHAT($r), '$r is a reference');
|
| is($$r, "gloop", '$r referent is eq to the substring');
|
|
|
| #?pugs: todo('scalarrefs are not handled correctly', 1);
|
| $$r = "boing";
|
| is($str, "boing ding", "assignment to reference modifies original");
|
| is($$r, "boing", '$r is consistent');
|
|
|
| #?pugs: todo('scalarrefs are not handled correctly', 3);
|
| my $o = \substr($str, 3, 2);
|
| is($$o, "ng", "other ref to other lvalue");
|
| $$r = "foo";
|
| is($str, "foo ding", "lvalue ref size varies but still works");
|
| is($$o, " d", "other lvalue wiggled around");
|
|
|
| };
|
|
|
| { # as lvalue, should work
|
| my $str = "gorch ding";
|
|
|
| substr($str, 0, 5) = "gloop";
|
| is($str, "gloop ding", "lvalue assignment modified original string");
|
| };
|
|
|
| { # as lvalue, using :=, should work
|
| my $str = "gorch ding";
|
|
|
| substr($str, 0, 5) = "gloop";
|
| is($str, "gloop ding", "lvalue assignment modified original string");
|
|
|
| my $r := substr($str, 0, 5);
|
| is($r, "gloop", 'bound $r is eq to the substring');
|
|
|
| $r = "boing";
|
| is($str, "boing ding", "assignment to bound var modifies original");
|
| #?pugs: todo('bug', 1);
|
| is($r, "boing", 'bound $r is consistent');
|
|
|
| my $o := substr($str, 3, 2);
|
| is($o, "ng", "other bound var to other lvalue");
|
| $r = "foo";
|
| is($str, "foo ding", "lvalue ref size varies but still works");
|
| #?pugs: todo('bug', 1);
|
| is($o, " d", "other lvalue wiggled around");
|
| };
|
|
|
| { # misc
|
| my $str = "hello foo and bar";
|
| is(substr($str, 6, 3), "foo", "substr");
|
| is($str.substr(6, 3), "foo", ".substr");
|
| is(substr("hello foo bar", 6, 3), "foo", "substr on literal string");
|
| is("hello foo bar".substr(6, 3), "foo", ".substr on literal string");
|
| is("hello foo bar".substr(6, 3).uc, "FOO", ".substr.uc on literal string");
|
| is("hello foo bar and baz".substr(6, 10).capitalize, "Foo Bar An", ".substr.capitalize on literal string");
|
| is("hello »« foo".substr(6, 2), "»«", ".substr on unicode string");
|
| is("שיעבוד כבר".substr(4, 4), "וד כ", ".substr on Hebrew text");
|
| }
|
|
|
our Str multi method substr (Str $string: StrPos $start, StrLen $length?) is rw is export our Str multi method substr (Str $string: StrPos $start, StrPos $end?) is rw is export our Str multi method substr (Str $string: StrPos $start, Int $length) is rw is export
substr returns part of an existing string. You control what part by passing a starting position and optionally either an end position or length. If you pass a number as either the position or length, then it will be used as the start or length with the assumtion that you mean "chars" in the current Unicode abstraction level, which defaults to graphemes. A number in the 3rd argument is interpreted as a length rather than a position (just as in Perl 5).
Here is an example of its use:
$initials = substr($first_name,0,1) ~ substr($last_name,0,1);
Optionally, you can use substr on the left hand side of an assignment like so:
$string ~~ /(barney)/; substr($string, $0.from, $0.to) = "fred";
If the replacement string is longer or shorter than the matched sub-string, then the original string will be dynamically resized.
Should replace vec with declared buffer/array of bit, uint2, uint4, etc.
From t/builtins/control_flow/eval.t lines 5–38 (7 √, 1 ×): (skip)
| # L<S29/Context/"=item eval"> |
| |
| =pod |
| |
| Tests for the eval() builtin |
| |
| =cut |
| |
| |
| if $?PUGS_BACKEND ne "BACKEND_PUGS" { |
| skip_rest "PIL2JS and PIL-Run do not support eval() yet."; |
| exit; |
| } |
| |
| # eval should evaluate the code in the lexical scope of eval's caller |
| sub make_eval_closure { my $a = 5; sub ($s) { eval $s } }; |
√ | is(make_eval_closure()('$a'), 5); |
| |
√ | is(eval('5'), 5); |
| my $foo = 1234; |
√ | is(eval('$foo'), $foo); |
| |
| # traps die? |
√ | ok(!eval('die; 1'), "eval can trap die"); |
| |
√ | ok(!eval('my @a = (1); @a<0>'), "eval returns undef on syntax error"); |
| |
√ | ok(!eval('use Poison; 1'), "eval can trap a fatal use statement"); |
| |
| sub v { 123 } |
√ | ok(v() == 123, "a plain subroutine"); |
| eval 'sub v { 456 }'; |
× | ok(v() == 456, "eval can overwrite a subroutine"); |
| |
multi eval ( Str $code, Grammar :$lang = CALLER::<$?PARSER>)
Execute $code as if it were code written in $lang. The default is the language in effect at the exact location of the eval call.
Returns whatever $code returns, or fails.
From t/builtins/control_flow/evalfile.t lines 5–23 (1 √, 0 ×): (skip)
| # L<S29/Context/"=item evalfile"> |
| |
| sub nonce () { return (".$*PID." ~ int rand 1000) } |
| |
| if $*OS eq "browser" { |
| skip_rest "Programs running in browsers don't have access to regular IO."; |
| exit; |
| } |
| |
| my $tmpfile = "temp-evalfile" ~ nonce(); |
| { |
| my $fh = open("$tmpfile", :w); |
| say $fh: "32 + 10"; |
| close $fh; |
| } |
| |
√ | is evalfile($tmpfile), 42, "evalfile() works"; |
| |
| END { unlink $tmpfile } |
multi evalfile (Str $filename ; Grammar :$lang = Perl6)
Behaves like, and replaces Perl 5 do EXPR, with optional $lang support.
From t/builtins/control_flow/exit-in-if.t lines 5–18 (1 √, 0 ×): (skip)
| # L<S29/Context/"=item exit"> |
| |
| # This test is primarily aimed at PIL2JS. |
| # In conditionals, or, to be more exact, in all things using PIL2JS.cps2normal, |
| # exit() did call all END blocks, but the control flow was resumed afterwards. |
| # This is now fixed, but it's still good to have a test for it. |
| |
| |
| if 1 { |
√ | pass; |
| exit; |
| } |
| |
| ok 0, "exit() in if didn't work"; |
From t/builtins/control_flow/exit.t lines 4–11 (1 √, 0 ×): (skip)
| # L<S29/Context/"=item exit"> |
| |
| # This test is primarily aimed at PIL2JS. |
| |
| plan 1; |
√ | pass; |
| exit; |
| ok 0, "exit() didn't work"; |
multi exit (Int $status = 0)
Stops all program execution, and returns $status to the calling environment.
From t/builtins/control_flow/nothing.t lines 11–21 (2 √, 0 ×): (skip)
| # L<S29/Context/=item nothing> |
| |
| plan 2; |
| |
√ | lives_ok { nothing }, "nothing() works"; |
| |
| # Probably the most commonly used form: |
| my $var; |
| nothing while $var++ < 3; |
| # We're still here, so pass(). |
√ | pass "nothing() works in while"; |
multi nothing ()
No operation. Literally does nothing.
From t/builtins/control_flow/sleep.t lines 4–18 (3 √, 1 ×): (skip)
| # L<S29/Context/"=item sleep"> |
| |
| |
| plan 4; |
| |
| my $start = time(); |
| diag "Sleeping for 3s"; |
| my $sleep_says = sleep 3; |
| my $diff = time() - $start; |
| |
× | cmp_ok( $sleep_says, &infix:«>=», 2, 'Sleep says it slept at least 2 seconds'); |
√ | cmp_ok( $sleep_says, &infix:«<=», 10, '... and no more than 10' ); |
| |
√ | cmp_ok( $diff, &infix:«>=», 2, 'Actual time diff is at least 2 seconds' ); |
√ | cmp_ok( $diff, &infix:«<=», 10, '... and no more than 10' ); |
our Num multi sleep ( Num $for = Inf )
Attempt to sleep for up to $for seconds. Implementations are obligated to support sub-second resolutions if that is at all possible.
See Synopsis 17: Concurrency for more details.
From t/builtins/control_flow/die.t lines 5–49 (14 √, 0 ×): (skip)
| # L<S29/Context/=item die> |
| |
| =pod |
| |
| Tests for the die() builtin |
| |
| =cut |
| |
√ | ok(!try { die "foo"; 1 }); |
| my $error = $!; |
√ | is($error, 'foo', 'got $! correctly'); |
| |
| my $foo = "-foo-"; |
| try { $foo = die "bar" }; |
| $foo; # this is testing for a bug where an error is stored into $foo in |
| # the above eval; unfortunately the if below doesn't detect this on it's |
| # own, so this lone $foo will die if the bug is present |
√ | ok($foo eq "-foo-"); |
| |
| sub recurse { |
| my $level=@_[0]; |
| $level>0 or die "Only this\n"; |
| recurse(--$level); |
| } |
| try { recurse(1) }; |
√ | is($!, "Only this\n"); |
| |
| # die in if,map,grep etc. |
√ | is ({ try { map { die }, 1,2,3 }; 42 }()), 42, "die in map"; |
√ | is ({ try { grep { die }, 1,2,3 }; 42 }()), 42, "die in grep"; |
√ | is ({ try { sort { die }, 1,2,3 }; 42 }()), 42, "die in sort"; |
√ | is ({ try { reduce { die }, 1,2,3 }; 42 }()), 42, "die in reduce"; |
√ | is ({ try { min { die }, 1,2,3 }; 42 }()), 42, "die in min"; |
√ | is ({ try { max { die }, 1,2,3 }; 42 }()), 42, "die in max"; |
| |
√ | is ({ try { for 1,2,3 { die } }; 42 }()), 42, "die in for"; |
√ | is ({ try { if 1 { die } else { die } }; 42 }()), 42, "die in if"; |
| |
| my sub die_in_return () { return die }; |
√ | is ({ try { die_in_return(); 23 }; 42 }()), 42, "die in return"; |
| |
| # If one of the above tests caused weird continuation bugs, the following line |
| # will be executed multiple times, resulting in a "too many tests run" error |
| # (which is what we want). (Test primarily aimed at PIL2JS) |
√ | is 42-19, 23, "basic sanity"; |
From t/builtins/control_flow/die_arg_preservation.t lines 5–48 (9 √, 1 ×): (skip)
| # L<S29/Context/"=item die"> |
| |
| =pod |
| |
| Tests that die() preserves the data type of its argument, |
| and does not cast its argument as a Str. |
| |
| =cut |
| |
| |
| try { |
| my Bool $foo = Bool::True; |
√ | is( $foo.WHAT, Bool, 'arg to be given as die() arg contains a Bool value' ); |
| die $foo; |
| }; |
√ | is( $!.WHAT, Bool, 'following try { die() } with Bool arg, $! contains a Bool value' ); |
| |
| try { |
| my Int $foo = 42; |
√ | is( $foo.WHAT, Int, 'arg to be given as die() arg contains a Int value' ); |
| die $foo; |
| }; |
√ | is( $!.WHAT, Int, 'following try { die() } with Int arg, $! contains a Int value' ); |
| |
| try { |
| my Str $foo = 'hello world'; |
√ | is( $foo.WHAT, 'Str', 'arg to be given as die() arg contains a Str value' ); |
| die $foo; |
| }; |
√ | is( $!.WHAT, Str, 'following try { die() } with Str arg, $! contains a Str value' ); |
| |
| try { |
| my Pair $foo = ('question' => 'answer'); |
√ | is( $foo.WHAT, Pair, 'arg to be given as die() arg contains a Pair value' ); |
| die $foo; |
| }; |
× | is( $!.WHAT, Pair, 'following try { die() } with Pair arg, $! contains a Pair value', :todo<bug> ); |
| |
| try { |
| my Object $foo .= new(); |
√ | is( $foo.WHAT, Object, 'arg to be given as die() arg contains a Object value' ); |
| die $foo; |
| }; |
√ | is( $!.WHAT, Object, 'following try { die() } with Object arg, $! contains a Object value' ); |
TODO: Research the exception handling system.
our Object multi method bless( Object::RepCandidate $candidate ) our Object multi method bless( *%args )
bless is only available as a method which can be called on a prototype object like so:
$object = $proto.bless(k1 => $v1, k2 => $v2, ...);
A newly created object, based on either the $candidate representation or a newly created representation (initialized with the %args that are passed in) when the second form is used.
It automatically calls all appropriate BUILD routines by calling the BUILDALL routine for the current class, which initializes the object in least-derived to most-derived order. See "Objects" in S12 for more detailed information on object creation.
From t/spec/S29-conversions/ord_and_chr.t lines 12–136 (no results): (skip)
| # L<S29/Conversions/chr>
|
|
|
| # What is the best way to test 0 through 31??
|
| my @maps = (
|
| " ", 32,
|
| "!", 33,
|
| "\"", 34,
|
| "#", 35,
|
| "$", 36,
|
| "%", 37,
|
| "&", 38,
|
| "\'", 39,
|
| "(", 40,
|
| ")", 41,
|
| "*", 42,
|
| "+", 43,
|
| ",", 44,
|
| "-", 45,
|
| ".", 46,
|
| "/", 47,
|
| "0", 48,
|
| "1", 49,
|
| "2", 50,
|
| "3", 51,
|
| "4", 52,
|
| "5", 53,
|
| "6", 54,
|
| "7", 55,
|
| "8", 56,
|
| "9", 57,
|
| ":", 58,
|
| ";", 59,
|
| "<", 60,
|
| "=", 61,
|
| ">", 62,
|
| "?", 63,
|
| "@", 64,
|
| "A", 65,
|
| "B", 66,
|
| "C", 67,
|
| "D", 68,
|
| "E", 69,
|
| "F", 70,
|
| "G", 71,
|
| "H", 72,
|
| "I", 73,
|
| "J", 74,
|
| "K", 75,
|
| "L", 76,
|
| "M", 77,
|
| "N", 78,
|
| "O", 79,
|
| "P", 80,
|
| "Q", 81,
|
| "R", 82,
|
| "S", 83,
|
| "T", 84,
|
| "U", 85,
|
| "V", 86,
|
| "W", 87,
|
| "X", 88,
|
| "Y", 89,
|
| "Z", 90,
|
| "[", 91,
|
| "\\", 92,
|
| "]", 93,
|
| "^", 94,
|
| "_", 95,
|
| "`", 96,
|
| "a", 97,
|
| "b", 98,
|
| "c", 99,
|
| "d", 100,
|
| "e", 101,
|
| "f", 102,
|
| "g", 103,
|
| "h", 104,
|
| "i", 105,
|
| "j", 106,
|
| "k", 107,
|
| "l", 108,
|
| "m", 109,
|
| "n", 110,
|
| "o", 111,
|
| "p", 112,
|
| "q", 113,
|
| "r", 114,
|
| "s", 115,
|
| "t", 116,
|
| "u", 117,
|
| "v", 118,
|
| "w", 119,
|
| "x", 120,
|
| "y", 121,
|
| "z", 122,
|
| "|", 124,
|
| "}", 125,
|
| "~", 126,
|
|
|
| # Unicode tests
|
| "ä", 228,
|
| "€", 8364,
|
| "»", 187,
|
| "«", 171,
|
|
|
| # Special chars
|
| "\o00", 0,
|
| "\o01", 1,
|
| "\o03", 3,
|
| );
|
|
|
| plan 32+@maps;
|
|
|
| for @maps -> $char, $code {
|
| my $descr = "\\{$code}{$code >= 32 ?? " == '{$char}'" !! ""}";
|
| is ord($char), $code, "ord() works for $descr";
|
| is chr($code), $char, "chr() works for $descr";
|
| }
|
|
|
| for 0..31 -> $code {
|
| my $char = chr($code);
|
| is ord($char), $code, "ord(chr($code)) is $code";
|
| }
|
|
|
|
|
From t/spec/S29-conversions/ord_and_chr.t lines 11–136 (no results): (skip)
| # L<S29/Conversions/ord>
|
| # L<S29/Conversions/chr>
|
|
|
| # What is the best way to test 0 through 31??
|
| my @maps = (
|
| " ", 32,
|
| "!", 33,
|
| "\"", 34,
|
| "#", 35,
|
| "$", 36,
|
| "%", 37,
|
| "&", 38,
|
| "\'", 39,
|
| "(", 40,
|
| ")", 41,
|
| "*", 42,
|
| "+", 43,
|
| ",", 44,
|
| "-", 45,
|
| ".", 46,
|
| "/", 47,
|
| "0", 48,
|
| "1", 49,
|
| "2", 50,
|
| "3", 51,
|
| "4", 52,
|
| "5", 53,
|
| "6", 54,
|
| "7", 55,
|
| "8", 56,
|
| "9", 57,
|
| ":", 58,
|
| ";", 59,
|
| "<", 60,
|
| "=", 61,
|
| ">", 62,
|
| "?", 63,
|
| "@", 64,
|
| "A", 65,
|
| "B", 66,
|
| "C", 67,
|
| "D", 68,
|
| "E", 69,
|
| "F", 70,
|
| "G", 71,
|
| "H", 72,
|
| "I", 73,
|
| "J", 74,
|
| "K", 75,
|
| "L", 76,
|
| "M", 77,
|
| "N", 78,
|
| "O", 79,
|
| "P", 80,
|
| "Q", 81,
|
| "R", 82,
|
| "S", 83,
|
| "T", 84,
|
| "U", 85,
|
| "V", 86,
|
| "W", 87,
|
| "X", 88,
|
| "Y", 89,
|
| "Z", 90,
|
| "[", 91,
|
| "\\", 92,
|
| "]", 93,
|
| "^", 94,
|
| "_", 95,
|
| "`", 96,
|
| "a", 97,
|
| "b", 98,
|
| "c", 99,
|
| "d", 100,
|
| "e", 101,
|
| "f", 102,
|
| "g", 103,
|
| "h", 104,
|
| "i", 105,
|
| "j", 106,
|
| "k", 107,
|
| "l", 108,
|
| "m", 109,
|
| "n", 110,
|
| "o", 111,
|
| "p", 112,
|
| "q", 113,
|
| "r", 114,
|
| "s", 115,
|
| "t", 116,
|
| "u", 117,
|
| "v", 118,
|
| "w", 119,
|
| "x", 120,
|
| "y", 121,
|
| "z", 122,
|
| "|", 124,
|
| "}", 125,
|
| "~", 126,
|
|
|
| # Unicode tests
|
| "ä", 228,
|
| "€", 8364,
|
| "»", 187,
|
| "«", 171,
|
|
|
| # Special chars
|
| "\o00", 0,
|
| "\o01", 1,
|
| "\o03", 3,
|
| );
|
|
|
| plan 32+@maps;
|
|
|
| for @maps -> $char, $code {
|
| my $descr = "\\{$code}{$code >= 32 ?? " == '{$char}'" !! ""}";
|
| is ord($char), $code, "ord() works for $descr";
|
| is chr($code), $char, "chr() works for $descr";
|
| }
|
|
|
| for 0..31 -> $code {
|
| my $char = chr($code);
|
| is ord($char), $code, "ord(chr($code)) is $code";
|
| }
|
|
|
|
|
multi Char method chr( Int $grid: ) is export multi Char sub chr( Int *@grid ) multi Int method ord( Str $string: ) is export
chr takes zero or more integer grapheme ids and returns the corresponding characters as a string. If any grapheme id is used that represents a higher abstraction level than the current lexical scope supports, that grapheme is converted to the corresponding lower-level string of codepoints/bytes that would be appropriate to the current context, just as any other Str would be downgraded in context.
ord goes the other direction; it takes a string value and returns character values as integers. In a scalar context, the return value is the just the integer value of the first character in the string. In a list context, the return value is the list of integers representing the entire string. The definition of character is context dependent. Normally it's a grapheme id, but under codepoints or bytes scopes, the string is coerced to the appropriate low-level view and interpreted as codepoints or bytes. Hence, under "use bytes" you will never see a value larger than 256, and under "use codepoints" you will never see a value larger than 0x10ffff. The only guarantee under "use graphemes" (the default) is that the number returned will correspond to the codepoint of the precomposed codepoint representing the grapheme, if there is such a codepoint. Otherwise, the implementation is free to return any unique id that larger than 0x10ffff. (The chr function will know how to backtranslate such ids properly to codepoints or bytes in any context. Note that we are assuming that every codepoints context knows its normalization preferences, and every bytes context also knows its encoding preferences. (These are knowable in the lexical scope via the $?NF and $?ENC compile-time constants).)
our List multi list ( *@list )
Forces List Context on it's arguments, and returns them.
our Item multi item ( $item )
Forces generic Item context on its argument, and returns it.
our Num multi prefix:<:16> ( Str $hexstr )
From t/spec/S02-literals/radix.t lines 33–82 (no results): (skip)
| # L<S29/Conversions/"prefix:<:16>">
|
| # L<S02/Literals/":16<DEAD_BEEF>">
|
|
|
| # 0 - 9 is the same int
|
| is(:16(0), 0, 'got the correct int value from hex 0');
|
| is(:16(1), 1, 'got the correct int value from hex 1');
|
| is(:16(2), 2, 'got the correct int value from hex 2');
|
| is(:16(3), 3, 'got the correct int value from hex 3');
|
| is(:16(4), 4, 'got the correct int value from hex 4');
|
| is(:16(5), 5, 'got the correct int value from hex 5');
|
| is(:16(6), 6, 'got the correct int value from hex 6');
|
| is(:16(7), 7, 'got the correct int value from hex 7');
|
| is(:16(8), 8, 'got the correct int value from hex 8');
|
| is(:16(9), 9, 'got the correct int value from hex 9');
|
|
|
| # check uppercase vals
|
| is(:16("A"), 10, 'got the correct int value from hex A');
|
| is(:16("B"), 11, 'got the correct int value from hex B');
|
| is(:16("C"), 12, 'got the correct int value from hex C');
|
| is(:16("D"), 13, 'got the correct int value from hex D');
|
| is(:16("E"), 14, 'got the correct int value from hex E');
|
| is(:16("F"), 15, 'got the correct int value from hex F');
|
|
|
| # check lowercase vals
|
| is(:16("a"), 10, 'got the correct int value from hex a');
|
| is(:16("b"), 11, 'got the correct int value from hex b');
|
| is(:16("c"), 12, 'got the correct int value from hex c');
|
| is(:16("d"), 13, 'got the correct int value from hex d');
|
| is(:16("e"), 14, 'got the correct int value from hex e');
|
| is(:16("f"), 15, 'got the correct int value from hex f');
|
|
|
| # check 2 digit numbers
|
| is(:16(10), 16, 'got the correct int value from hex 10');
|
| is(:16(20), 32, 'got the correct int value from hex 20');
|
| is(:16(30), 48, 'got the correct int value from hex 30');
|
| is(:16(40), 64, 'got the correct int value from hex 40');
|
| is(:16(50), 80, 'got the correct int value from hex 50');
|
|
|
| # check 3 digit numbers
|
| is(:16(100), 256, 'got the correct int value from hex 100');
|
|
|
| # check some weird versions
|
| is(:16("FF"), 255, 'got the correct int value from hex FF');
|
| is(:16("fF"), 255, 'got the correct int value from (mixed case) hex fF');
|
|
|
| # some random mad up hex strings (these values are checked against perl5)
|
| is :16("FFACD5FE"), 4289517054, 'got the correct int value from hex FFACD5FE';
|
| is :16("AAA4872D"), 2862909229, 'got the correct int value from hex AAA4872D';
|
| is :16<DEAD_BEEF>, 0xDEADBEEF, 'got the correct int value from hex DEAD_BEEF';
|
|
|
our Num multi prefix:<:8> ( Str $octstr )
From t/spec/S02-literals/radix.t lines 112–137 (no results): (skip)
| # L<S29/Conversions/"prefix:<:8>">
|
|
|
| # 0 - 7 is the same int
|
| is(:8(0), 0, 'got the correct int value from oct 0');
|
| is(:8(1), 1, 'got the correct int value from oct 1');
|
| is(:8(2), 2, 'got the correct int value from oct 2');
|
| is(:8(3), 3, 'got the correct int value from oct 3');
|
| is(:8(4), 4, 'got the correct int value from oct 4');
|
| is(:8(5), 5, 'got the correct int value from oct 5');
|
| is(:8(6), 6, 'got the correct int value from oct 6');
|
| is(:8(7), 7, 'got the correct int value from oct 7');
|
|
|
| # check 2 digit numbers
|
| is(:8(10), 8, 'got the correct int value from oct 10');
|
| is(:8(20), 16, 'got the correct int value from oct 20');
|
| is(:8(30), 24, 'got the correct int value from oct 30');
|
| is(:8(40), 32, 'got the correct int value from oct 40');
|
| is(:8(50), 40, 'got the correct int value from oct 50');
|
|
|
| # check 3 digit numbers
|
| is(:8(100), 64, 'got the correct int value from oct 100');
|
|
|
| # check some weird versions
|
| is(:8("77"), 63, 'got the correct int value from oct 77');
|
| is(:8<177777>, 65535, 'got the correct int value from oct 177777');
|
|
|
our Num multi prefix:<:2> ( Str $binstr )
From t/spec/S02-literals/radix.t lines 151–163 (no results): (skip)
| # L<S29/Conversions/"prefix:<:2>">
|
|
|
| is(:2(0), 0, 'got the correct int value from bin 0');
|
| is(:2(1), 1, 'got the correct int value from bin 1');
|
| is(:2(10), 2, 'got the correct int value from bin 10');
|
| is(:2(1010), 10, 'got the correct int value from bin 1010');
|
|
|
| is(
|
| :2(11111111111111111111111111111111),
|
| 0xFFFFFFFF,
|
| 'got the correct int value from bin 11111111111111111111111111111111');
|
|
|
|
|
our Num multi prefix:<:10> ( Str $decstr ) etc.
Interprets string as a number, with a default hexadecimal/octal/binary/decimal radix. Any radix prefix (0b, 0d, 0x, 0o) mentioned inside the string will override this operator (this statement is true: 10 == :8("0d10")), except 0b and 0d will be interpreted as hex digits by :16 (hex("0d10") == :16 "0d10"). fails on failure.
These aren't really functions, syntactically, but adverbial forms that just happen to allow a parenthesize argument. But more typically you'll see
:4<222>
:16<deadbeef>
and such.
Replaces Perl 5 hex and oct.
From t/builtins/io/time.t lines 4–176 (5 √, 5 ×): (skip)
| # L<S29/"Time"> |
| |
| # Based Heavily on the t/op/time.t test from Perl5.8.6 |
| # Perhaps the testing of these builtins needs to be more rigorous |
| # mattc 20050316 |
| |
| plan 10; |
| |
| #-- subs -- |
| |
| # Sub for evaulation valid date-time strings |
| # Used in place of Rules for the moment |
| sub is_dt (Str $datetime) returns Bool { |
| |
| my ($dow, $mon, $day, $time, $year) = split(' ', $datetime); |
| my $result = 0; |
| |
| for < Sun Mon Tue Wed Thu Fri Sat > { |
| if $dow eq $_ { |
| $result++; |
| last(); |
| } |
| } |
| |
| for < Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec > { |
| if $mon eq $_ { |
| $result++; |
| last(); |
| } |
| } |
| |
| if $day >= 1 && $day <= 31 { |
| $result++; |
| } |
| |
| my ($hour, $min, $sec) = split(':',$time); |
| |
| if $hour >= 0 && $hour <= 23 && |
| $min >= 0 && $min <= 59 && |
| $sec >= 0 && $sec <= 59 { |
| $result++; |
| } |
| |
| if $year >= 0 && $year <= 9999 { |
| $result++; |
| } |
| |
| return ($result == 5); |
| } |
| |
| # Before we get started, sanity check the is_dt sub |
| |
| #-- 1 -- |
| |
| my $gen_dt = "Tue Mar 15 14:43:10 2005"; |
| my $hibound_dt = "Mon Jan 31 23:59:59 9999"; |
| my $lowbound_dt = "Mon Jan 1 00:00:00 0"; |
| |
√ | ok(is_dt($gen_dt) && |
| is_dt($hibound_dt) && |
| is_dt($lowbound_dt) , |
| 'test datetime string tester, pos cases'); |
| |
| #-- 2 -- |
| |
| my $fail_dt_1 = "Mun Mar 15 14:43:10 2005"; |
| my $fail_dt_2 = "Mon Mxr 15 14:43:10 2005"; |
| my $fail_dt_3 = "Mon Mar 32 14:43:10 2005"; |
| my $fail_dt_4 = "Mon Mar 15 24:43:10 2005"; |
| my $fail_dt_5 = "Mon Mar 15 14:60:10 2005"; |
| my $fail_dt_6 = "Mon Mar 15 14:43:60 2005"; |
| my $fail_dt_7 = "Mon Mar 15 14:43:10 10000"; |
| |
√ | ok(!is_dt($fail_dt_1) && |
| !is_dt($fail_dt_2) && |
| !is_dt($fail_dt_3) && |
| !is_dt($fail_dt_4) && |
| !is_dt($fail_dt_5) && |
| !is_dt($fail_dt_6) && |
| !is_dt($fail_dt_7) , |
| 'test datetime string tester, neg cases'); |
| |
| #-- Real Tests Start -- |
| |
| #-- 3 -- |
| |
| my $beg = time; |
| my $now; |
| |
| # Loop until $beg in the past |
| while (($now = time) == $beg) { sleep 1 } |
| |
√ | ok($now > $beg && $now - $beg < 10, 'very basic time test'); |
√ | ok time + 10, "'time()' may drop its parentheses"; |
| |
| #-- 4 -- |
| if $*OS eq "browser" { |
| skip 1, "Programs running in browsers don't have access to regular IO."; |
| } else { |
| my ($beguser,$begsys); |
| my ($nowuser,$nowsys); |
| |
| ($beguser,$begsys) = times; |
| my $i; |
| loop ($i = 0; $i < 100000; $i++) { |
| ($nowuser, $nowsys) = times; |
| $i = 200000 if $nowuser > $beguser && ( $nowsys >= $begsys || (!$nowsys && !$begsys)); |
| $now = time; |
| last() if ($now - $beg > 20); |
| } |
√ | ok($i >= 200000, 'very basic times test'); |
| } |
| |
| #-- 5 -- |
| my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); |
| my ($xsec,$foo); |
| |
| ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg); |
| ($xsec,$foo) = localtime($now); |
| |
| my $localyday = $yday; |
| |
× | flunk("FIXME Time::Local should by numifiable", :todo<bug>); |
| #ok($sec != $xsec && $mday && $year, 'localtime() list context', :todo); |
| |
| #-- 6 -- |
| |
× | ok(is_dt({ my $str = localtime() }()), 'localtime(), scalar context', :todo<bug>); |
| |
| # Ultimate implementation as of above test as Rule |
| #todo_ok(localtime() ~~ /^Sun|Mon|Tue|Wed|Thu|Fri|Sat\s |
| # Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec\s |
| # \d\d\s\d\d:\d\d:\d\d\s\d**{4}$ |
| # /, |
| # 'localtime(), scalar context'); |
| |
| #-- 7 -- |
| |
| my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); |
| my ($xsec,$foo); |
| |
| ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = try { gmtime($beg) }; |
| ($xsec,$foo) = localtime($now); |
| |
× | flunk("FIXME Time::Local should by numifiable", :todo<bug>); |
| #ok($sec != $xsec && $mday && $year, 'gmtime() list context', :todo); |
| |
| #-- 8 -- |
| |
| if ($localyday && $yday) { |
| my $day_diff = $localyday - $yday; |
| ok($day_diff == 0 || |
| $day_diff == 1 || |
| $day_diff == -1 || |
| $day_diff == 364 || |
| $day_diff == 365 || |
| $day_diff == -364 || |
| $day_diff == -365, |
| 'gmtime() and localtime() agree what day of year', :todo); |
| } else { |
× | ok(0, 'gmtime() and localtime() agree what day of year', :todo); |
| } |
| |
| #-- 9 -- |
| |
× | ok(is_dt({ my $str = try { gmtime() } }()), 'gmtime(), scalar context', :todo); |
| |
| # Ultimate implementation as of above test as Rule |
| #todo_ok(gmtime() ~~ /^Sun|Mon|Tue|Wed|Thu|Fri|Sat\s |
| # Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec\s |
| # \d\d\s\d\d:\d\d:\d\d\s\d**{4}$ |
| # /, |
| # 'gmtime(), scalar context'); |
our Time multi gmtime ( Time $time? ) our Time multi method gmtime ( Time $time: )
Identical to:
Time::localtime(:$time,:tz<GMT>)
our Time multi localtime ( Time $time?, Time::Zone $tz? ) our Time multi method localtime ( Time $time: Time::Zone $tz? )
Returns a time object whose default timezone is $tz (or the system's default timezone if none is provided).
If used as a function, and no time is provided, the current time is used.
Note that no matter what, $time's concept of "its timezone" is discarded in favor of something new.
our Time multi time()
Returns a Time object. There are a number of uses for this object, all of which can be found in the documentation for Time.
There is, by default, no timezone associated with this Time object, so whatever default the system has will take over if timezone-specific data is accessed.
our OS::Name multi gethost() our OS::Name multi gethost( Str $name, OS::Addfamily :$type ) our OS::Name multi method gethost( OS::Addr $addr: ) is export our OS::Name multi method gethost( URI $uri: ) is export
The gethost function operates on host naming or address information and returns an OS::Name. An OS::Name is, minimally:
class OS::Name {
has Str $.name;
has OS::Addr $.addr;
has Array of Str @.aliases;
has Array of OS::Addr @.addrs;
}
Such names can apply to anything which has a name that maps to an address, however, in this case the name is a hostname and the address is some sort of network identifier (e.g. an IPV4 address when resolving hosts that have IPV4 addresses).
When stringified, an OS::Name yields its name. When stringified, an OS::addr yields its address in an appropriate text format (e.g. "10.1.2.3" for an IPV4 address).
The optional type adverb can be passed when resolving a hostname, and will filter the result to only those addresses that are of the appropriate address family. This feature may be supported by the underlying operating system, or Perl may emulate it.
Examples:
say "Connection from {$socket.peer.gethost}";
my $address = gethost("foo.example.com").addr;
my $hostname = gethost(:addr<"10.1.2.3">);
our OS::PW multi getpw() our OS::PW multi getpw( Int $uid ) our OS::PW multi getpw( Str $name ) our OS::PW multi method OS::PWEnt::getpw( OS::PWEnt $pw: ) our OS::PW multi method OS::PWEnt::getpw( OS::PWEnt $pw: Int $uid ) our OS::PW multi method OS::PWEnt::getpw( OS::PWEnt $pw: Str $name )
The getpw function operates on system login information, returning data about users in the form of an OS::PW object ("PW" refers to the historical getpw* functions that are part of the POSIX standard, and stands for "password").
When given no parameters, the "next" user entry is returned (undef is returned when the list of users has been exhausted).
When $uid is provided, a user with the given UID is found and returned. undef is returned if no matching entry is found.
When $name is provided, a user with the matching name is found and returned. undef is returned if no matching entry is found.
The return value is an object that represents the system-specific information about the user. When numified, this object returns the UID of the user. When stringified, this object returns the username.
Therefore, the typical convention of:
my Int $uid = getpw(~$name);
and
my Str $name = getpw(+$uid);
Will work as expected.
See the documentation for the OS::PW and OS::PWEnt classes for more information and the equivalent of the Perl 5 setpwent / endpwent functions.
WARNING: Even when used as a method on an OS::PWEnt object, there may be system-specific, global state associated with the implementation of these routines.
[Note: TODO setpgrp setpriority times -ajs ]
our Bool multi chroot ( Str $path = CALLER::<$_> )
On POSIX systems, changes the context of the current process such that the "root" directory becomes $path and all rooted paths (those that begin with a leading path separator) are relative to that path. For security reasons, many operating systems limit this functionality to the superuser. The return value will be true on success.
our Str multi getlogin ()
Returns the username of the account running the program. This may not be as secure as using getpwuid on some platforms.
our Bool multi kill ( OS::Signal $signal, Bool :$group, *@pids ) our Bool multi method kill ( Proc::PID $pid: OS::Signal $signal?, Bool :$group )
Sends the given $signal to the process(es) given and returns a boolean value indicating success (true) if all of the processes existed and were sent the signal and failure (false) if any of the processes did not exist or the signal could not be delivered to them.
The $signal can be initialized from an integer signal number or a string. Common signals are:
KILL - stop the process, do not allow it to exit gracefully TERM - stop the process, allow it to exit gracefully HUP - Hangup, often used as a request to re-run from scratch STOP - Pause execution CONT - Continue after a STOP
Consult your operating system documentation for the full list of signal names and numbers. For compatibility, a signal name may be prefixed with "SIG".
The method form may omit the signal. In this case, the default signal is 'TERM'.
If the :group named parameter is passed, kill will attempt to send the signal to a process group rather than a single process. This functionality is platform-specific.
The special signal 0 can be sent which does not actually deliver a signal at all, and is used to determine if processes are still running:
say "Still running" if $proc.kill(0);
From t/builtins/system/01-strings-with-spaces.t lines 5–197 (no results): (skip)
| # L<S29/"OS"/"=item run"> |
| |
| skip_rest "This file was in t_disabled/. Remove this SKIP of it now works."; |
| exit; |
| |
| if $?OS ne 'MSWin32' { |
| skip_rest "These are Win32-specific tests"; |
| exit; |
| } |
| |
| =kwid |
| |
| Test the interaction of system(LIST) and whitespace characters. In |
| an ideal world, system() does Just Enough quoting of the parameters |
| that system(LIST) is sane. On *nix-like platforms, system(LIST) |
| is an actual system call, so there should be no additional logic needed. |
| On Win32, system(LIST) does not exist and is mostly implemented as |
| system("@LIST") , so additional quoting magic is needed. |
| |
| This situation on Win32 is aggravated by the fact that there is no magic |
| routine to do parameter I<en>coding but a routine to do parameter I<de>coding, |
| which is not really documented and varies between the versions of MSVC. |
| So there is no fast and easy way to get automagic command line quoting for all |
| programs, especially if double-quotes as parameters are involved. |
| |
| Haskell's automagic quoting seems to be amazingly good though. |
| |
| =cut |
| |
| # Win32 specific tests for system() being sane enough |
| |
| my $cwdb = $*CWD; |
| my $cwd = $cwdb; |
| $cwd ~~ s:P5:g!\\!/!; |
| $cwdb ~~ s:P5:g,/,\\,; |
| |
| my $testdir = "t/builtins/system/t e s t"; |
| my $exename = "showav"; |
| my $plxname = "showargv.pl"; |
| |
| my $exe = "$testdir/$exename"; |
| my $exex = $exe ~ ".exe"; |
| my $exeb = $exe; |
| $exeb ~~ s:P5:g,/,\\,; |
| my $exebx = $exeb ~ ".exe"; |
| |
| my $plx = "$testdir/$plxname"; |
| my $plxb = $plx; |
| $plxb ~~ s:P5:g,/,\\,; |
| |
| my $bat = "$testdir/$plxname"; |
| my $batb = $bat; |
| $batb ~~ s:P5:g,/,\\,; |
| |
| my $cmdx = $bat ~ ".cmd"; |
| my $cmdb = $batb; |
| my $cmdbx = $cmdb ~ ".cmd"; |
| |
| my $pugs = 'pugs.exe'; |
| |
| my @command = ( |
| $exe, |
| $exex, |
| $exeb, |
| $exebx, |
| "./$exe", |
| "./$exex", |
| ".\\$exeb", |
| ".\\$exebx", |
| "$cwd/$exe", |
| "$cwd/$exex", |
| "$cwdb\\$exeb", |
| "$cwdb\\$exebx", |
| #"$bat", |
| #"$batx", |
| #"$batb", |
| #"$batbx", |
| #"./$bat", |
| #"./$batx", |
| #".\\$batb", |
| #".\\$batbx", |
| #"$cwd/$bat", |
| #"$cwd/$batx", |
| #"$cwdb\\$batb", |
| #"$cwdb\\$batbx", |
| #"$cmdx", |
| #"$cmdbx", |
| #"./$cmdx", |
| #"\\$cmdbx", |
| #"$cwd/$cmdx", |
| #"$cwdb\\$cmdbx", |
| #[$INTERPRETER, $batx], |
| #[$INTERPRETER, $batbx], |
| #[$INTERPRETER, "./$batx"], |
| #[$INTERPRETER, ".\\$batbx"], |
| #[$INTERPRETER, "$cwd/$batx"], |
| #[$INTERPRETER, "$cwdb\\$batbx"], |
| #[$INTERPRETER, "-w", "$cwdb\\$batbx"], |
| #[$pugs,'-e',q!say('['~$*PROGRAM_NAME~']['~@*ARGS.join('][')~']')!], |
| [$pugs,$plx], |
| [$pugs,$plxb], |
| ); |
| |
| my @av = ( |
| undef, |
| "", |
| " ", |
| "abc", |
| "a b\tc", |
| "\tabc", |
| "abc\t", |
| " abc\t", |
| "\ta b c ", |
| ["\ta b c ", ""], |
| ["\ta b c ", " "], |
| ["", "\ta b c ", "abc"], |
| [" ", "\ta b c ", "abc"], |
| ['" "', 'a" "b" "c', "abc"], |
| |
| # Added by Max Maischein |
| 'Hello "World"!', |
| 'c:\\', |
| 'c:\\test name', |
| 'c:\\test directory\\', |
| '\\\\localhost\\', |
| 'Hello ^_^', |
| 'Hello ^^', |
| '^^', |
| '""', |
| ); |
| |
| diag "Creating test files"; |
| my $counter; |
| my @cleanup; |
| |
| for @command -> $cmd { |
| my @cmd = $cmd; |
| for @av -> $arg { |
| my @args = $arg; |
| |
| my $prog = "perl6-temprun-test-" ~ ($counter++) ~ ".tmp"; |
| |
| my $fh = open($prog, :w); |
| $fh.say("system("); |
| #say @cmd; |
| #say @args; |
| for @cmd, @args -> $l { |
| my $line = $l.perl(); |
| #say $line; |
| $line ~~ s:P5/^\\//; |
| #say $line; |
| $fh.say($line ~ ",") |
| }; |
| $fh.say(")"); |
| $fh.close(); |
| undefine $fh; |
| |
| push @cleanup, $prog; |
| }; |
| }; |
| ok(1,"Created test files"); |
| |
| my $counter = 0; |
| for @command -> $cmd { |
| my @cmd = $cmd; |
| for @av -> $arg { |
| my @args = $arg; |
| |
| my $outfile = "perl6-tempout-" ~ ($counter) ~ ".tmp"; |
| push @cleanup, $outfile; |
| |
| my $prog = "perl6-temprun-test-" ~ ($counter++) ~ ".tmp"; |
| |
| my $cmd = @cmd[-1]; |
| my $expected = "[" ~ $cmd ~ "][" ~ @args.join("][") ~ "]"; |
| my $name = "|" ~ @cmd.join("*") ~ "| with [" ~ @args.join("][") ~ "]"; |
| |
| if (! system($pugs ~ " " ~ $prog ~ "> " ~ $outfile)) { |
| fail($name); |
| diag slurp $prog; |
| next(); |
| }; |
| |
| my $output = slurp $outfile; |
| $output .= chomp; |
| |
| is($output,$expected,$name) |
| or diag slurp $prog; |
| }; |
| }; |
| |
| diag "Cleaning up"; |
| for @cleanup { unlink($_) }; |
From t/builtins/os/system.t lines 4–27 (3 √, 0 ×): (skip)
| # L<S29/"OS"/"=item run"> |
| # system may be re-named to run, so link there. |
| |
| plan 3; |
| |
| if $*OS eq "browser" { |
| skip_rest "Programs running in browsers don't have access to regular IO."; |
| exit; |
| } |
| |
| my $pugs = ($*OS eq any(<MSWin32 mingw msys cygwin>)) |
| ?? 'pugs.exe' |
| !! $*EXECUTABLE_NAME; |
| |
| my $res; |
| |
| $res = system($pugs,'-e1'); |
√ | ok($res,"system() to an existing program does not die (and returns something true)"); |
| |
| $res = system("program_that_does_not_exist_ignore_this_error_please.exe"); |
√ | ok(!$res, "system() to a nonexisting program does not die (and returns something false)"); |
| |
| $res = system("program_that_does_not_exist_ignore_errors_please.exe","a","b"); |
√ | ok(!$res, "system() to a nonexisting program with an argument list does not die (and returns something false)"); |
our Proc::Status multi run ( ; Str $command ) our Proc::Status multi run ( ; Str $path, *@args ) our Proc::Status multi run ( Str @path_and_args ) our Proc multi run ( ; Str $command, Bool :$bg! ) our Proc multi run ( ; Str $path, Bool :$bg!, *@args ) our Proc multi run ( Str @path_and_args, Bool :$bg! )
run executes an external program, and returns control to the caller once the program has exited.
The default form expects a single string argument which contains the full command-line. This command-line will be scanned for special characters that the operating system's shell might interpret such as ; or embedded quotes. If any are found, the command will be run through a sub-shell in an operating system specific fashion (on POSIX systems, this means sh -c).
If called like this:
run( :path<'/some/path'>, 'arg1', 'arg2', ... )
or with a single array (containing both the path and arguments), then the path given is executed directly with no shell interpretation.
The return value is the exit status of the program, and can be evaluated in the following contexts:
Bool - True = success; False = failure Int - Exit status (per the .exit method)
See wait for more detail on how the Proc::Status object is used.
On failure to execute, an undefined value is returned.
If the :bg named parameter is passed, the program will be executed in the background, and the run command will return as soon as the child process is created. This means that the object returned is actually a Proc, which represents the created process.
[ Note: should the :bg form take rw filehandles or is that over-overloading the functionality of run? Should run be the new open with
respect to executing external code? -ajs ]
[ Note: system() should be renamed to sys() or sh() or run() or some such to avoid P5-induced boolean inversion confusion, plus Huffmanize it a little better. I'm thinking run() might be best for MMD reasons. --law
Note: exec should also be renamed to something clearer and "final" and huffmanly longer. I'm thinking runinstead(). And maybe the function behind qq:x should be rungather() rather than readpipe(). -law ]
multi runinstead ( ; Str $path, *@args ) multi runinstead ( ; Str $command )
Identical to run except that it never returns. The executed program replaces the currently running program in memory.
There are higher-level models of concurrency management in Perl (see "Concurrency" in S17). These functions are simply the lowest level tools
our Proc sub Processes::fork()
Creates a copy of the current process. Both processes return from fork. The original process returns the child process as a Proc object. The newly created process returns the parent process as a Proc object. As with any Proc object, the child process object numifies to the process ID (OS dependent integer). However, the parent process object numifies to 0 so that the child and parent can distinguish each other.
Typical usage would be:
if !defined(my $pid = fork) {
die "Error calling fork: $!";
} elsif $pid == 0 {
say "I am the new child!";
exit 0;
} else {
say "I am the parent of {+$pid}";
wait();
}
our Proc::Status multi method wait( Proc $process: *%options ) our Proc::Status multi wait ( Proc $process = -1, *%options )
Waits for a child process to terminate and returns the status object for the child. This status object will numify to the process ID of the child that exited.
Important Proc::Status methods:
.exit - Numeric exit value .pid - Process ID .signal - Signal number if any, otherwise 0
For historical reasons there is a .status method which is equal to:
($status.exit +< 8) +| $status.signal
If $process is supplied, then wait will only return when the given process has exited. Either a full Proc object can be passed, or just a numeric process ID. A -1 explicitly indicates that wait should return immediately if any child process exits.
When called in this way, the returned Proc::Status object will have a .pid of -1 (which is also what it numifies to) if there was no such process to wait for.
The named options include:
Defaults to true. If set to false, this forces wait to return immediately.
Exists for historical compatibility. WNOHANG = 1> is identical to blocking = False>.
use DB_File;
Dumped.
See Exegesis 7.
use IPC::SysV;
Replaced by temp which, unlike local, defaults to not changing the value.
See "Concurrency" in S17. lock has been replaced by is atomic.
There is no ref() any more, since it was almost always used to get the type name in Perl 5. If you really want the type name, you can use $var.WHAT. If you really want P5 ref semantics, use Perl5::p5ref.
But if you're just wanting to test against a type, you're likely better off performing an isa or does or can, or just $var ~~ TYPE.
Was there a good use for this?
&func.meta.signature; &func.^signature;
Algorithm was too Anglo-centric. Could be brought back if generalized somehow.
wait can now be called with or without an optional process/pid.
$num1 % $num2
Does a floating point modulus operation, i.e. 5.5 % 1 == 0.5 and 5 % 2.5 == 0.
The following functions are classified by Apocalypse/Synopsis numbers.
tie tied untie (now implemented as container classes? my $foo is ....? is tie the meta operation on the container type for 'rebless' - macro tie ( $var, $class, *@args ) { CODE { variable($var).meta.rebless( $class, *@args ) } } )
These are replaced by container types. The compiler is free to assume that any lexical variable is never going to change its container type unless some representation is made to that effect in the declaration. Note: P5's tied() is roughly replaced by P6's variable().
chroot crypt getlogin /[get|set][pw|gr].*/ kill setpgrp setpriority times
... These are probably going to be part of POSIX, automatically imported to GLOBAL if the platform is the right one
Please post errors and feedback to perl6-language. If you are making a general laundry list, please separate messages by topic.
[ Top ] [ Index of Synopses ]