Pourquoi la fonction de support de Haskell fonctionne-t-elle dans les exécutables mais échoue-t-elle dans les tests?

Je vois un comportement très étrange où la bracketfonction de Haskell se comporte différemment selon qu'elle est utilisée stack runou non stack test.

Considérez le code suivant, où deux crochets imbriqués sont utilisés pour créer et nettoyer les conteneurs 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
                     )
          )

Lorsque j'exécute cela avec stack runet que j'interromps avec Ctrl+C, j'obtiens la sortie attendue:

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

Et je peux vérifier que les deux conteneurs Docker sont créés puis supprimés.

Cependant, si je colle exactement ce même code dans un test et que j'exécute stack test, seul (une partie de) le premier nettoyage se produit:

Inside both brackets, sleeping!
^CInner release
container2

Il en résulte un conteneur Docker laissé en cours d'exécution sur ma machine. Que se passe-t-il?

• J'ai fait en sorte que les mêmes informations ghc-optionssoient transmises aux deux.
• Repo de démonstration complet ici: https://github.com/thomasjm/bracket-issue

Lorsque vous utilisez stack run, Stack utilise efficacement un execappel système pour transférer le contrôle à l'exécutable, de sorte que le processus du nouvel exécutable remplace le processus Stack en cours d'exécution, comme si vous exécutiez l'exécutable directement à partir du shell. Voici à quoi ressemble l'arbre de processus stack run. Notez en particulier que l'exécutable est un enfant direct du shell Bash. Plus important encore, notez que le groupe de processus de premier plan du terminal (TPGID) est 17996, et le seul processus de ce groupe de processus (PGID) est le bracket-test-exeprocessus.

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

Par conséquent, lorsque vous appuyez sur Ctrl-C pour interrompre le processus en cours d'exécution sous stack runou directement à partir du shell, le signal SIGINT n'est délivré qu'au bracket-test-exeprocessus. Cela déclenche une UserInterruptexception asynchrone . La façon dont bracketfonctionne, quand:

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

reçoit une exception asynchrone lors du traitement body, il s'exécute releasepuis relance l'exception. Avec vos bracketappels imbriqués , cela a pour effet d'interrompre le corps interne, de traiter la version interne, de sur-lever l'exception pour interrompre le corps externe et de traiter la version externe, et enfin de sur-lever l'exception pour terminer le programme. (S'il y avait plus d'actions suivant l'extérieur bracketde votre mainfonction, elles ne seraient pas exécutées.)

D'un autre côté, lorsque vous utilisez stack test, Stack utilise withProcessWaitpour lancer l'exécutable en tant que processus enfant du stack testprocessus. Dans l'arborescence de processus suivante, notez qu'il bracket-test-tests'agit d'un processus enfant de stack test. De manière critique, le groupe de processus de premier plan du terminal est 18050, et ce groupe de processus comprend à la fois le stack testprocessus et le bracket-test-testprocessus.

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

Lorsque vous appuyez sur Ctrl-C dans le terminal, le signal SIGINT est envoyé à tous les processus du groupe de processus de premier plan du terminal afin d' obtenir les deux stack testet bracket-test-testle signal. bracket-test-testdémarre le traitement du signal et exécute les finaliseurs comme décrit ci-dessus. Cependant, il y a une condition de concurrence ici parce que quand stack testest interrompu, c'est au milieu de celui-ci withProcessWaitqui est défini plus ou moins comme suit:

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

ainsi, lorsque son bracketest interrompu, il appelle stopProcessce qui termine le processus fils en lui envoyant le SIGTERMsignal. En contraste avec SIGINT, cela ne déclenche pas d'exception asynchrone. Il met fin à l'enfant immédiatement, généralement avant qu'il ne puisse terminer l'exécution des finaliseurs.

Je ne peux pas penser à un moyen particulièrement facile de contourner cela. Une façon consiste à utiliser les installations System.Posixpour placer le processus dans son propre groupe de processus:

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"

Maintenant, Ctrl-C entraînera la livraison de SIGINT uniquement au bracket-test-testprocessus. Il nettoiera, restaurera le groupe de processus de premier plan d'origine pour pointer vers le stack testprocessus et se terminera. Cela entraînera l'échec du test et stack testcontinuera simplement à fonctionner.

Une alternative serait d'essayer de gérer SIGTERMet de maintenir le processus enfant en cours d'exécution pour effectuer le nettoyage, même une fois le stack testprocessus terminé. C'est un peu moche car le processus se nettoiera en arrière-plan pendant que vous regardez l'invite du shell.