Author: masak
Date: Thu Nov 27 15:12:36 2008
New Revision: 33278
Modified:
trunk/languages/perl6/Test.pm
Log:
[rakudo] added is_deeply sub to Test.pm, from the November project
Modified: trunk/languages/perl6/Test.pm
==============================================================================
--- trunk/languages/perl6/Test.pm (original)
+++ trunk/languages/perl6/Test.pm Thu Nov 27 15:12:36 2008
@@ -143,6 +143,48 @@
}
+multi sub is_deeply($this, $that, $reason) {
+ my $val = _is_deeply( $this, $that );
+ proclaim( $val, $reason, $this.perl, $that.perl );
+}
+
+multi sub is_deeply($this, $that) {
+ my $val = _is_deeply( $this, $that );
+ proclaim( $val, '', $this.perl, $that.perl );
+}
+
+sub _is_deeply( $this, $that) {
+
+ if $this ~~ Array && $that ~~ Array {
+ return if +$this.values != +$that.values;
+ for $this Z $that -> $a, $b {
+ return if ! _is_deeply( $a, $b );
+ }
+ return True;
+ }
+ elsif $this ~~ Hash && $that ~~ Hash {
+ return if +$this.keys != +$that.keys;
+ for $this.keys.sort Z $that.keys.sort -> $a, $b {
+ return if $a ne $b;
+ return if ! _is_deeply( $this{$a}, $that{$b} );
+ }
+ return True;
+ }
+ elsif $this ~~ Str | Num | Int && $that ~~ Str | Num | Int {
+ return $this eq $that;
+ }
+ elsif $this ~~ Pair && $that ~~ Pair {
+ return $this.key eq $that.key
+ && _is_deeply( $this.value, $this.value );
+ }
+ elsif $this ~~ undef && $that ~~ undef && $this.WHAT eq $that.WHAT {
+ return True;
+ }
+
+ return;
+}
+
+
## 'private' subs
sub eval_exception($code) {
