A test for upgrading scalars. Curiously, before this, lib/Math/Trig.t
Nicholas Clark [Wed, 26 Dec 2007 11:22:38 +0000 (11:22 +0000)]
was the only code anywhere in the build or testsuite that upgraded an
NV to an RV.

p4raw-id: //depot/perl@32724

MANIFEST
t/op/upgrade.t [new file with mode: 0644]

index 5c27821..2726727 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3932,6 +3932,7 @@ t/op/tr.t                 See if tr works
 t/op/undef.t                   See if undef works
 t/op/universal.t               See if UNIVERSAL class works
 t/op/unshift.t                 See if unshift works
+t/op/upgrade.t                 See if upgrading and assigning scalars works
 t/op/utf8decode.t              See if UTF-8 decoding works
 t/op/utfhash.t                 See if utf8 keys in hashes behave
 t/op/utftaint.t                        See if utf8 and taint work together
diff --git a/t/op/upgrade.t b/t/op/upgrade.t
new file mode 100644 (file)
index 0000000..787d413
--- /dev/null
@@ -0,0 +1,48 @@
+#!./perl -w
+
+# Check that we can "upgrade" from anything to anything else.
+# Curiously, before this, lib/Math/Trig.t was the only code anywhere in the
+# build or testsuite that upgraded an NV to an RV
+
+BEGIN {
+    chdir 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use strict;
+
+my $null;
+
+$! = 1;
+my %types = (
+    null => $null,
+    iv => 3,
+    nv => .5,
+    rv => [],
+    pv => "Perl rules",
+    pviv => 3,
+    pvnv => 1==1,
+    pvmg => $^,
+);
+
+# This is somewhat cheating but I can't think of anything built in that I can
+# copy that already has type PVIV
+$types{pviv} = "Perl rules!";
+
+# use Devel::Peek; Dump $pvmg;
+
+my @keys = keys %types;
+plan tests => @keys * @keys;
+
+foreach my $source_type (@keys) {
+    foreach my $dest_type (@keys) {
+       # Pads re-using variables might contaminate this
+       my $vars = {};
+       $vars->{dest} = $types{$dest_type};
+       $vars->{source} = $types{$source_type};
+       diag "Assigning $source_type to $dest_type";
+       $vars->{dest} = $vars->{source};
+       is ($vars->{dest}, $vars->{source});
+    }
+}