Mengapa fungsi braket Haskell bekerja di executables tetapi gagal untuk membersihkan dalam tes?

Saya melihat perilaku yang sangat aneh di mana bracketfungsi Haskell berperilaku berbeda tergantung pada apakah stack runatau stack testtidak digunakan.

Pertimbangkan kode berikut, di mana dua tanda kurung bersarang digunakan untuk membuat dan membersihkan wadah Docker:

module Main where

import Control.Concurrent
import Control.Exception
import System.Process

main :: IO ()
main = do
  bracket (callProcess "docker" ["run", "-d", "--name", "container1", "registry:2"])
          (\() -> do
              putStrLn "Outer release"
              callProcess "docker" ["rm", "-f", "container1"]
              putStrLn "Done with outer release"
          )
          (\() -> do
             bracket (callProcess "docker" ["run", "-d", "--name", "container2", "registry:2"])
                     (\() -> do
                         putStrLn "Inner release"
                         callProcess "docker" ["rm", "-f", "container2"]
                         putStrLn "Done with inner release"
                     )
                     (\() -> do
                         putStrLn "Inside both brackets, sleeping!"
                         threadDelay 300000000
                     )
          )

Ketika saya menjalankan ini dengan stack rundan menyela dengan Ctrl+C, saya mendapatkan hasil yang diharapkan:

Inside both brackets, sleeping!
^CInner release
container2
Done with inner release
Outer release
container1
Done with outer release

Dan saya dapat memverifikasi bahwa kedua wadah Docker dibuat dan kemudian dihapus.

Namun, jika saya menempelkan kode yang sama persis ini ke dalam pengujian dan menjalankan stack test, hanya (bagian dari) pembersihan pertama terjadi:

Inside both brackets, sleeping!
^CInner release
container2

Ini menghasilkan wadah Docker dibiarkan berjalan di mesin saya. Apa yang sedang terjadi?

• Saya sudah memastikan bahwa hal yang sama ghc-optionsditeruskan ke keduanya.
• Repo demonstrasi lengkap di sini: https://github.com/thomasjm/bracket-issue

Ketika Anda menggunakan stack run, Stack secara efektif menggunakan execsystem call untuk mentransfer kontrol ke executable, sehingga proses untuk executable baru menggantikan proses Stack yang berjalan, sama seperti jika Anda menjalankan executable langsung dari shell. Inilah yang tampak setelah pohon proses stack run. Perhatikan khususnya bahwa executable adalah anak langsung dari Bash shell. Lebih kritis lagi, perhatikan bahwa grup proses latar depan terminal (TPGID) adalah 17996, dan satu-satunya proses dalam kelompok proses (PGID) adalah bracket-test-exeproses.

PPID   PID  PGID   SID TTY      TPGID STAT   UID   TIME COMMAND
13816 13831 13831 13831 pts/3    17996 Ss    2001   0:00  |       \_ /bin/bash --noediting -i
13831 17996 17996 13831 pts/3    17996 Sl+   2001   0:00  |       |   \_ .../.stack-work/.../bracket-test-exe

Akibatnya, ketika Anda menekan Ctrl-C untuk menghentikan proses yang berjalan di bawah stack runatau langsung dari shell, sinyal SIGINT dikirim hanya ke bracket-test-exeproses. Ini menimbulkan UserInterruptpengecualian asinkron . Cara bracketkerjanya, saat:

bracket
  acquire
  (\() -> release)
  (\() -> body)

menerima pengecualian asinkron saat memproses body, itu berjalan releasedan kemudian memunculkan kembali pengecualian. Dengan bracketpanggilan bersarang Anda , ini memiliki efek mengganggu tubuh bagian dalam, memproses pelepasan bagian dalam, meningkatkan kembali pengecualian untuk mengganggu bagian luar, dan memproses pelepasan bagian luar, dan akhirnya kembali meningkatkan pengecualian untuk menghentikan program. (Jika ada lebih banyak tindakan mengikuti bagian luar bracketdalam mainfungsi Anda , mereka tidak akan dieksekusi.)

Di sisi lain, ketika Anda menggunakan stack test, Stack menggunakan withProcessWaituntuk meluncurkan executable sebagai proses anak dari stack testproses. Di pohon proses berikut, perhatikan bahwa itu bracket-test-testadalah proses anak dari stack test. Secara kritis, grup proses latar depan terminal adalah 18050, dan grup proses tersebut mencakup stack testproses dan bracket-test-testproses.

PPID   PID  PGID   SID TTY      TPGID STAT   UID   TIME COMMAND
13816 13831 13831 13831 pts/3    18050 Ss    2001   0:00  |       \_ /bin/bash --noediting -i
13831 18050 18050 13831 pts/3    18050 Sl+   2001   0:00  |       |   \_ stack test
18050 18060 18050 13831 pts/3    18050 Sl+   2001   0:00  |       |       \_ .../.stack-work/.../bracket-test-test

Ketika Anda menekan Ctrl-C di terminal, sinyal SIGINT dikirim ke semua proses dalam kelompok proses latar depan terminal sehingga keduanya stack testdan bracket-test-testmendapatkan sinyal. bracket-test-testakan mulai memproses sinyal dan menjalankan finalizer seperti dijelaskan di atas. Namun, ada kondisi balapan di sini karena ketika stack testterganggu, ia berada di tengah-tengah withProcessWaityang didefinisikan kurang lebih sebagai berikut:

withProcessWait config f =
  bracket
    (startProcess config)
    stopProcess
    (\p -> f p <* waitExitCode p)

jadi, ketika bracketterganggu, ia memanggil stopProcessyang menghentikan proses anak dengan mengirimkannya SIGTERMsinyal. Dalam konstruksinya SIGINT, ini tidak menimbulkan pengecualian asinkron. Itu hanya mengakhiri anak segera, umumnya sebelum dapat menyelesaikan menjalankan setiap finalis.

Saya tidak bisa memikirkan cara yang sangat mudah untuk mengatasi hal ini. Salah satu caranya adalah dengan menggunakan fasilitas System.Posixuntuk menempatkan proses ke dalam kelompok prosesnya sendiri:

main :: IO ()
main = do
  -- save old terminal foreground process group
  oldpgid <- getTerminalProcessGroupID (Fd 2)
  -- get our PID
  mypid <- getProcessID
  let -- put us in our own foreground process group
      handleInt  = setTerminalProcessGroupID (Fd 2) mypid >> createProcessGroupFor mypid
      -- restore the old foreground process gorup
      releaseInt = setTerminalProcessGroupID (Fd 2) oldpgid
  bracket
    (handleInt >> putStrLn "acquire")
    (\() -> threadDelay 1000000 >> putStrLn "release" >> releaseInt)
    (\() -> putStrLn "between" >> threadDelay 60000000)
  putStrLn "finished"

Sekarang, Ctrl-C akan menghasilkan SIGINT yang dikirimkan hanya ke bracket-test-testproses. Ini akan membersihkan, mengembalikan grup proses latar depan asli untuk menunjuk ke stack testproses, dan mengakhiri. Ini akan menghasilkan tes gagal, dan stack testhanya akan terus berjalan.

Alternatifnya adalah mencoba untuk menangani SIGTERMdan menjaga proses anak berjalan untuk melakukan pembersihan, bahkan setelah stack testproses tersebut dihentikan. Ini agak jelek karena prosesnya akan seperti membersihkan di latar belakang saat Anda melihat prompt shell.