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