msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

transactions should always start with the last revision and release it when done

Browse Source
This commit is contained in:
Krasimir Angelov
2022-05-23 19:50:41 +02:00
parent d66cf23811
commit fc09bc776b
8 changed files with 15 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -175,7 +175,7 @@ foreign import ccall pgf_infer_expr :: Ptr PgfDB -> Ptr PGF -> Ptr (StablePtr Ex
foreign import ccall pgf_check_type :: Ptr PgfDB -> Ptr PGF -> Ptr (StablePtr Type) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO ()
foreign import ccall pgf_start_transaction :: Ptr PgfDB -> Ptr PGF -> Ptr PgfExn -> IO (Ptr PGF)
foreign import ccall pgf_start_transaction :: Ptr PgfDB -> Ptr PgfExn -> IO (Ptr PGF)
foreign import ccall pgf_commit_transaction :: Ptr PgfDB -> Ptr PGF -> Ptr PgfExn -> IO ()

2
src/runtime/haskell/PGF2/Transactions.hsc
View File

@@ -84,7 +84,7 @@ modifyPGF p (Transaction f) =
withForeignPtr (a_revision p) $ \c_revision ->
withPgfExn "modifyPGF" $ \c_exn ->
mask $ \restore -> do
c_revision <- pgf_start_transaction (a_db p) c_revision c_exn
c_revision <- pgf_start_transaction (a_db p) c_exn
ex_type <- (#peek PgfExn, type) c_exn
if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE)
then do ((restore (f (a_db p) c_revision c_revision c_exn))

8
src/runtime/haskell/tests/transactions.hs
View File

@@ -9,10 +9,8 @@ main = do
gr1 <- readPGF "tests/basic.pgf"
let Just ty = readType "(N -> N) -> P (s z)"
print 1
gr2 <- modifyPGF gr1 (createFunction "foo" ty 0 [] pi >>
createCategory "Q" [(Explicit,"x",ty)] pi)
print 2
gr4 <- checkoutPGF gr1
@@ -21,6 +19,7 @@ main = do
gr7 <- modifyPGF gr1 $
createConcrete "basic_eng" $ do
setConcreteFlag "test_flag" (LStr "test")
let Just cnc = Map.lookup "basic_eng" (languages gr7)
c <- runTestTT $
@@ -31,8 +30,8 @@ main = do
,TestCase (assertEqual "original categories" ["Float","Int","N","P","S","String"] (categories gr1))
,TestCase (assertEqual "extended categories" ["Float","Int","N","P","Q","S","String"] (categories gr2))
,TestCase (assertEqual "Q context" (Just [(Explicit,"x",ty)]) (categoryContext gr2 "Q"))
,TestCase (assertEqual "reduced functions" ["c","floatLit","intLit","nat","s","stringLit","z"] (functions gr6))
,TestCase (assertEqual "reduced categories" ["Float","Int","N","P","String"] (categories gr6))
,TestCase (assertEqual "reduced functions" ["c","floatLit","foo","intLit","nat","s","stringLit","z"] (functions gr6))
,TestCase (assertEqual "reduced categories" ["Float","Int","N","P","Q","String"] (categories gr6))
,TestCase (assertEqual "old function type" Nothing (functionType gr1 "foo"))
,TestCase (assertEqual "new function type" (Just ty) (functionType gr2 "foo"))
,TestCase (assertEqual "old function prob" (-log 0) (functionProbability gr1 "foo"))
@@ -49,3 +48,4 @@ main = do
if (errors c == 0) && (failures c == 0)
then exitSuccess
else exitFailure