diff --git a/src/CLRTypes.pm b/src/CLRTypes.pm index e46df190..1b7a5f9f 100644 --- a/src/CLRTypes.pm +++ b/src/CLRTypes.pm @@ -136,6 +136,7 @@ my %typedata = ( 'Console.Error.WriteLine' => [m => 'Void'], 'System.Environment.Exit' => [m => 'Void'], 'String.Concat' => [m => 'String'], + 'String.CompareOrdinal'=> [m => 'Int32'], 'Kernel.AnyP' => [f => 'IP6'], 'Kernel.AnyMO' => [f => 'DynMetaObject'], 'Kernel.ArrayP' => [f => 'IP6'], diff --git a/src/CgOp.pm b/src/CgOp.pm index e86ebbc1..0944edaa 100644 --- a/src/CgOp.pm +++ b/src/CgOp.pm @@ -163,6 +163,7 @@ use warnings; sub str_length { getfield('Length', $_[0]) } sub str_substring { rawcall($_[0], 'Substring', $_[1], $_[2]) } sub str_chr { rawnew('str', cast('clr:System.Char', $_[0]), CgOp::int(1)) } + sub strcmp { rawscall('String.CompareOrdinal', $_[0], $_[1]) } sub strbuf_new { rawnew('strbuf') } sub strbuf_append { rawcall($_[0], 'Append', $_[1]) } diff --git a/test2.pl b/test2.pl index 5e239d6a..c64c5cfa 100644 --- a/test2.pl +++ b/test2.pl @@ -1,58 +1,34 @@ # vim: ft=perl6 use Test; -{ - is chars("foo"), 3, '&chars works'; - is substr("Hello",1,3), 'ell', '&substr works'; - is substr("Hello",2), "llo", '&substr works (2 args)'; - is reverse(1,2,3).join("|"), '3|2|1', '&reverse works'; - is join("|",1,2,3), '1|2|3', '&join works'; - my @foo = 4,5,6; - is join("|",item @foo), '4 5 6', '&item works'; - is join("|",@foo.item), '4 5 6', 'Mu.item works'; - is (not False), 'Bool::True', '¬ works'; - is (defined 5), 'Bool::True', '&defined works'; - push @foo, 7, 8; - is join("|",@foo), '4|5|6|7|8', '&push works'; - unshift @foo, 2, 3; - is join("|",@foo), '2|3|4|5|6|7|8', '&unshift works'; - is pop(@foo), '8', '&pop works'; - is shift(@foo), '2', '&shift works'; - is join("|",@foo), '3|4|5|6|7', '... with side effects'; - is +True, '1', "Bool.Numeric works"; - my %bar = :a<9>; - is %bar, '9', "Hash.LISTSTORE works"; - %bar = :c<9>; - ok (!defined %bar), "Hash.LISTSTORE clears existing"; - is keys(%bar), "c", "Hash.keys works"; - is values(%bar), "9", "Hash.values works"; - is (join "|", %bar.kv), "c|9", "Hash.kv works"; - is (%bar.invert.<9>), "c", "Hash.invert works"; - ok %bar :exists, ":exists works"; - is (%bar :delete), "9", ":delete returns old"; - ok !(%bar :exists), ":delete removes value"; +sub infix:($str, $ct) { + my $i = +$ct; + my $j = ''; # XXX use strbuf + while $i >= 1 { + $i--; + $j ~= $str; + } + $j; } -{ - my class A { - method tom() { 12 } - method foo($x) { $x * $x } - method bar(:$x) { $x + $x } - } - my class B is A { - method tom() { nextsame; } - method foo($x) { nextsame; } #OK - method bar(:$x) { nextsame; } #OK - } - is B.tom(), 12, "nextsame functional"; - is B.foo(5), 25, "nextsame functional w/ argument"; - # TODO - # is B.bar(:x(7)), 14, "nextsame functional w/ named arg"; +sub grep($filter, *@items) { @items.grep($filter) } +sub map($callback, *@items) { @items.map($callback) } - sub foo(*%x) { %x } - is foo(:z(2)), 2, "slurpy hashes work"; +sub infix:($s1, $s2) { + Q:CgOp { (box Num (cast num (strcmp (unbox str (@ {$s1.Str})) (unbox str (@ {$s2.Str}))))) } } +sub infix:($s1, $s2) { ($s1 leg $s2) >= 0 } +sub infix:($s1, $s2) { ($s1 leg $s2) > 0 } +sub infix:($s1, $s2) { ($s1 leg $s2) <= 0 } +sub infix:($s1, $s2) { ($s1 leg $s2) < 0 } + +ok 'cow' le 'sow', 'cow le sow'; +ok !('sow' le 'cow'), 'sow !le cow'; +ok 'row' lt 'tow', 'row lt tow'; +ok 'how' gt 'bow', 'how gt bow'; +ok 'yow' ge 'yow', 'yow ge yow'; + #is $?FILE, 'test.pl', '$?FILE works'; #is $?ORIG.substr(0,5), '# vim', '$?ORIG works'; diff --git a/v6/TODO b/v6/TODO index f9604d6d..41c3a472 100644 --- a/v6/TODO +++ b/v6/TODO @@ -22,18 +22,13 @@ Cursor.moreinput Cursor.O Cursor.suppose Cursor.trim_heredoc -:delete -:exists EXPR will need a re-write with tests. $ = 1 $*FOO as a parameter func(|($key => $value)) gt, lt, leg, etc -Hash.keys &keys -Hash.LISTSTORE hash literals infix: -invert(%hash) List.at-pos(WhateverCode) Match.CURSOR Match.iterator should return numbered captures @@ -47,21 +42,28 @@ temp $*FOO token { :my $var = expr; $var } token { $param-role-var } -DONE OR AVERTED: - -given & when -if not binding $_ -Mu.new(foo => $bar) +DONE: Bool.Numeric -//=, ||=, &&=, etc -substr($str,$from,$len) -not($bool) +&chars defined($thing) -shift(@array) -push(@array, $thing) +:delete +:exists +Hash.keys &keys +Hash.LISTSTORE +invert(%hash) &item -&reverse -&chars -¬e &join +not($bool) +¬e pop(@array) +push(@array, $thing) +&reverse +shift(@array) +substr($str,$from,$len) + +AVERTED: + +//=, ||=, &&=, etc +given & when +if not binding $_ +Mu.new(foo => $bar)