pull in Perlito test files

t/v5/01-sanity.t

@@ -0,0 +1,8 @@
+use perl5;
+use feature 'say';
+
+package Main;
+say '1..2';
+say 'ok 1';
+print 'o'; say 'k 2';
+

t/v5/02-int.t

@@ -0,0 +1,7 @@
+use perl5;
+use strict;
+use feature 'say';
+
+package Main;
+say '1..1';
+say 'ok ', 1;

t/v5/03-num.t

@@ -0,0 +1,43 @@
+use perl5;
+use strict;
+use feature 'say';
+
+package Main;
+say '1..8';
+my $v = 1 + 0.3;
+if (( $v < 1.29 ) || ( $v > 1.31 )) {
+    print 'not '
+}
+say 'ok ', 1;
+
+if (( $v . '' ) ne '1.3') {
+    print 'not '
+}
+say 'ok ', 2, ' # ', $v;
+
+if (( $v + '3.4' ) ne '4.7') {
+    print 'not '
+}
+say 'ok ', 3, ' # ', ($v + '3.4');
+
+if (( $v / 2 ) != 0.65) {
+    print 'not '
+}
+say 'ok 4 # ', ($v / 2);
+
+if (( $v * 2 ) != 2.6) {
+    print 'not '
+}
+say 'ok 5 # ', ($v * 2);
+
+print 'not ' if !defined 3.14;
+say 'ok 6 - defined num';
+
+$v = 3.14;
+print 'not ' if !defined $v;
+say 'ok 7 - defined var';
+
+my $y;
+print 'not ' if defined $y;
+say 'ok 8 - undefined var';
+

t/v5/04-op.t

@@ -0,0 +1,57 @@
+use perl5;
+use strict;
+use feature 'say';
+
+package Main;
+
+    say '1..11';
+
+    my $x = 1;
+    if ($x != "1") {
+        print 'not '
+    };
+    say 'ok 1 - != ', $x;
+
+    $x = 2;
+    if (!($x eq "2")) {
+        print 'not '
+    };
+    say 'ok 2 - ne ', $x;
+
+    $x = 0 ? "not ok" : "ok";
+    say $x, ' 3 - ternary';
+
+    $x = 1 ? "ok" : "not ok";
+    say $x, ' 4 - ternary';
+
+    print "ok 5 - print with embedded newlines\nok 6 - more newlines\n";
+
+    $x = 2;
+    if (!(($x + 2) == ($x + 1 + 1))) {
+        print 'not '
+    };
+    say 'ok 7 - add ';
+
+    $x = 2;
+    if (!(($x . 2) eq "22")) {
+        print 'not '
+    };
+    say 'ok 8 - concat';
+
+    my $undef;
+    if ($undef) {
+        print 'not '
+    };
+    say 'ok 9 - undef to bool';
+
+    if (!(($undef . 2) eq "2")) {
+        print 'not '
+    };
+    say 'ok 10 - undef to str';
+
+    $x = 2;
+    if (!(($x + 2) eq 4)) {
+        print 'not '
+    };
+    say 'ok 11 - plus with string';
+

t/v5/04-string.t

@@ -0,0 +1,111 @@
+use perl5;
+use strict;
+use feature 'say';
+
+say '1..20';
+
+my $x = "abcd";
+if (substr($x,1,1) ne "b") {
+    print 'not '
+};
+say 'ok 1 - substr ', substr($x,1,1);
+
+if (index($x,"c") ne 2) {
+    print 'not '
+};
+say 'ok 2 - index ', index($x,"c");
+
+if (substr($x,3,1) ne "d") {
+    print 'not '
+}
+say 'ok 3 - substr ', substr($x,3,1);
+
+print 'not ' if !defined "abc";
+say 'ok 4 - defined str';
+
+my $s = "o";
+$s .= "k 5 - concat";
+say $s;
+
+$s = "The black cat climbed the green tree";
+my $color  = substr $s, 4, 5;      # black
+my $middle = substr $s, 4, -11;    # black cat climbed the
+my $end    = substr $s, 14;        # climbed the green tree
+my $tail   = substr $s, -4;        # tree
+my $z      = substr $s, -4, 2;     # tr
+
+say "# $s";
+
+print 'not ' if $color ne 'black';
+say "ok 6  # $color";
+
+print 'not ' if $middle ne 'black cat climbed the';
+say "ok 7  # $middle";
+
+print 'not ' if $end ne 'climbed the green tree';
+say "ok 8  # $end";
+
+print 'not ' if $tail ne 'tree';
+say "ok 9  # $tail";
+
+print 'not ' if $z ne 'tr';
+say 'ok 10';
+
+
+# interpolation
+
+my $v = 123;
+my $r = "-$v-";
+print 'not ' if $r ne '-123-';  say 'ok 11 - scalar interpolation';
+
+my @v = (234, 567);
+$r = "-$v[1]-";
+print 'not ' if $r ne '-567-';  say 'ok 12 - array element interpolation';
+
+$r = "-${v[1]}-";
+print 'not ' if $r ne '-567-';  say 'ok 13 - array element interpolation';
+
+$r = "-@v-";
+print 'not ' if $r ne '-234 567-';  say 'ok 14 - array interpolation';
+
+my %v = (xyz => 234, abc => 567);
+$r = "-$v{xyz}-";
+print 'not ' if $r ne '-234-';  say 'ok 15 - hash element interpolation';
+
+$r = "-${v{xyz}}-";
+print 'not ' if $r ne '-234-';  say 'ok 16 - hash element interpolation';
+
+$v = { xyz => 123, abc => 567 };
+$r = "-$v->{xyz}-";
+print 'not ' if $r ne '-123-';  say "ok 17 - hash deref interpolation - $r";
+
+# {
+#     no strict 'refs';
+#     # Can't use bareword ("v") as a HASH ref while "strict refs" in use 
+#     # Global symbol "%v" requires explicit package name 
+#     $r = "-${v->{xyz}}-";
+#     print 'not ' if $r ne '-234-';  say 'ok 18 - hash deref interpolation';
+# }
+
+$v = [ 123, 567, 890 ];
+$r = "-$v->[2]-";
+print 'not ' if $r ne '-890-';  say "ok 18 - array deref interpolation - $r";
+
+# {
+#     no strict 'refs';
+#     # Can't use bareword ("v") as a HASH ref while "strict refs" in use 
+#     # Global symbol "@v" requires explicit package name 
+#     $r = "-${v->[2]}-";
+#     print 'not ' if $r ne '-890-';  say 'ok 18 - array deref interpolation';
+# }
+
+$r = "-$$v[2]-";
+print 'not ' if $r ne '-890-';  say "ok 19 - array deref interpolation - $r";
+
+{
+    my $x = "123"; 
+    my $y = \$x; 
+    $r = "[$$y]";
+    print 'not ' if $r ne '[123]';  say "ok 20 - scalar deref interpolation - $r";
+}
+

t/v5/05-anon-sub-lex-block.t

@@ -0,0 +1,32 @@
+use perl5;
+use strict;
+use feature 'say';
+
+package Main;
+    say '1..3';
+    my $a = sub () { 
+            do { 5 }
+        };
+    if ($a->() != 5) {
+        print 'not '
+    }
+    say 'ok 1 - do inside function';
+
+    $a = sub () { 
+            return do { 5 };
+            4;
+        };
+    if ($a->() != 5) {
+        print 'not '
+    }
+    say 'ok 2 - do inside function';
+
+    $a = sub () { 
+            do { return 5 };
+            4;
+        };
+    if ($a->() != 5) {
+        print 'not '
+    }
+    say 'ok 3 - do inside function';
+

t/v5/05-anon-sub.t

@@ -0,0 +1,22 @@
+use perl5;
+use strict;
+use feature 'say';
+
+package Main;
+    say '1..4';
+    my $a = sub { 3 };
+    say 'ok 1 - create function';
+    if ($a->() != 3) {
+        print 'not '
+    }
+    say 'ok 2 - apply';
+    $a = ( sub { 4 } )->();
+    if ($a != 4) {
+        print 'not '
+    }
+    say 'ok 3 - apply in line';
+    $a = ( sub () { sub { 5 } } )->();
+    if ($a->() != 5) {
+        print 'not '
+    }
+    say 'ok 4 - return function';

t/v5/05-array.t

@@ -0,0 +1,81 @@
+use perl5;
+use strict;
+use feature 'say';
+
+say '1..17';
+my @a;
+say 'ok 1 - create array';
+$a[1] = 3;
+say 'ok 2 - set element';
+if ($a[1] != 3) {
+    print 'not '
+}
+say 'ok 3 - fetch element # ', $a[1];
+
+my @x = ( 3, 4 ); 
+@a = ( 1, @x, 2 ); 
+if ($a[1] != 3) {
+    print 'not '
+}
+say 'ok 4 - interpolate array # ', @a;
+
+my $x = [ 5, 6 ];
+my $v = $x->[1];
+if ($v != 6) {
+    print 'not '
+}
+say 'ok 5 - array in a scalar var # ', $v;
+$x->[1] = 7;
+if ($x->[1] != 7) {
+    print 'not '
+}
+say 'ok 6 - array in a scalar var # ', $x->[1];
+
+{
+    my $v;
+    $v->[2] = 8;
+    if ($v->[2] != 8) {
+        print 'not '
+    }
+    say 'ok 7 - array in a scalar var # ', $v->[2];
+}
+
+print 'not ' if defined $x->[4];
+say "ok 8 - undefined item";
+
+print 'not ' if !defined $x->[1];
+say "ok 9 - defined item";
+
+$x->[4] = 5;
+print 'not ' if !defined $x->[4];
+say "ok 10 - defined item";
+
+unshift(@$x, 6);
+print 'not ' if $x->[0] != 6;
+say "ok 11 - unshift";
+print 'not ' if $x->[5] != 5;
+say "ok 12 - unshift";
+
+my @x13 = ( 3, 4 );
+my $s13 = join('#', @x13);
+print 'not '
+    unless $s13 eq '3#4';
+say "ok 13 - join # '$s13'";
+
+my @x14 = @x13;
+$x14[1] = 5;
+print 'not '
+    unless $x13[1] == 4;
+say "ok 14 - array copy";
+print 'not '
+    unless $x14[1] == 5;
+say "ok 15 - array copy";
+
+push @x14, 7;
+print 'not '
+    unless $x14[2] == 7;
+say "ok 16 - array push";
+
+print 'not '
+    unless ref( \@x14 ) eq 'ARRAY';
+say "ok 17 - ref is ARRAY";

t/v5/05-bind.t

@@ -0,0 +1,18 @@
+use perl5;
+use strict;
+use feature 'say';
+
+say '1..2';
+
+my $x = 1;
+if ($x != 1) {
+    print 'not '
+};
+say 'ok ', $x;
+
+$x = 2;
+if ($x != 2) {
+    print 'not '
+};
+say 'ok ', $x;
+