This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid accessing free()d memory when calling reset in one thread, after
[perl5.git] / t / op / reset.t
CommitLineData
2f3c5f77
NC
1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8use strict;
9
10# Currently only testing the reset of patterns.
a1f22e0c 11plan tests => 24;
2f3c5f77
NC
12
13package aiieee;
14
15sub zlopp {
16 (shift =~ ?zlopp?) ? 1 : 0;
17}
18
19sub reset_zlopp {
20 reset;
21}
22
23package CLINK;
24
25sub ZZIP {
26 shift =~ ?ZZIP? ? 1 : 0;
27}
28
29sub reset_ZZIP {
30 reset;
31}
32
33package main;
34
35is(aiieee::zlopp(""), 0, "mismatch doesn't match");
36is(aiieee::zlopp("zlopp"), 1, "match matches first time");
37is(aiieee::zlopp(""), 0, "mismatch doesn't match");
38is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time");
39aiieee::reset_zlopp();
40is(aiieee::zlopp("zlopp"), 1, "match matches after reset");
41is(aiieee::zlopp(""), 0, "mismatch doesn't match");
42
43aiieee::reset_zlopp();
44
45is(aiieee::zlopp(""), 0, "mismatch doesn't match");
46is(aiieee::zlopp("zlopp"), 1, "match matches first time");
47is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
48is(CLINK::ZZIP("ZZIP"), 1, "match matches first time");
49is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
50is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match second time");
51is(aiieee::zlopp(""), 0, "mismatch doesn't match");
52is(aiieee::zlopp("zlopp"), 0, "match doesn't match second time");
53
54aiieee::reset_zlopp();
55is(aiieee::zlopp("zlopp"), 1, "match matches after reset");
56is(aiieee::zlopp(""), 0, "mismatch doesn't match");
57
58is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
59is(CLINK::ZZIP("ZZIP"), 0, "match doesn't match third time");
60
61CLINK::reset_ZZIP();
62is(CLINK::ZZIP("ZZIP"), 1, "match matches after reset");
63is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
a1f22e0c
NC
64
65
66undef $/;
67my $prog = <DATA>;
68
69SKIP:
70{
71 eval {require threads; 1} or
72 skip "No threads", 4;
a1f22e0c
NC
73 foreach my $eight ('/', '?') {
74 foreach my $nine ('/', '?') {
75 my $copy = $prog;
76 $copy =~ s/8/$eight/gm;
77 $copy =~ s/9/$nine/gm;
78 fresh_perl_is($copy, "pass", "",
79 "first pattern $eight$eight, second $nine$nine");
80 }
81 }
82}
83
84__DATA__
85#!perl
86use warnings;
87use strict;
88
89# Note that there are no digits in this program, other than the placeholders
90sub a {
918one8;
92}
93sub b {
949two9;
95}
96
97use threads;
98use threads::shared;
99
100sub wipe {
101 eval 'no warnings; sub b {}';
102}
103
104sub lock_then_wipe {
105 my $l_r = shift;
106 lock $$l_r;
107 cond_wait($$l_r) until $$l_r eq "B";
108 wipe;
109 $$l_r = "C";
110 cond_signal $$l_r;
111}
112
113my $lock : shared = "A";
114my $r = \$lock;
115
116my $t;
117{
118 lock $$r;
119 $t = threads->new(\&lock_then_wipe, $r);
120 wipe;
121 $lock = "B";
122 cond_signal $lock;
123}
124
125{
126 lock $lock;
127 cond_wait($lock) until $lock eq "C";
128 reset;
129}
130
131$t->join;
132print "pass\n";