From 91769c7ff255f293bd690bf44308f3d06a06ee48 Mon Sep 17 00:00:00 2001 From: Krasimir Angelov Date: Wed, 1 Mar 2023 15:24:30 +0100 Subject: [PATCH] if createConcrete/alterConcrete fail, report the error correctly --- src/runtime/haskell/PGF2/Transactions.hsc | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/src/runtime/haskell/PGF2/Transactions.hsc b/src/runtime/haskell/PGF2/Transactions.hsc index 8cb2dd002..849ad5431 100644 --- a/src/runtime/haskell/PGF2/Transactions.hsc +++ b/src/runtime/haskell/PGF2/Transactions.hsc @@ -184,17 +184,26 @@ dropCategory name = Transaction $ \c_db _ c_revision c_exn -> createConcrete :: ConcName -> Transaction Concr () -> Transaction PGF () createConcrete name (Transaction f) = Transaction $ \c_db c_abstr c_revision c_exn -> withText name $ \c_name -> do - bracket (pgf_create_concrete c_db c_revision c_name c_exn) - (pgf_free_concr_revision_ c_db) $ \c_concr_revision -> + bracketPtr (pgf_create_concrete c_db c_revision c_name c_exn) + (pgf_free_concr_revision_ c_db) $ \c_concr_revision -> f c_db c_abstr c_concr_revision c_exn alterConcrete :: ConcName -> Transaction Concr a -> Transaction PGF a alterConcrete name (Transaction f) = Transaction $ \c_db c_abstr c_revision c_exn -> withText name $ \c_name -> do - bracket (pgf_clone_concrete c_db c_revision c_name c_exn) - (pgf_free_concr_revision_ c_db) $ \c_concr_revision -> + bracketPtr (pgf_clone_concrete c_db c_revision c_name c_exn) + (pgf_free_concr_revision_ c_db) $ \c_concr_revision -> f c_db c_abstr c_concr_revision c_exn +bracketPtr before after thing = + mask $ \restore -> do + a <- before + if a == nullPtr + then return undefined + else do r <- restore (thing a) `onException` after a + _ <- after a + return r + dropConcrete :: ConcName -> Transaction PGF () dropConcrete name = Transaction $ \c_db _ c_revision c_exn -> withText name $ \c_name -> do