Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | small amend (code review, implicit gets for *nix/eof to avoid endless event-cycle, etc) |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | sebres-speedup-testsuite |
| Files: | files | file ages | folders |
| SHA3-256: |
cdb6ed3f55e4107fe8a47dbb71d99896 |
| User & Date: | sebres 2018-12-18 22:30:55 |
Context
|
2018-12-18
| ||
| 22:30 | small amend (code review, implicit gets for *nix/eof to avoid endless event-cycle, etc) Leaf check-in: cdb6ed3f55 user: sebres tags: sebres-speedup-testsuite | |
| 20:41 | tests: new test-command "testisprocessrunning" in order to help recognize in test cases a child proc... check-in: 21737c5c85 user: sebres tags: sebres-speedup-testsuite | |
Changes
Changes to tests/socket.test.
1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 |
} else {
set x {client socket was inherited}
}
} else {
set x {client socket was not inherited}
}
# touch to signal end:
set done $done
catch { close $file }
} else {
set x {impossible case}
catch { close $file }
set done -2
}
return
}
proc scriptend {p} {
# wait for end of p:
variable pid2
variable done
set time 100
if {![eof $p]} {
if {[info command ::testisprocessrunning] eq ""
|| [testisprocessrunning $pid2]
} {
return
}
set time 0; # process exited - notify immediately
}
fileevent $p readable {}
# Pipe closed - process exited, give few time (0.1s) to fulfill the end.
after $time [list set done 1]
# If the socket doesn't hit end-of-file in 0.1 seconds, the
# script1 process must have inherited the client.
close $p
}
set done 0
# Launch the script2 process with port as argument
set port [lindex [fconfigure $server -sockname] 2]
set pid1 {}
set p [open "|[list [interpreter] $path(script2) $port]" w+]
set pid2 [pid $p]
fconfigure $p -buffering none -blocking 0
fileevent $p readable [list scriptend $p]
set x none
set tmr [after 2000 {set done -1; set x timeout}]
vwait done
if {[info command ::testisprocessrunning] ne ""} {
# be sure process 2 is exited:
while {$done == 0 && [testisprocessrunning $pid2]} {
after 10; update
}
# and process 1 is still running:
if {$done >= 0 && $pid1 ne "" && ![testisprocessrunning $pid1]} {
set x {unexpected, process 2 exited}
}
|
| > > > > > > | > | | |
1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 |
} else {
set x {client socket was inherited}
}
} else {
set x {client socket was not inherited}
}
# touch to signal end:
after 0 [namespace code {set done $done}]
catch { close $file }
} else {
set x {impossible case}
catch { close $file }
set done -2
}
return
}
proc scriptend {p} {
# wait for end of p:
variable pid2
variable done
variable waitcntr
set time 100
gets $p
if {![eof $p]} {
if {[info command ::testisprocessrunning] eq ""
|| [testisprocessrunning $pid2]
} {
# avoid endless event-cycle if process "hangs" before eof signaled:
if {[incr waitcntr] > 1000} {
fileevent $p readable {}
}
return
}
set time 0; # process exited - notify immediately
}
fileevent $p readable {}
# Pipe closed - process exited, give few time (0.1s) to fulfill the end.
after $time [namespace code {set done 1}]
# If the socket doesn't hit end-of-file in 0.1 seconds, the
# script1 process must have inherited the client.
close $p
}
set done 0
# Launch the script2 process with port as argument
set port [lindex [fconfigure $server -sockname] 2]
set pid1 {}
set p [open "|[list [interpreter] $path(script2) $port]" w+]
set pid2 [pid $p]
fconfigure $p -buffering none -blocking 0
set waitcntr 0
fileevent $p readable [list scriptend $p]
set x none
set tmr [after 2000 [namespace code {set done -1; set x timeout}]]
vwait done
if {[info command ::testisprocessrunning] ne ""} {
# be sure process 2 is exited:
while {$done == 0 && [testisprocessrunning $pid2]} {
after 10; update
}
# and process 1 is still running:
if {$done >= 0 && $pid1 ne "" && ![testisprocessrunning $pid1]} {
set x {unexpected, process 2 exited}
}
|