Permalink
Browse files

pull in Perlito test files

  • Loading branch information...
1 parent 4ae984e commit 85bbba61d0f6e811e7ae18700c975890490405fc @FROGGS FROGGS committed Mar 24, 2013
View
@@ -0,0 +1,8 @@
+use perl5;
+use feature 'say';
+
+package Main;
+say '1..2';
+say 'ok 1';
+print 'o'; say 'k 2';
+
View
@@ -0,0 +1,7 @@
+use perl5;
+use strict;
+use feature 'say';
+
+package Main;
+say '1..1';
+say 'ok ', 1;
View
@@ -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';
+
View
@@ -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';
+
View
@@ -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";
+}
+
@@ -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';
+
View
@@ -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';
View
@@ -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";
View
@@ -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;
+
Oops, something went wrong.

0 comments on commit 85bbba6

Please sign in to comment.