xref: /openbsd-src/gnu/usr.bin/perl/t/op/svflags.t (revision 256a93a44f36679bee503f12e49566c2183f6181)
1*256a93a4Safresh1#!./perl
2*256a93a4Safresh1
3*256a93a4Safresh1BEGIN {
4*256a93a4Safresh1    chdir 't' if -d 't';
5*256a93a4Safresh1    require './test.pl';
6*256a93a4Safresh1    set_up_inc('../lib');
7*256a93a4Safresh1    skip_all("need B, need full perl") if is_miniperl();
8*256a93a4Safresh1}
9*256a93a4Safresh1
10*256a93a4Safresh1# Tests the new documented mechanism for determining the original type
11*256a93a4Safresh1# of an SV.
12*256a93a4Safresh1
13*256a93a4Safresh1plan tests => 16;
14*256a93a4Safresh1use strict;
15*256a93a4Safresh1use B qw(svref_2object SVf_IOK SVf_NOK SVf_POK);
16*256a93a4Safresh1
17*256a93a4Safresh1my $x = 10;
18*256a93a4Safresh1my $xobj = svref_2object(\$x);
19*256a93a4Safresh1is($xobj->FLAGS & (SVf_IOK | SVf_POK), SVf_IOK, "correct base flags on IV");
20*256a93a4Safresh1
21*256a93a4Safresh1my $y = $x . "";
22*256a93a4Safresh1
23*256a93a4Safresh1is($xobj->FLAGS & (SVf_IOK | SVf_POK), SVf_IOK, "POK not set on IV used as string");
24*256a93a4Safresh1
25*256a93a4Safresh1$x = 1.0;
26*256a93a4Safresh1
27*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "correct base flags on NV");
28*256a93a4Safresh1
29*256a93a4Safresh1$y = $x . "";
30*256a93a4Safresh1
31*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on NV used as string");
32*256a93a4Safresh1
33*256a93a4Safresh1my $z = $x;
34*256a93a4Safresh1$x = $z;
35*256a93a4Safresh1
36*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on copy of NV used as string");
37*256a93a4Safresh1
38*256a93a4Safresh1$x = "Inf" + 0;
39*256a93a4Safresh1
40*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "correct base flags on Inf NV");
41*256a93a4Safresh1
42*256a93a4Safresh1$y = $x . "";
43*256a93a4Safresh1
44*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on Inf NV used as string");
45*256a93a4Safresh1
46*256a93a4Safresh1$z = $x;
47*256a93a4Safresh1$x = $z;
48*256a93a4Safresh1
49*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on copy of Inf NV used as string");
50*256a93a4Safresh1
51*256a93a4Safresh1$x = "-Inf" + 0;
52*256a93a4Safresh1
53*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "correct base flags on -Inf NV");
54*256a93a4Safresh1
55*256a93a4Safresh1$y = $x . "";
56*256a93a4Safresh1
57*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on -Inf NV used as string");
58*256a93a4Safresh1
59*256a93a4Safresh1$z = $x;
60*256a93a4Safresh1$x = $z;
61*256a93a4Safresh1
62*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on copy of -Inf NV used as string");
63*256a93a4Safresh1
64*256a93a4Safresh1{
65*256a93a4Safresh1    local $^W = 0;
66*256a93a4Safresh1    $x  = "NaN" + 0;
67*256a93a4Safresh1}
68*256a93a4Safresh1
69*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "correct base flags on NaN NV");
70*256a93a4Safresh1
71*256a93a4Safresh1$y = $x . "";
72*256a93a4Safresh1
73*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on NaN NV used as string");
74*256a93a4Safresh1
75*256a93a4Safresh1$z = $x;
76*256a93a4Safresh1$x = $z;
77*256a93a4Safresh1
78*256a93a4Safresh1is($xobj->FLAGS & (SVf_NOK | SVf_POK), SVf_NOK, "POK not set on copy of NaN NV used as string");
79*256a93a4Safresh1
80*256a93a4Safresh1$x = "10";
81*256a93a4Safresh1is($xobj->FLAGS & (SVf_IOK | SVf_POK), SVf_POK, "correct base flags on PV");
82*256a93a4Safresh1
83*256a93a4Safresh1$y = $x + 10;
84*256a93a4Safresh1
85*256a93a4Safresh1is($xobj->FLAGS & (SVf_IOK | SVf_POK), (SVf_IOK | SVf_POK), "POK still set on PV used as number");
86