15 (shift =~ m?zlopp?) ? 1 : 0;
25 shift =~ m?ZZIP? ? 1 : 0;
34 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
35 is(aiieee::zlopp("zlopp"), 1, "match matches first time");
36 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
37 is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time");
38 aiieee::reset_zlopp();
39 is(aiieee::zlopp("zlopp"), 1, "match matches after reset");
40 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
42 aiieee::reset_zlopp();
44 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
45 is(aiieee::zlopp("zlopp"), 1, "match matches first time");
46 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
47 is(CLINK::ZZIP("ZZIP"), 1, "match matches first time");
48 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
49 is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match second time");
50 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
51 is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time");
53 aiieee::reset_zlopp();
54 is(aiieee::zlopp("zlopp"), 1, "match matches after reset");
55 is(aiieee::zlopp(""), 0, "mismatch doesn't match");
57 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
58 is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match third time");
61 is(CLINK::ZZIP("ZZIP"), 1, "match matches after reset");
62 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
69 ok !match_foo(), 'reset "" leaves patterns alone [perl #97958]';
74 package scratch { reset "a" }
75 is join("-", $scratch::a//'u', $scratch::a2//'u', $scratch::b//'u'),
83 package scratch { reset "bc" }
84 is join("-", $scratch::a//'u', $scratch::a2//'u', $scratch::b//'u',
93 package scratch { reset "a-b" }
94 is join("-", $scratch::a//'u', $scratch::a2//'u', $scratch::b//'u',
99 { no strict; ${"scratch::\0foo"} = "bar" }
101 package scratch { reset "\0a" }
102 is join("-", $scratch::a//'u', do { no strict; ${"scratch::\0foo"} }//'u'),
106 $scratch::cow = __PACKAGE__;
107 $scratch::qr = ${qr//};
109 $scratch::glob = *is;
111 package scratch { reset 'cqgvr' }
112 is join ("-", map $_//'u', $scratch::cow, $scratch::qr, $scratch::v,
113 $scratch::glob,$scratch::ro), 'u-u-u-u-1',
114 'cow, qr, vstring, glob, ro test';
116 @scratch::an_array = 1..3;
117 %scratch::a_hash = 1..4;
118 package scratch { reset 'a' }
119 is @scratch::an_array, 0, 'resetting an array';
120 is %scratch::a_hash, 0, 'resetting a hash';
122 @scratch::an_array = 1..3;
123 %scratch::an_array = 1..4;
124 *scratch::an_array = \1;
125 package scratch { reset 'a' }
126 is @scratch::an_array, 0, 'resetting array in the same gv as a ro scalar';
127 is @scratch::an_array, 0, 'resetting a hash in the same gv as a ro scalar';
128 is $scratch::an_array, 1, 'reset skips ro scalars in the same gv as av/hv';
137 () = "$_"; # used to crash
139 is ref\$z, "GLOB", 'reset leaves real-globs-as-scalars as GLOBs';
140 is $z, "*main::_", 'And the glob still has the right value';
143 # This used to crash under threaded builds, because pmops were remembering
144 # their stashes by name, rather than by pointer.
145 fresh_perl_is( # it crashes more reliably with a smaller script
149 BEGIN { *baz:: = *bar::; *bar:: = *foo:: }
150 # The name "bar" no langer refers to the same package
152 undef &foo; # so freeing the op does not remove it from the stash’s list
154 push @_, ($_) x 10000; # and its memory is scribbled over
155 reset; # so reset on the original package tries to reset an invalid op
158 "no crash if package is effectively renamed before op is freed");
160 sub _117941 { package _117941; reset }
161 delete $::{"_117941::"};
163 pass("no crash when current package is freed");
170 eval {require threads; 1} or
171 skip "No threads", 4;
172 foreach my $eight ('/', '?') {
173 foreach my $nine ('/', '?') {
175 $copy =~ s/8/$eight/gm;
176 $copy =~ s/9/$nine/gm;
177 fresh_perl_is($copy, "pass", "",
178 "first pattern $eight$eight, second $nine$nine");
188 # Note that there are no digits in this program, other than the placeholders
200 eval 'no warnings; sub b {}; 1' or die $@;
206 cond_wait($$l_r) until $$l_r eq "B";
212 my $lock : shared = "A";
218 $t = threads->new(\&lock_then_wipe, $r);
226 cond_wait($lock) until $lock eq "C";