1#!./perl 2 3# Four-argument select 4 5my $hires; 6BEGIN { 7 chdir 't' if -d 't'; 8 require './test.pl'; 9 set_up_inc('.', '../lib'); 10 $hires = eval 'use Time::HiResx "time"; 1'; 11} 12 13skip_all("Win32 miniperl has no socket select") 14 if $^O eq "MSWin32" && is_miniperl(); 15 16plan (16); 17 18my $blank = ""; 19eval {select undef, $blank, $blank, 0}; 20is ($@, "", 'select undef $blank $blank 0'); 21eval {select $blank, undef, $blank, 0}; 22is ($@, "", 'select $blank undef $blank 0'); 23eval {select $blank, $blank, undef, 0}; 24is ($@, "", 'select $blank $blank undef 0'); 25 26eval {select "", $blank, $blank, 0}; 27is ($@, "", 'select "" $blank $blank 0'); 28eval {select $blank, "", $blank, 0}; 29is ($@, "", 'select $blank "" $blank 0'); 30eval {select $blank, $blank, "", 0}; 31is ($@, "", 'select $blank $blank "" 0'); 32 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 43eval {select "a", $blank, $blank, 0}; 44like ($@, qr/^Modification of a read-only value attempted/, 45 'select "a" $blank $blank 0'); 46eval {select $blank, "a", $blank, 0}; 47like ($@, qr/^Modification of a read-only value attempted/, 48 'select $blank "a" $blank 0'); 49eval {select $blank, $blank, "a", 0}; 50like ($@, qr/^Modification of a read-only value attempted/, 51 'select $blank $blank "a" 0'); 52 53my $sleep = 3; 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. 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# 63 64my $under = $hires ? 0.1 : 1; 65 66my $t0 = time; 67select(undef, undef, undef, $sleep); 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"); 72 73my $empty = ""; 74vec($empty,0,1) = 0; 75$t0 = time; 76select($empty, undef, undef, $sleep); 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"); 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} 98 99package _131645{ 100 sub TIESCALAR { bless [] } 101 sub FETCH { 0 } 102 sub STORE { } 103} 104tie $tie, _131645::; 105select ($tie, undef, undef, $tie); 106ok("no crash from select $numeric_tie, undef, undef, $numeric_tie") 107