Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / caller.pl
CommitLineData
d8c5b3c5 1# tests shared between t/op/caller.t and ext/XS/APItest/t/op.t
2
3use strict;
4use warnings;
5
6sub dooot {
7 is(hint_fetch('dooot'), undef);
8 is(hint_fetch('thikoosh'), undef);
9 ok(!hint_exists('dooot'));
10 ok(!hint_exists('thikoosh'));
11 if ($::testing_caller) {
12 is(hint_fetch('dooot', 1), 54);
13 }
14 BEGIN {
15 $^H{dooot} = 42;
16 }
17 is(hint_fetch('dooot'), 6 * 7);
18 if ($::testing_caller) {
19 is(hint_fetch('dooot', 1), 54);
20 }
21
22 BEGIN {
23 $^H{dooot} = undef;
24 }
25 is(hint_fetch('dooot'), undef);
26 ok(hint_exists('dooot'));
27
28 BEGIN {
29 delete $^H{dooot};
30 }
31 is(hint_fetch('dooot'), undef);
32 ok(!hint_exists('dooot'));
33 if ($::testing_caller) {
34 is(hint_fetch('dooot', 1), 54);
35 }
36}
37{
38 is(hint_fetch('dooot'), undef);
39 is(hint_fetch('thikoosh'), undef);
40 BEGIN {
41 $^H{dooot} = 1;
42 $^H{thikoosh} = "SKREECH";
43 }
44 if ($::testing_caller) {
45 is(hint_fetch('dooot'), 1);
46 }
47 is(hint_fetch('thikoosh'), "SKREECH");
48
49 BEGIN {
50 $^H{dooot} = 42;
51 }
52 {
53 {
54 BEGIN {
55 $^H{dooot} = 6 * 9;
56 }
57 is(hint_fetch('dooot'), 54);
58 is(hint_fetch('thikoosh'), "SKREECH");
59 {
60 BEGIN {
61 delete $^H{dooot};
62 }
63 is(hint_fetch('dooot'), undef);
64 ok(!hint_exists('dooot'));
65 is(hint_fetch('thikoosh'), "SKREECH");
66 }
67 dooot();
68 }
69 is(hint_fetch('dooot'), 6 * 7);
70 is(hint_fetch('thikoosh'), "SKREECH");
71 }
72 is(hint_fetch('dooot'), 6 * 7);
73 is(hint_fetch('thikoosh'), "SKREECH");
74}
75
76print "# which now works inside evals\n";
77
78{
79 BEGIN {
80 $^H{dooot} = 42;
81 }
82 is(hint_fetch('dooot'), 6 * 7);
83
84 eval "is(hint_fetch('dooot'), 6 * 7); 1" or die $@;
85
86 eval <<'EOE' or die $@;
87 is(hint_fetch('dooot'), 6 * 7);
88 eval "is(hint_fetch('dooot'), 6 * 7); 1" or die $@;
89 BEGIN {
90 $^H{dooot} = 54;
91 }
92 is(hint_fetch('dooot'), 54);
93 eval "is(hint_fetch('dooot'), 54); 1" or die $@;
94 eval 'BEGIN { $^H{dooot} = -1; }; 1' or die $@;
95 is(hint_fetch('dooot'), 54);
96 eval "is(hint_fetch('dooot'), 54); 1" or die $@;
97EOE
98}
99
100{
101 BEGIN {
102 $^H{dooot} = "FIP\0FOP\0FIDDIT\0FAP";
103 }
104 is(hint_fetch('dooot'), "FIP\0FOP\0FIDDIT\0FAP", "Can do embedded 0 bytes");
105
106 BEGIN {
107 $^H{dooot} = chr 256;
108 }
109 is(hint_fetch('dooot'), chr 256, "Can do Unicode");
110
111 BEGIN {
112 $^H{dooot} = -42;
113 }
114 is(hint_fetch('dooot'), -42, "Can do IVs");
115
116 BEGIN {
117 $^H{dooot} = ~0;
118 }
119 cmp_ok(hint_fetch('dooot'), '>', 42, "Can do UVs");
120}
121
122{
123 my ($k1, $k2, $k3, $k4);
124 BEGIN {
125 $k1 = chr 163;
126 $k2 = $k1;
127 $k3 = chr 256;
128 $k4 = $k3;
129 utf8::upgrade $k2;
130 utf8::encode $k4;
131
132 $^H{$k1} = 1;
133 $^H{$k2} = 2;
134 $^H{$k3} = 3;
135 $^H{$k4} = 4;
136 }
137
138
139 is(hint_fetch($k1), 2, "UTF-8 or not, it's the same");
140 if ($::testing_caller) {
141 # Perl_refcounted_he_fetch() insists that you have the key correctly
142 # normalised for the way hashes store them. As this one isn't
143 # normalised down to bytes, it won't t work with
144 # Perl_refcounted_he_fetch()
145 is(hint_fetch($k2), 2, "UTF-8 or not, it's the same");
146 }
147 is(hint_fetch($k3), 3, "Octect sequences and UTF-8 are distinct");
148 is(hint_fetch($k4), 4, "Octect sequences and UTF-8 are distinct");
149}
150
151{
152 my ($k1, $k2, $k3);
153 BEGIN {
154 ($k1, $k2, $k3) = ("\0", "\0\0", "\0\0\0");
155 $^H{$k1} = 1;
156 $^H{$k2} = 2;
157 $^H{$k3} = 3;
158 }
159
160 is(hint_fetch($k1), 1, "Keys with the same hash value don't clash");
161 is(hint_fetch($k2), 2, "Keys with the same hash value don't clash");
162 is(hint_fetch($k3), 3, "Keys with the same hash value don't clash");
163
164 BEGIN {
165 $^H{$k1} = "a";
166 $^H{$k2} = "b";
167 $^H{$k3} = "c";
168 }
169
170 is(hint_fetch($k1), "a", "Keys with the same hash value don't clash");
171 is(hint_fetch($k2), "b", "Keys with the same hash value don't clash");
172 is(hint_fetch($k3), "c", "Keys with the same hash value don't clash");
173}
174
1751;