Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Implement [^^] #952

Closed
p6rt opened this issue Apr 27, 2009 · 12 comments
Closed

Implement [^^] #952

p6rt opened this issue Apr 27, 2009 · 12 comments
Labels

Comments

@p6rt
Copy link

p6rt commented Apr 27, 2009

Migrated from rt.perl.org#65164 (status was 'resolved')

Searchable as RT65164$

@p6rt
Copy link
Author

p6rt commented Apr 27, 2009

From @masak

<szabgab> rakudo​: say 1 ^^ 1
<p6eval> rakudo c4f676​: OUTPUT«␤»
<szabgab> rakudo​: say 1 ^^ 1 ^^ 1
<p6eval> rakudo c4f676​: OUTPUT«1␤»
<szabgab> rakudo​: say [^^] 1, 1
<p6eval> rakudo c4f676​: OUTPUT«say requires an argument at line 1,
near " [^^] 1, 1" [...]
<szabgab> is masak filing a bug ?
<masak> szabgab​: he could be, if you like.
* masak files

@p6rt
Copy link
Author

p6rt commented Aug 16, 2009

From @kyleha

This is an automatically generated mail to inform you that tests are now available in t/spec/S03-operators/reduce-metaop.t

commit 4be422c883431ad5a841b0e0d57b7dfbbdb316ba
Author​: kyle <kyle@​c213334d-75ef-0310-aa23-eaa082d1ae64>
Date​: Sun Aug 16 03​:59​:48 2009 +0000

  [t/spec] Tests for RT #​65164
 
  git-svn-id​: http://svn.pugscode.org/pugs@&#8203;28001 c213334d-75ef-0310-aa23-eaa082d1ae64

Inline Patch
diff --git a/t/spec/S03-operators/reduce-metaop.t b/t/spec/S03-operators/reduce-metaop.t
index adae355..b9c3a5a 100644
--- a/t/spec/S03-operators/reduce-metaop.t
+++ b/t/spec/S03-operators/reduce-metaop.t
@@ -1,7 +1,7 @@
 use v6;
 use Test;
 
-plan 59;
+plan 71;
 
 =begin pod
 
@@ -179,4 +179,23 @@ lives_ok({my @foo = [>>+<<] ([1..3],[1..3],[1..3])},'Parse [>>+<<]');
 is( ([*]()), 1, "[*]() returns 1");
 is( ([+]()), 0, "[+]() returns 0");
 
+# RT #65164 (TODO: implement [^^])
+#?rakudo skip 'implement [^^]'
+{
+    is [^^](0, 42), 42, '[^^] works (one of two true)';
+    is [^^](42, 0), 42, '[^^] works (one of two true)';
+    ok ! [^^](1, 42),   '[^^] works (two true)';
+    ok ! [^^](0, 0),    '[^^] works (two false)';
+
+    ok ! [^^](0, 0, 0), '[^^] works (three false)';
+    ok ! [^^](5, 9, 17), '[^^] works (three true)';
+
+    is [^^](5, 9, 0),  (5 ^^ 9 ^^ 0),  '[^^] mix 1';
+    is [^^](5, 0, 17), (5 ^^ 0 ^^ 17), '[^^] mix 2';
+    is [^^](0, 9, 17), (0 ^^ 9 ^^ 17), '[^^] mix 3';
+    is [^^](5, 0, 0),  (5 ^^ 0 ^^ 0),  '[^^] mix 4';
+    is [^^](0, 9, 0),  (0 ^^ 9 ^^ 0),  '[^^] mix 5';
+    is [^^](0, 0, 17), (0 ^^ 0 ^^ 17), '[^^] mix 6';
+}
+
 # vim: ft=perl6

@p6rt
Copy link
Author

p6rt commented Aug 16, 2009

The RT System itself - Status changed from 'new' to 'open'

@p6rt
Copy link
Author

p6rt commented Aug 3, 2010

From @bbkr

On * release

$ perl6 -e 'say [^^] 1, 1'
===SORRY!===
Could not find sub &infix​:<^^>

@p6rt
Copy link
Author

p6rt commented Aug 7, 2010

From @masak

On Tue Aug 03 09​:05​:29 2010, bbkr wrote​:

On * release

$ perl6 -e 'say [^^] 1, 1'
===SORRY!===
Could not find sub &infix​:<^^>

In other words, still not implemented. The error message is better, though.

@p6rt
Copy link
Author

p6rt commented Dec 6, 2010

From @masak

<thundergnat> I was idly looking through RT and came across
http://rt.perl.org/rt3/Public/Bug/Display.html?id=65164 and thought "That looks like LHF!"
<thundergnat> I wrote some infix routines that work correctly but the base ^^ operator seems
to be borked.
<thundergnat> rakudo​: say 1 ^^ 1;
<p6eval> rakudo : OUTPUT«␤»
<thundergnat> should be Bool​::False
<thundergnat> rakudo​: say 0 ^^ 0;
<p6eval> rakudo : OUTPUT«0␤»
<thundergnat> also should be Bool​::False
<moritz_> what is ^^ ?
<thundergnat> Where is ^^ implemented? I couldn't find it.
<moritz_> erm, what's it supposed to be?
<thundergnat> exclusive or
<moritz_> why isn't that ?^ then?
<moritz_> we have ~ ? and + versions of all the logic operators
<moritz_> ^^ feels wrong
<thundergnat> it's in the spec
<Kodi> moritz_​: But we say && and ||, not ?& and ?|.
<thundergnat> http://github.com/perl6/roast/blob/master/S03-operators/misc.t#L54-L68
<moritz_> Kodi​: && and ?& have different semantics
<thundergnat> Maybe the spec needs to be changed.
<Kodi> moritz_​: ?& exists? That surprises me.
<moritz_> ie 1 ?& 3 returns True, 1 && 3 returns 3
<Kodi> I see.
<moritz_> rakudo​: say 1 ?& 3
<p6eval> rakudo : OUTPUT«Bool​::True␤»
<moritz_> infix​:<^^>, short-circuit exclusive-or
<moritz_> $a ^^ $b ^^ $c ...
<moritz_> Returns the true argument if there is one (and only one). Returns Bool​::False if all
arguments are false or if more than one argument is true.
<moritz_> sounds like it needs to be implemented with list infix associatvity
<thundergnat> Right, Thats what I was doing
<moritz_> src/Perl6/Grammar.pm
<moritz_> 1886​:token infix​:sym<^^> { <sym> <O('%tight_or, :pasttype<xor>')> }
<moritz_> that's wrong
<moritz_> removing the :pasttype<xor> and writing your own two-arg infix​:<^^> should fix it
* masak , belatedly, submits rakudobug
<masak> ah well, let's integrate it into #​65164
<masak> moritz_​: wait, two-arg op?
<masak> doesn't the infix​:<^^> op have listish behaviour?
<masak> rakudo​: our multi sub infix​:<^^>(Mu $a, Mu $b) { $a ?? $b ?? Bool​::False !! $a !! $b ??
$b !! Bool​::False }; say [^^](1,2,0,3,0);
<p6eval> rakudo : OUTPUT«3␤»
<masak> that's wrong.
<masak> according to moritz_' quote above.
<thundergnat> masak​: good point
<masak> infix​:<^^> is *not* two-arg. that's what sets it apart from ?^
<masak> (besides the boolifying thing)

@p6rt
Copy link
Author

p6rt commented Jan 5, 2011

From @thundergnat

The following patch passes all the attached tests (some 285 of them)
also fixes http://rt.perl.org/rt3/Public/Bug/Display.html?id=72826 and
part of http://rt.perl.org/rt3/Public/Bug/Display.html?id=73280

################################################################

Inline Patch
diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
index 93b73c0..8928af1 100644
--- a/src/Perl6/Grammar.pm
+++ b/src/Perl6/Grammar.pm
@@ -1883,7 +1883,7 @@ token dumbsmart {
 token infix:sym<&&>   { <sym>  <O('%tight_and, :pasttype<if>')> }

 token infix:sym<||>   { <sym>  <O('%tight_or, :assoc<left>,
:pasttype'> } \-token infix​:sym\<^^> \{ \ \'\)> \} \+token infix​:sym\<^^> \{ \ \ \} token infix​:sym\ \{ \ \, :pasttype\'> \} token infix​:sym\ \{ \ >> \ \} token infix​:sym\ \{ \ >> \ \}
Inline Patch
diff --git a/src/core/operators.pm b/src/core/operators.pm
index 75840d8..8ab2828 100644
--- a/src/core/operators.pm
+++ b/src/core/operators.pm
@@ -512,6 +512,31 @@ our multi sub infix:<or>(Mu $a, Mu $b) { $a or $b }
 our multi sub infix:<&&>(Mu $a, Mu $b) { $a && $b }
 our multi sub infix:<and>(Mu $a, Mu $b) { $a and $b }

+
+our multi sub infix:<^^>(Mu $a, Mu $b) {
+    return $a  ??  $b ?? Bool::False !! $a
+               !!  $b ?? $b          !! Bool::False;
+}
+
+our multi sub infix:<^^>(Mu @a, Mu @b) {
+    return +@a  ??  +@b  ?? () !! @b
+                !!  +@b  ?? @b !! ();
+}
+
+our multi sub infix:<^^>(Mu $a, *@a) {
+    return [^^] $a, @a;
+}
+
+our multi sub prefix:<[^^]>(*@a) {
+    my $a = shift @a;
+    for @a -> $b
+    {
+        return Bool::False if $b && $a;
+        $a ||= $b;
+    };
+    return $a || Bool::False;
+}
+
 # Eliminate use of this one, but keep the pir around for
 # the moment, as it may come in handy elsewhere.
 #



##########################################################

# tests from roast S03-metaops/reduce.t
  ok [^^] ( 0, 42 ) == 42, '[^^] works (one of two true)';
  ok [^^] ( 42, 0 ) == 42, '[^^] works (one of two true)';

  nok [^^] ( 1, 42 ), '[^^] works (two true)';
  nok [^^] ( 0, 0 ), '[^^] works (two false)';

  nok [^^] ( 0, 0, 0 ), '[^^] works (three false)';
  nok [^^] ( 5, 9, 17 ), '[^^] works (three true)';

  ok [^^] ( 5, 9, 0 ) == (5 ^^ 9 ^^ 0), '[^^] mix 1';
  ok [^^] ( 5, 0, 17 ) == (5 ^^ 0 ^^ 17), '[^^] mix 2';
  ok [^^] ( 0, 9, 17 ) == (0 ^^ 9 ^^ 17), '[^^] mix 3';
  ok [^^] ( 5, 0, 0 ) == (5 ^^ 0 ^^ 0), '[^^] mix 4';
  ok [^^] ( 0, 9, 0 ) == (0 ^^ 9 ^^ 0), '[^^] mix 5';
  ok [^^] ( 0, 0, 17 ) == (0 ^^ 0 ^^ 17), '[^^] mix 6';

# test an empty list
  nok [^^] (), 'reduce empty list ok';

{ # test False / undefined things
  my $msg1 = 'reduce [^^] false variable test';
  my $msg2 = 'infix ^^ false variable test';

  for (0, '0', '', Bool​::False, Any, Mu, Nil) -> $undef
  {

  ok [^^] ( $undef, $undef, $undef, 5 ), "|{$undef.perl}| $msg1
\#​1";
  nok [^^] ( 1, 2, $undef, 3, $undef ), "|{$undef.perl}| $msg1
\#​2";
  nok [^^] ( $undef, $undef, 1, 5 ), "|{$undef.perl}| $msg1
\#​3";
  nok [^^] ( 1, $undef, $undef, 5 ), "|{$undef.perl}| $msg1
\#​4";
  ok [^^] ( $undef, $undef, 2, $undef ), "|{$undef.perl}| $msg1
\#​5";
  nok [^^] ( $undef, $undef, $undef ), "|{$undef.perl}| $msg1
\#​6";
  nok [^^] ( $undef, $undef ), "|{$undef.perl}| $msg1
\#​7";
  ok [^^] ( $undef, 1 ), "|{$undef.perl}| $msg1
\#​8";
  ok [^^] ( 1, $undef ), "|{$undef.perl}| $msg1
\#​9";
  nok [^^] ( $undef ), "|{$undef.perl}| $msg1
\#​10";
  ok ( $undef ^^ $undef ^^ $undef ^^ 5 ), "|{$undef.perl}| $msg2
\#​1";
  nok ( 1 ^^ 2 ^^ $undef ^^ 3 ^^ $undef ), "|{$undef.perl}| $msg2
\#​2";
  nok ( $undef ^^ $undef ^^ 1 ^^ 5 ), "|{$undef.perl}| $msg2
\#​3";
  nok ( 1 ^^ $undef ^^ $undef ^^ 5 ), "|{$undef.perl}| $msg2
\#​4";
  ok ( $undef ^^ $undef ^^ 2 ^^ $undef ), "|{$undef.perl}| $msg2
\#​5";
  nok ( $undef ^^ $undef ^^ $undef ), "|{$undef.perl}| $msg2
\#​6";
  nok ( $undef ^^ $undef ), "|{$undef.perl}| $msg2
\#​7";
  ok ( $undef ^^ 1 ), "|{$undef.perl}| $msg2
\#​8";
  ok ( 1 ^^ $undef ), "|{$undef.perl}| $msg2
\#​9";
  }
}

{ # test numericy true things
  my $msg1 = 'reduce [^^] true numbery variable test';
  my $msg2 = 'infix ^^ true numbery variable test';

  for (1, -147, pi, Bool​::True) -> $def
  {
  nok [^^] ( 0, 0, $def, 3, $def ), "|{$def.perl}| $msg1 \#​1";
  nok [^^] ( $def, $def, 0 ), "|{$def.perl}| $msg1 \#​2";
  nok [^^] ( 1, $def, Any, 5 ), "|{$def.perl}| $msg1 \#​3";
  ok [^^] ( $def, 0, 0, 0 ) == $def, "|{$def.perl}| $msg1 \#​4";
  ok [^^] ( Any, Any, Any, $def ) == $def, "|{$def.perl}| $msg1 \#​5";
  nok [^^] ( $def, $def ), "|{$def.perl}| $msg1 \#​6";
  ok [^^] ( $def, 0 ) == $def, "|{$def.perl}| $msg1 \#​7";
  ok [^^] ( 0, $def ) == $def, "|{$def.perl}| $msg1 \#​8";
  ok [^^] ( $def ), "|{$def.perl}| $msg1 \#​9";
  nok ( 0 ^^ 0 ^^ $def ^^ 3 ^^ $def ), "|{$def.perl}| $msg2 \#​1";
  nok ( $def ^^ $def ^^ 0 ), "|{$def.perl}| $msg2 \#​2";
  nok ( 1 ^^ $def ^^ Any ^^ 5 ), "|{$def.perl}| $msg2 \#​3";
  ok ( $def ^^ 0 ^^ 0 ^^ 0 ) == $def, "|{$def.perl}| $msg2 \#​4";
  ok ( Any ^^ Any ^^ Any ^^ $def ) == $def,"|{$def.perl}| $msg2 \#​5";
  nok ( $def ^^ $def ), "|{$def.perl}| $msg2 \#​6";
  ok ( $def ^^ 0 ) == $def, "|{$def.perl}| $msg2 \#​7";
  ok ( 0 ^^ $def ) == $def, "|{$def.perl}| $msg2 \#​8";
  }
}

{ # test stringy true things
  my $msg1 = 'reduce [^^] true string variable test';
  my $msg2 = 'infix ^^ true string variable test';

  for ('no', 'Bob', '10', 'False') -> $def
  {
  nok [^^] ( $def, $def, $def, 'string' ), "|{$def.perl}| $msg1 \#​1";
  nok [^^] ( '', '', $def, 'str', $def ), "|{$def.perl}| $msg1 \#​2";
  nok [^^] ( $def, $def,'' ), "|{$def.perl}| $msg1 \#​3";
  nok [^^] ( 1, $def, Any, 5 ), "|{$def.perl}| $msg1 \#​4";
  ok [^^] ( $def, '', '', '' ) eq $def, "|{$def.perl}| $msg1 \#​5";
  ok [^^] ( Any, Any, Any, $def ) eq $def, "|{$def.perl}| $msg1 \#​6";
  nok [^^] ( $def, $def ), "|{$def.perl}| $msg1 \#​7";
  ok [^^] ( $def, '' ) eq $def, "|{$def.perl}| $msg1 \#​8";
  ok [^^] ( '', $def ) eq $def, "|{$def.perl}| $msg1 \#​9";
  ok [^^] ( $def ) eq $def, "|{$def.perl}| $msg1
\#​10";
  nok ( $def ^^ $def ^^ $def ^^ 'string' ), "|{$def.perl}| $msg2 \#​1";
  nok ( '' ^^ '' ^^ $def ^^ 'str' ^^ $def ),"|{$def.perl}| $msg2 \#​2";
  nok ( $def ^^ $def ^^'' ), "|{$def.perl}| $msg2 \#​3";
  nok ( 1 ^^ $def ^^ Any ^^ 5 ), "|{$def.perl}| $msg2 \#​4";
  ok ( $def ^^ '' ^^ '' ^^ '' ) eq $def, "|{$def.perl}| $msg2 \#​5";
  ok ( Any ^^ Any ^^ Any ^^ $def ) eq $def,"|{$def.perl}| $msg2 \#​6";
  nok ( $def ^^ $def ), "|{$def.perl}| $msg2 \#​7";
  ok ( $def ^^ '' ) eq $def, "|{$def.perl}| $msg2 \#​8";
  ok ( '' ^^ $def ) eq $def, "|{$def.perl}| $msg2 \#​9";
  }
}

{
  my @​a = (1,2,3);
  my @​b = (4,5,6);
  my (@​c, @​d);
 
  is (@​a ^^ @​c), '1 2 3', 'Array ^^ true returns true array';
  is (@​c ^^ @​a), '1 2 3', 'Array ^^ true returns true array';
  ok (@​a ^^ @​b) == (), 'Array ^^ true returns empty list';
  ok (@​c ^^ @​d) == (), 'Array ^^ true returns empty list';
  is (@​a ^^ ()), '1 2 3', 'True array ^^ empty list returns array';
  is (() ^^ @​a), '1 2 3', 'Empty list ^^ true array returns array';
  ok (() ^^ @​c) == (), 'Empty list ^^ empty array returns ()';
}

{
  # RT # 73820 http://rt.perl.org/rt3/Public/Bug/Display.html?id=73280
  # RT # 72826 http://rt.perl.org/rt3/Public/Bug/Display.html?id=72826

  is ( 7 ^^ 7 ).WHAT, 'Bool()', 'Bool()';
  is ( 7 ^^ Mu ).WHAT, 'Int()', 'Int()';
  is ( 0 ^^ ^7 ).WHAT, 'Range()', 'Range()';
  is ( ^7 ^^ 0 ).WHAT, 'Range()', 'Range()';
  is ( 7.5i ^^ Mu ).WHAT, 'Complex()', 'Complex()';
  is ( Inf ^^ Mu ).WHAT, 'Num()', 'Num()';
  is ( 'Inf' ^^ Mu ).WHAT, 'Str()', 'Str()';
}

@p6rt
Copy link
Author

p6rt commented Jan 5, 2011

From @thundergnat

Attached patch and test files mentioned in previous comment. Doh.

@p6rt
Copy link
Author

p6rt commented Jan 5, 2011

From @thundergnat

# tests from roast S03-metaops/reduce.t
  ok [^^] ( 0, 42 ) == 42, '[^^] works (one of two true)';
  ok [^^] ( 42, 0 ) == 42, '[^^] works (one of two true)';

  nok [^^] ( 1, 42 ), '[^^] works (two true)';
  nok [^^] ( 0, 0 ), '[^^] works (two false)';

  nok [^^] ( 0, 0, 0 ), '[^^] works (three false)';
  nok [^^] ( 5, 9, 17 ), '[^^] works (three true)';

  ok [^^] ( 5, 9, 0 ) == (5 ^^ 9 ^^ 0), '[^^] mix 1';
  ok [^^] ( 5, 0, 17 ) == (5 ^^ 0 ^^ 17), '[^^] mix 2';
  ok [^^] ( 0, 9, 17 ) == (0 ^^ 9 ^^ 17), '[^^] mix 3';
  ok [^^] ( 5, 0, 0 ) == (5 ^^ 0 ^^ 0), '[^^] mix 4';
  ok [^^] ( 0, 9, 0 ) == (0 ^^ 9 ^^ 0), '[^^] mix 5';
  ok [^^] ( 0, 0, 17 ) == (0 ^^ 0 ^^ 17), '[^^] mix 6';

# test an empty list
  nok [^^] (), 'reduce empty list ok';

{ # test False / undefined things
  my $msg1 = 'reduce [^^] false variable test';
  my $msg2 = 'infix ^^ false variable test';

  for (0, '0', '', Bool​::False, Any, Mu, Nil) -> $undef
  {

  ok [^^] ( $undef, $undef, $undef, 5 ), "|{$undef.perl}| $msg1 \#​1";
  nok [^^] ( 1, 2, $undef, 3, $undef ), "|{$undef.perl}| $msg1 \#​2";
  nok [^^] ( $undef, $undef, 1, 5 ), "|{$undef.perl}| $msg1 \#​3";
  nok [^^] ( 1, $undef, $undef, 5 ), "|{$undef.perl}| $msg1 \#​4";
  ok [^^] ( $undef, $undef, 2, $undef ), "|{$undef.perl}| $msg1 \#​5";
  nok [^^] ( $undef, $undef, $undef ), "|{$undef.perl}| $msg1 \#​6";
  nok [^^] ( $undef, $undef ), "|{$undef.perl}| $msg1 \#​7";
  ok [^^] ( $undef, 1 ), "|{$undef.perl}| $msg1 \#​8";
  ok [^^] ( 1, $undef ), "|{$undef.perl}| $msg1 \#​9";
  nok [^^] ( $undef ), "|{$undef.perl}| $msg1 \#​10";
  ok ( $undef ^^ $undef ^^ $undef ^^ 5 ), "|{$undef.perl}| $msg2 \#​1";
  nok ( 1 ^^ 2 ^^ $undef ^^ 3 ^^ $undef ), "|{$undef.perl}| $msg2 \#​2";
  nok ( $undef ^^ $undef ^^ 1 ^^ 5 ), "|{$undef.perl}| $msg2 \#​3";
  nok ( 1 ^^ $undef ^^ $undef ^^ 5 ), "|{$undef.perl}| $msg2 \#​4";
  ok ( $undef ^^ $undef ^^ 2 ^^ $undef ), "|{$undef.perl}| $msg2 \#​5";
  nok ( $undef ^^ $undef ^^ $undef ), "|{$undef.perl}| $msg2 \#​6";
  nok ( $undef ^^ $undef ), "|{$undef.perl}| $msg2 \#​7";
  ok ( $undef ^^ 1 ), "|{$undef.perl}| $msg2 \#​8";
  ok ( 1 ^^ $undef ), "|{$undef.perl}| $msg2 \#​9";
  }
}

{ # test numericy true things
  my $msg1 = 'reduce [^^] true numbery variable test';
  my $msg2 = 'infix ^^ true numbery variable test';

  for (1, -147, pi, Bool​::True) -> $def
  {
  nok [^^] ( 0, 0, $def, 3, $def ), "|{$def.perl}| $msg1 \#​1";
  nok [^^] ( $def, $def, 0 ), "|{$def.perl}| $msg1 \#​2";
  nok [^^] ( 1, $def, Any, 5 ), "|{$def.perl}| $msg1 \#​3";
  ok [^^] ( $def, 0, 0, 0 ) == $def, "|{$def.perl}| $msg1 \#​4";
  ok [^^] ( Any, Any, Any, $def ) == $def, "|{$def.perl}| $msg1 \#​5";
  nok [^^] ( $def, $def ), "|{$def.perl}| $msg1 \#​6";
  ok [^^] ( $def, 0 ) == $def, "|{$def.perl}| $msg1 \#​7";
  ok [^^] ( 0, $def ) == $def, "|{$def.perl}| $msg1 \#​8";
  ok [^^] ( $def ), "|{$def.perl}| $msg1 \#​9";
  nok ( 0 ^^ 0 ^^ $def ^^ 3 ^^ $def ), "|{$def.perl}| $msg2 \#​1";
  nok ( $def ^^ $def ^^ 0 ), "|{$def.perl}| $msg2 \#​2";
  nok ( 1 ^^ $def ^^ Any ^^ 5 ), "|{$def.perl}| $msg2 \#​3";
  ok ( $def ^^ 0 ^^ 0 ^^ 0 ) == $def, "|{$def.perl}| $msg2 \#​4";
  ok ( Any ^^ Any ^^ Any ^^ $def ) == $def,"|{$def.perl}| $msg2 \#​5";
  nok ( $def ^^ $def ), "|{$def.perl}| $msg2 \#​6";
  ok ( $def ^^ 0 ) == $def, "|{$def.perl}| $msg2 \#​7";
  ok ( 0 ^^ $def ) == $def, "|{$def.perl}| $msg2 \#​8";
  }
}

{ # test stringy true things
  my $msg1 = 'reduce [^^] true string variable test';
  my $msg2 = 'infix ^^ true string variable test';

  for ('no', 'Bob', '10', 'False') -> $def
  {
  nok [^^] ( $def, $def, $def, 'string' ), "|{$def.perl}| $msg1 \#​1";
  nok [^^] ( '', '', $def, 'str', $def ), "|{$def.perl}| $msg1 \#​2";
  nok [^^] ( $def, $def,'' ), "|{$def.perl}| $msg1 \#​3";
  nok [^^] ( 1, $def, Any, 5 ), "|{$def.perl}| $msg1 \#​4";
  ok [^^] ( $def, '', '', '' ) eq $def, "|{$def.perl}| $msg1 \#​5";
  ok [^^] ( Any, Any, Any, $def ) eq $def, "|{$def.perl}| $msg1 \#​6";
  nok [^^] ( $def, $def ), "|{$def.perl}| $msg1 \#​7";
  ok [^^] ( $def, '' ) eq $def, "|{$def.perl}| $msg1 \#​8";
  ok [^^] ( '', $def ) eq $def, "|{$def.perl}| $msg1 \#​9";
  ok [^^] ( $def ) eq $def, "|{$def.perl}| $msg1 \#​10";
  nok ( $def ^^ $def ^^ $def ^^ 'string' ), "|{$def.perl}| $msg2 \#​1";
  nok ( '' ^^ '' ^^ $def ^^ 'str' ^^ $def ),"|{$def.perl}| $msg2 \#​2";
  nok ( $def ^^ $def ^^'' ), "|{$def.perl}| $msg2 \#​3";
  nok ( 1 ^^ $def ^^ Any ^^ 5 ), "|{$def.perl}| $msg2 \#​4";
  ok ( $def ^^ '' ^^ '' ^^ '' ) eq $def, "|{$def.perl}| $msg2 \#​5";
  ok ( Any ^^ Any ^^ Any ^^ $def ) eq $def,"|{$def.perl}| $msg2 \#​6";
  nok ( $def ^^ $def ), "|{$def.perl}| $msg2 \#​7";
  ok ( $def ^^ '' ) eq $def, "|{$def.perl}| $msg2 \#​8";
  ok ( '' ^^ $def ) eq $def, "|{$def.perl}| $msg2 \#​9";
  }
}

{
  my @​a = (1,2,3);
  my @​b = (4,5,6);
  my (@​c, @​d);
 
  is (@​a ^^ @​c), '1 2 3', 'Array ^^ true returns true array';
  is (@​c ^^ @​a), '1 2 3', 'Array ^^ true returns true array';
  ok (@​a ^^ @​b) == (), 'Array ^^ true returns empty list';
  ok (@​c ^^ @​d) == (), 'Array ^^ true returns empty list';
  is (@​a ^^ ()), '1 2 3', 'True array ^^ empty list returns array';
  is (() ^^ @​a), '1 2 3', 'Empty list ^^ true array returns array';
  ok (() ^^ @​c) == (), 'Empty list ^^ empty array returns ()';
}

{
  # RT # 73820 http://rt.perl.org/rt3/Public/Bug/Display.html?id=73280
  # RT # 72826 http://rt.perl.org/rt3/Public/Bug/Display.html?id=72826

  is ( 7 ^^ 7 ).WHAT, 'Bool()', 'Bool()';
  is ( 7 ^^ Mu ).WHAT, 'Int()', 'Int()';
  is ( 0 ^^ ^7 ).WHAT, 'Range()', 'Range()';
  is ( ^7 ^^ 0 ).WHAT, 'Range()', 'Range()';
  is ( 7.5i ^^ Mu ).WHAT, 'Complex()', 'Complex()';
  is ( Inf ^^ Mu ).WHAT, 'Num()', 'Num()';
  is ( 'Inf' ^^ Mu ).WHAT, 'Str()', 'Str()';
}

@p6rt
Copy link
Author

p6rt commented Jan 5, 2011

From @thundergnat

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
index 93b73c0..8928af1 100644
--- a/src/Perl6/Grammar.pm
+++ b/src/Perl6/Grammar.pm
@​@​ -1883,7 +1883,7 @​@​ token dumbsmart {
token infix​:sym<&&> { <sym> <O('%tight_and, :pasttype<if>')> }

token infix​:sym<||> { <sym> <O('%tight_or, :assoc<left>, :pasttype<unless>'> }
-token infix​:sym<^^> { <sym> <O('%tight_or, :pasttype<xor>')> }
+token infix​:sym<^^> { <sym> <O('%tight_or')> }
token infix​:sym<//> { <sym> <O('%tight_or, :assoc<left>, :pasttype<def_or>'> }
token infix​:sym<min> { <sym> >> <O('%tight_or')> }
token infix​:sym<max> { <sym> >> <O('%tight_or')> }
diff --git a/src/core/operators.pm b/src/core/operators.pm
index 75840d8..8ab2828 100644
--- a/src/core/operators.pm
+++ b/src/core/operators.pm
@​@​ -512,6 +512,31 @​@​ our multi sub infix​:<or>(Mu $a, Mu $b) { $a or $b }
our multi sub infix​:<&&>(Mu $a, Mu $b) { $a && $b }
our multi sub infix​:<and>(Mu $a, Mu $b) { $a and $b }

+
+our multi sub infix​:<^^>(Mu $a, Mu $b) {
+ return $a ?? $b ?? Bool​::False !! $a
+ !! $b ?? $b !! Bool​::False;
+}
+
+our multi sub infix​:<^^>(Mu @​a, Mu @​b) {
+ return +@​a ?? +@​b ?? () !! @​b
+ !! +@​b ?? @​b !! ();
+}
+
+our multi sub infix​:<^^>(Mu $a, *@​a) {
+ return [^^] $a, @​a;
+}
+
+our multi sub prefix​:<[^^]>(*@​a) {
+ my $a = shift @​a;
+ for @​a -> $b
+ {
+ return Bool​::False if $b && $a;
+ $a ||= $b;
+ };
+ return $a || Bool​::False;
+}
+
# Eliminate use of this one, but keep the pir around for
# the moment, as it may come in handy elsewhere.
#

@p6rt
Copy link
Author

p6rt commented Jan 27, 2011

From @Kodiologist

I've made other changes to Rakudo (549d2a9) in preference to your patch,
thundergnat, because of issues like calling [^^] without parentheses.
But your tests have been incorporated into roast. At any rate, the bug's
fixed.

@p6rt
Copy link
Author

p6rt commented Jan 27, 2011

@Kodiologist - Status changed from 'open' to 'resolved'

@p6rt p6rt closed this as completed Jan 27, 2011
@p6rt p6rt added the Todo label Jan 5, 2020
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
Projects
None yet
Development

No branches or pull requests

1 participant