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