This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Couple of test file comments
[perl5.git] / t / op / sselect.t
CommitLineData
729c079f
NC
1#!./perl
2
926b8942
FC
3# Four-argument select
4
b3d9788e 5my $hires;
729c079f
NC
6BEGIN {
7 chdir 't' if -d 't';
624c42e2
N
8 require './test.pl';
9 set_up_inc('.', '../lib');
b3d9788e 10 $hires = eval 'use Time::HiResx "time"; 1';
729c079f
NC
11}
12
74416803
TC
13skip_all("Win32 miniperl has no socket select")
14 if $^O eq "MSWin32" && is_miniperl();
15
90eaaf02 16plan (15);
729c079f
NC
17
18my $blank = "";
19eval {select undef, $blank, $blank, 0};
8075d46e 20is ($@, "", 'select undef $blank $blank 0');
729c079f 21eval {select $blank, undef, $blank, 0};
8075d46e 22is ($@, "", 'select $blank undef $blank 0');
729c079f 23eval {select $blank, $blank, undef, 0};
8075d46e 24is ($@, "", 'select $blank $blank undef 0');
729c079f
NC
25
26eval {select "", $blank, $blank, 0};
8075d46e 27is ($@, "", 'select "" $blank $blank 0');
729c079f 28eval {select $blank, "", $blank, 0};
8075d46e 29is ($@, "", 'select $blank "" $blank 0');
729c079f 30eval {select $blank, $blank, "", 0};
8075d46e 31is ($@, "", 'select $blank $blank "" 0');
15547071 32
ba3062ae
FC
33# Test with read-only copy-on-write empty string
34my($rocow) = keys%{{""=>undef}};
35Internals::SvREADONLY($rocow,1);
36eval {select $rocow, $blank, $blank, 0};
37is ($@, "", 'select $rocow $blank $blank 0');
38eval {select $blank, $rocow, $blank, 0};
39is ($@, "", 'select $blank $rocow $blank 0');
40eval {select $blank, $blank, $rocow, 0};
41is ($@, "", 'select $blank $blank $rocow 0');
42
15547071 43eval {select "a", $blank, $blank, 0};
8075d46e
DM
44like ($@, qr/^Modification of a read-only value attempted/,
45 'select "a" $blank $blank 0');
15547071 46eval {select $blank, "a", $blank, 0};
8075d46e
DM
47like ($@, qr/^Modification of a read-only value attempted/,
48 'select $blank "a" $blank 0');
15547071 49eval {select $blank, $blank, "a", 0};
8075d46e
DM
50like ($@, qr/^Modification of a read-only value attempted/,
51 'select $blank $blank "a" 0');
e4d771f5 52
b3d9788e 53my $sleep = 3;
0ebb4f02
JD
54# Actual sleep time on Windows may be rounded down to an integral
55# multiple of the system clock tick interval. Clock tick interval
56# is configurable, but usually about 15.625 milliseconds.
b3d9788e
DM
57# time() however (if we haven;t loaded Time::HiRes), doesn't return
58# fractional values, so the observed delay may be 1 second short.
59#
60# There is also a report that old linux kernels may return 0.5ms early:
61# <20110520081714.GC17549@mars.tony.develop-help.com>.
62#
0ebb4f02 63
b3d9788e
DM
64my $under = $hires ? 0.1 : 1;
65
66my $t0 = time;
e4d771f5 67select(undef, undef, undef, $sleep);
b3d9788e
DM
68my $t1 = time;
69my $diff = $t1-$t0;
70ok($diff >= $sleep-$under, "select(u,u,u,\$sleep): at least $sleep seconds have passed");
71note("diff=$diff under=$under");
e4d771f5
JD
72
73my $empty = "";
74vec($empty,0,1) = 0;
b3d9788e 75$t0 = time;
e4d771f5 76select($empty, undef, undef, $sleep);
b3d9788e
DM
77$t1 = time;
78$diff = $t1-$t0;
79ok($diff >= $sleep-$under, "select(\$e,u,u,\$sleep): at least $sleep seconds have passed");
80note("diff=$diff under=$under");
90eaaf02
EB
81
82# [perl #120102] CORE::select ignoring timeout var's magic
83
84{
85 package RT120102;
86
87 my $count = 0;
88
89 sub TIESCALAR { bless [] }
90 sub FETCH { $count++; 0.1 }
91
92 my $sleep;
93
94 tie $sleep, 'RT120102';
95 select (undef, undef, undef, $sleep);
96 ::is($count, 1, 'RT120102');
97}