git.iko.soy/Idris-dev
on master help sign in
Merge pull request #744 from Melvar/executor-null-string

Allow the executor to call foreign functions that return possibly-NULL strings

commitabe366e4688b92fb3a0ecd9a19f5e45a2ba1f128 authorEdwin Brady <edwin.brady@gmail.com> dateSun 22 Dec 2013, 04:38 (13 years ago) parentc68b376d4dfcc3
6 files changed+45−3
compare with master
unifiedsplit
idris.cabal+15 src/Core/Execute.hs+10−3 test/README+1 test/reg029/expected+4 test/reg029/reg029.idr+10 test/reg029/run+5
idris.cabal+15
@@ -177,6 +177,21 @@ Extra-source-files:
177177 test/reg024/run
178178 test/reg024/*.idr
179179 test/reg024/expected
180+ test/reg025/run
181+ test/reg025/*.idr
182+ test/reg025/expected
183+ test/reg026/run
184+ test/reg026/*.idr
185+ test/reg026/expected
186+ test/reg027/run
187+ test/reg027/*.idr
188+ test/reg027/expected
189+ test/reg028/run
190+ test/reg028/*.idr
191+ test/reg028/expected
192+ test/reg029/run
193+ test/reg029/*.idr
194+ test/reg029/expected
180195 test/test001/run
181196 test/test001/*.idr
182197 test/test001/expected
src/Core/Execute.hs+10−3
@@ -285,6 +285,12 @@ execApp' env ctxt (EP _ (UN "mkForeignPrim") _) (_:fn:(EPtr p):rest)
285285 if p == nullPtr then 1 else 0
286286 in execApp' env ctxt res (tail rest)
287287
288+-- A foreign-returned char* has to be tested for NULL sometimes
289+execApp' env ctxt (EP _ (UN "mkForeignPrim") _) (_:fn:EConstant (Str s):rest)
290+ | Just (FFun "isNull" _ _) <- foreignFromTT fn
291+ = let res = ioWrap . EConstant . I $ 0
292+ in execApp' env ctxt res (tail rest)
293+
288294-- Throw away the 'World' argument to the foreign function
289295
290296execApp' env ctxt f@(EP _ (UN "mkForeignPrim") _) args@(ty:fn:xs)
@@ -440,9 +446,10 @@ call (FFun name argTypes retType) args =
440446 res <- execIO $ callFFI h retCChar (prepArgs args)
441447 return (EConstant (Ch (castCCharToChar res)))
442448 call' (Fun _ h) args FString = do res <- execIO $ callFFI h retCString (prepArgs args)
443− hStr <- execIO $ peekCString res
444−-- lift $ free res
445− return (EConstant (Str hStr))
449+ if res == nullPtr
450+ then return (EPtr res)
451+ else do hStr <- execIO $ peekCString res
452+ return (EConstant (Str hStr))
446453
447454 call' (Fun _ h) args FPtr = EPtr <$> (execIO $ callFFI h (retPtr retVoid) (prepArgs args))
448455 call' (Fun _ h) args FUnit = do _ <- execIO $ callFFI h retVoid (prepArgs args)
test/README+1
@@ -37,4 +37,5 @@ Tests:
3737
3838regxxx: various regression tests
3939reg020: working strlen
40+reg029: executor doesn’t crash receiving a NULL String from C
4041
test/reg029/expectednew file+4
@@ -0,0 +1,4 @@
1+Nothing
2+Just "exists!"
3+Nothing
4+Just "exists!"
test/reg029/reg029.idrnew file+10
@@ -0,0 +1,10 @@
1+module Main
2+
3+import System
4+
5+%dynamic "libm"
6+
7+main : IO ()
8+main = do
9+ print !(getEnv "IDRIS_REG029_NONEXISTENT_VAR")
10+ print !(getEnv "IDRIS_REG029_EXISTENT_VAR")
test/reg029/runnew file+5
@@ -0,0 +1,5 @@
1+#!/usr/bin/env bash
2+idris $@ reg029.idr -o reg029
3+env -u IDRIS_REG029_NONEXISTENT_VAR IDRIS_REG029_EXISTENT_VAR='exists!' ./reg029
4+env -u IDRIS_REG029_NONEXISTENT_VAR IDRIS_REG029_EXISTENT_VAR='exists!' idris $@ reg029.idr --exec
5+rm -f reg029 *.ibc