MailboxProcessor Scan memory leak - memory-leaks

Consider the following agent which uses Scan to process every message, with a message posted every millisecond.
open System.Threading
let mp = MailboxProcessor<string>.Start (fun inbox ->
let rec await () = inbox.Scan (fun msg ->
printfn "Received : %s" msg
printfn "Queue length: %i" inbox.CurrentQueueLength
Some <| await ())
await ())
while true do
mp.Post "word"
Thread.Sleep 1
If I monitor the memory usage of the process (macOS, via Activity Monitor), it grows and grows. Yet you can see from the printout that the queue length remains at 0.
Is this a memory leak bug in Scan or am I doing something wrong?

Related

Yesod WebSocketsT handler cleanup

I'm currently authoring an application in Haskell that relies on Yesod and its web sockets implementation.
I was wondering what is the correct way to acquire and release resources for a WebSocketT handler.
For example, in the following naive case...
chatApp :: WebSocketsT Handler ()
chatApp = do
let outgoingFlow = forever $ deliverOutgoingMessages
let incomingFlow = forever $ deliverIncomingMessages
bracket_ acquireResource
releaseResource
(race_ outgoingFlow incomingFlow)
... releaseResource does not seem to be called when a client disconnects abruptly or purposefully.
This is what I ended up doing over the weekend. This is essentially a replication of how web socket background ping process works, apart for the fact that I'm not swallowing the ping send exception when the other end is no longer reachable, but rather using it to detect the disconnection.
echoApp' :: WebSocketsT Handler ()
echoApp' = do
conn <- ask
let acquire = putStrLn "Acquiring..."
release = putStrLn "Releasing"
hardWork = (threadDelay 600000000)
ping i = do
threadDelay (30 * 1000 * 1000)
WS.sendPing conn (T.pack $ show i)
ping (i + 1)
liftIO $ bracket_ acquire release $ race_ hardWork (ping 1)
The downside of this approach is that there's still an up to 30 seconds window when the web socket process is lingering, but at least the resource gets eventually released in a more or less controllable way.

Sys.set_signal interrupts input_line on the main thread, but not in children threads

What is the proper way to write an interruptible reader thread in OCaml? Concretely, the following single-threaded program works (that is, Ctrl-C Ctrl-C interrupts it immediately):
exception SigInt
let _ =
Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> raise SigInt));
try output_string stdout (input_line stdin);
with SigInt -> print_endline "SINGLE_SIGINT"
The following program, on the other hand, cannot be interrupted with C-c C-c:
let _ =
Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> raise SigInt));
let go () =
try output_string stdout (input_line stdin);
with SigInt -> print_endline "CHILD_SIGINT" in
try Thread.join (Thread.create go ());
with SigInt -> print_endline "PARENT_SIGINT"
What's a cross-platform way to implement an interruptible reader thread in OCaml?. That is, what changes do I need to make to the multithreaded program above to make it interruptible?
I've explored multiple hypotheses to understand why the multi-threaded example above was not working, but none made sense full to me:
Maybe input_line isn't interruptible? But the the single-threaded example above would not work.
Maybe Thread.join is blocking the signal for the whole process? But in that case the following example would not be interruptible either:
let _ =
Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> raise SigInt));
let rec alloc acc =
alloc (1::acc) in
let go () =
try alloc []
with SigInt -> print_endline "CHILD_SIGINT" in
try Thread.join (Thread.create go ());
with SigInt -> print_endline "PARENT_SIGINT"
…and yet it is: pressing Ctrl-C Ctrl-C exits immediately.
Maybe the signal is delivered to the main thread, which is waiting uninterruptibly in Thread.join. If this was true, pressing Ctrl-C Ctrl-C then Enter would print "PARENT_SIGINT". But it doesn't: it prints "CHILD_SIGINT", meaning that the signal was routed to the child thread and delayed until input_line completed. Surprisingly, though, this works (and it prints CHILD_SIGINT)
let multithreaded_sigmask () =
Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> raise SigInt));
let go () =
try
ignore (Thread.sigmask Unix.SIG_SETMASK []);
output_string stdout (input_line stdin);
with SigInt -> print_endline "CHILD_SIGINT" in
try
ignore (Thread.sigmask Unix.SIG_SETMASK [Sys.sigint]);
Thread.join (Thread.create go ());
with SigInt -> print_endline "PARENT_SIGINT"
… but sigmask is not available on Windows.
Two things are working together to make the behavior hard to understand. The first is OS signal delivery to the process. The second is how the OCaml runtime delivers them to the application code.
Looking at the OCaml source code, its OS signal handler simply records the fact that a signal was raised, via a global variable. That flag is then polled by other parts of the OCaml runtime, at times when it is safe to deliver the signal. So the Thread.sigmask controls which thread(s) the OS signal can be delivered on, to the OCaml runtime. It does not control delivery to your app.
Pending signals are delivered by caml_process_pending_signals(), which is called by caml_enter_blocking_section() and caml_leave_blocking_section(). There is no thread mask or affinity here... the first thread to process the global list of pending signals does so.
The input_line function polls the OS for fresh input, and each time it does, it enters and leaves the blocking section, so it is polling frequently for signals.
Thread.join enters the blocking section, then blocks indefinitely, until the thread is finished, then leaves the blocking section. So while it is waiting, it is not polling for pending signals.
In your first interruptable example, what happens if you actually type and hit enter? Does the input_line call actually accumulate input and return it? It may not.. the Thread.join may own the blocking section and be preventing input and signal delivery process-wide.

Ocaml Thread misunderstanding

I only see the whole output after a 5 sec delay, but I think it should be otherwise.
I expect following output:
main is here
hi received
(and only then sleep for 5 sec)
but my code starts by sleeping first for 5 sec and only then continues.
let t1 ch =
let m = sync (receive ch) in
print_string (m ^ " -> received\n");
delay 5.0;
sync (send ch "t1 got the message")
let main () =
let ch = new_channel () in
create t1 ch;
print_string "main is here\n";
sync (send ch "hi");
print_string ("main confirms :" ^ sync(receive ch))
I would gladly read some tutorials online but I didn't find any.
Try flushing the output
print_string "main is here\n";
flush stdout

Testing captured IO from a spawned process

I want to test the return value and the IO output on the following method:
defmodule Speaker do
def speak do
receive do
{ :say, msg } ->
IO.puts(msg)
speak
_other ->
speak # throw away the message
end
end
end
In the ExUnit.CaptureIO docs, there is an example test that does this which looks like the following:
test "checking the return value and the IO output" do
fun = fn ->
assert Enum.each(["some", "example"], &(IO.puts &1)) == :ok
end
assert capture_io(fun) == "some\nexample\n"
end
Given that, I thought I could write the following test that performs a similar action but with a spawned process:
test ".speak with capture io" do
pid = Kernel.spawn(Speaker, :speak, [])
fun = fn ->
assert send(pid, { :say, "Hello" }) == { :say, "Hello" }
end
assert capture_io(fun) == "Hello\n"
end
However, I get the following error message telling me there was no output, even though I can see output on the terminal:
1) test .speak with capture io (SpeakerTest)
test/speaker_test.exs:25
Assertion with == failed
code: capture_io(fun) == "Hello\n"
lhs: ""
rhs: "Hello\n"
stacktrace:
test/speaker_test.exs:30: (test)
So, am I missing something perhaps with regards to testing spawned processes or methods that use the receive macro? How can I change my test to make it pass?
CaptureIO might not be suited for what you're trying to do here. It runs a function and returns the captured output when that function returns. But your function never returns, so seems like this won't work. I came up with the following workaround:
test ".speak with capture io" do
test_process = self()
pid = spawn(fn ->
Process.group_leader(self(), test_process)
Speaker.speak
end)
send(pid, {:say, "Hello"})
assert_receive {:io_request, _, _, {:put_chars, :unicode, "Hello\n"}}
# Just to cleanup pid which dies upon not receiving a correct response
# to the :io_request after a timeout
Process.exit(pid, :kill)
end
It uses Process.group_leader to set the current process as the receiver of IO messages for the tested process and then asserts that these messages arrive.
I had a similar problem, I had a registered process on my Application that would timeout every 10 seconds and write to stdio with IO.binwrite, to simulate multiple timeouts I took upon #Pawel-Obrok answer, but change it as to reply the :io_request with an :io_reply, that way the process would not hang allowing me to send multiple messages.
defp assert_io() do
send(MyProcess, :timeout)
receive do
{:io_request, _, reply_as, {:put_chars, _, msg}} ->
assert msg == "Some IO message"
send(Stats, {:io_reply, reply_as, :ok})
_ ->
flunk
end
end
test "get multiple messages" do
Process.group_leader(Process.whereis(MyProcess), self())
assert_io()
assert_io()
end
If you want to know more about the IO protocol take a look at the erlang docs about it.

F# Async Task Cancellation without Token

I am trying to parse hundreds of C source files to map dozens of software signal variables to the names of physical hardware pins. I am trying to do this asynchronously in F#
IndirectMappedHWIO
|> Seq.map IndirectMapFromFile //this is the function with the regex in it
|> Async.Parallel
|> Async.RunSynchronously
The issue is that I cannot figure out how to pass in a CancellationToken to end my task. Each task is reading around 300 C files so I want to be able to stop the task's execution as soon as the regex matches. I tried using Thread.CurrentThread.Abort() but that does not seem to work. Any ideas on how to pass in a CancellationToken for each task? Or any other way to cancel a task based on a condition?
let IndirectMapFromFile pin =
async {
let innerFunc filename =
use streamReader = new StreamReader (filePath + filename)
while not streamReader.EndOfStream do
try
let line1 = streamReader.ReadLine()
streamReader.ReadLine() |> ignore
let line2 = streamReader.ReadLine()
if(obj.ReferenceEquals(line2, null)) then
Thread.CurrentThread.Abort() //DOES NOT WORK!!
else
let m1 = Regex.Match(line1, #"^.*((Get|Put)\w+).*$");
let m2 = Regex.Match(line2, #"\s*return\s*\((\s*" + pin.Name + "\s*)\);");
if (m1.Success && m2.Success) then
pin.VariableName <- m1.Groups.[1].Value
Thread.CurrentThread.Abort() //DOES NOT WORK!!
else
()
with
| ex -> ()
()
Directory.GetFiles(filePath, "Rte*") //all C source and header files that start with Rte
|> Array.iter innerFunc
}
Asyncs cancel on designated operations, such as on return!, let!, or do!; they don't just kill the thread in any unknown state, which is not generally safe. If you want your asyncs to stop, they could for example:
be recursive and iterate via return!. The caller would provide a CancellationToken to Async.RunSynchronously and catch the resulting OperationCanceledException when the job is done.
check some thread-safe state and decide to stop depending on it.
Note that those are effectively the same thing: the workers who iterate over the data check what is going on and cancel in an orderly fashion. In other words, it is clear when exactly they check for cancellation.
Using async cancellation might result in something like this:
let canceler = new System.Threading.CancellationTokenSource()
let rec worker myParameters =
async {
// do stuff
if amIDone() then canceler.Cancel()
else return! worker (...) }
let workers = (...) |> Async.Parallel
try Async.RunSynchronously(workers, -1, canceler.Token) |> ignore
with :? System.OperationCanceledException -> ()
Stopping from common state could look like this:
let keepGoing = ref true
let rec worker myParameters =
if !keepGoing then
// do stuff
if amIDone() then keepGoing := false
worker (...)
let makeWorker initParams = async { worker initParams }
// make workers
workers |> Async.Parallel |> Async.RunSynchronously |> ignore
If the exact timing of cancellation is relevant, I believe the second method may not be safe, as there may be a delay until other threads see the variable change. This doesn't seem to matter here though.

Resources