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