Permalink
Browse files

Perlito5 - another ~200 standard tests

  • Loading branch information...
1 parent a9955f1 commit 73d65642dd5211f6c5d89e94672d15fe7d6541dc @fglock committed Nov 29, 2012
Showing with 145 additions and 0 deletions.
  1. +72 −0 t5/op/pow.t
  2. +54 −0 t5/op/wantarray.t
  3. +19 −0 t5/re/reg_unsafe.t
View
@@ -0,0 +1,72 @@
+#!./perl -w
+# Now they'll be wanting biff! and zap! tests too.
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+# This calcualtion ought to be within 0.001 of the right answer.
+my $bits_in_uv = int (0.001 + log (~0+1) / log 2);
+
+# 3**30 < 2**48, don't trust things outside that range on a Cray
+# Likewise other 3 should not overflow 48 bits if I did my sums right.
+my @pow = ([ 3, 30, 1e-14],
+ [ 4, 32, 0],
+ [ 5, 20, 1e-14],
+ [2.5, 10, 1e-14],
+ [ -2, 69, 0],
+ [ -3, 30, 1e-14],
+);
+my $tests;
+$tests += $_->[1] foreach @pow;
+
+plan tests => 13 + $bits_in_uv + $tests;
+
+# (-3)**3 gave 27 instead of -27 before change #20167.
+# Let's test the other similar edge cases, too.
+is((-3)**0, 1, "negative ** 0 = 1");
+is((-3)**1, -3, "negative ** 1 = self");
+is((-3)**2, 9, "negative ** 2 = positive");
+is((-3)**3, -27, "(negative int) ** (odd power) is negative");
+
+# Positives shouldn't be a problem
+is(3**0, 1, "positive ** 0 = 1");
+is(3**1, 3, "positive ** 1 = self");
+is(3**2, 9, "positive ** 2 = positive");
+is(3**3, 27, "(positive int) ** (odd power) is positive");
+
+# And test order of operations while we're at it
+is(-3**0, -1);
+is(-3**1, -3);
+is(-3**2, -9);
+is(-3**3, -27);
+
+
+# Ought to be 32, 64, 36 or something like that.
+
+my $remainder = $bits_in_uv & 3;
+
+cmp_ok ($remainder, '==', 0, 'Sanity check bits in UV calculation')
+ or printf "# ~0 is %d (0x%d) which gives $bits_in_uv bits\n", ~0, ~0;
+
+# These are a lot of brute force tests to see how accurate $m ** $n is.
+# Unfortunately rather a lot of perl programs expect 2 ** $n to be integer
+# perfect, forgetting that it's a call to floating point pow() which never
+# claims to deliver perfection.
+foreach my $n (0..$bits_in_uv - 1) {
+ my $pow = 2 ** $n;
+ my $int = 1 << $n;
+ cmp_ok ($pow, '==', $int, "2 ** $n vs 1 << $n");
+}
+
+foreach my $pow (@pow) {
+ my ($base, $max, $range) = @$pow;
+ my $expect = 1;
+ foreach my $n (0..$max-1) {
+ my $got = $base ** $n;
+ within ($got, $expect, $range, "$base ** $n got[$got] expect[$expect]");
+ $expect *= $base;
+ }
+}
View
@@ -0,0 +1,54 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+use strict;
+
+plan 13;
+
+sub context {
+ local $::Level = $::Level + 1;
+ my ( $cona, $testnum ) = @_;
+ my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
+ is $cona, $conb;
+}
+
+context('V');
+my $a = context('S');
+my @a = context('A');
+scalar context('S');
+$a = scalar context('S');
+($a) = context('A');
+($a) = scalar context('S');
+
+{
+ # [ID 20020626.011] incorrect wantarray optimisation
+ sub simple { wantarray ? 1 : 2 }
+ sub inline {
+ my $a = wantarray ? simple() : simple();
+ $a;
+ }
+ my @b = inline();
+ my $c = inline();
+ is @b, 1;
+ is "@b", "2";
+ is $c, 2;
+}
+
+my $q;
+
+my $qcontext = q{
+ $q = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
+};
+eval $qcontext;
+is $q, 'V';
+$a = eval $qcontext;
+is $q, 'S';
+@a = eval $qcontext;
+is $q, 'A';
+
+1;
View
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+
+}
+print "1..1\n";
+
+# there is an equivelent test in t/re/pat.t which does NOT fail
+# its not clear why it doesnt fail, so this todo gets its own test
+# file until we can work it out.
+
+my $x;
+($x='abc')=~/(abc)/g;
+$x='123';
+
+print "not " if $1 ne 'abc';
+print "ok 1 # TODO safe match vars make /g slow\n";

0 comments on commit 73d6564

Please sign in to comment.