[Hugs]Unexpected signal from FFI
Marco Vezzoli
marco.vezzoli at st.com
Thu Apr 24 07:09:04 EDT 2003
(sorry for the cross-posting with hugs-user -- I 've found this ml
later)
Hi,
I'm learning how to use ffi with hugs (latest version, on Solaris 8, gcc
3.0.2).
I can compile this simple example without errors
----Test.hs-----------------------
module Test where
import Foreign.C.String
import Foreign.C.Types
foreign import ccall "test.h incr" incr :: Int->IO Int
foreign import ccall "test.h times" times :: CChar->Int->IO CString
testTimes = do{j<-times (castCharToCChar 'a') 3;c <- peekCString j
;putStr c}
testIncr = do{j<-incr 1;putStr $show j}
----Test.hs-----------------------
----test.c-----------------------
#include <stdlib.h>
#include "test.h"
int incr(int i){
return i+1;
}
char* times(char c,int i){
printf("times running %d\n",i);
char* ret;
char* itr;
ret=(char*)malloc(i*sizeof(char)+1);
for (itr=ret;itr<ret+i;itr++){
*itr=c;
}
*itr=0;
return ret;
}
----test.c-----------------------
----test.h-----------------------
int incr(int);
char* times(char,int);
----test.h-----------------------
the command I use is
ffihugs -P{Hugs}/libraries/:{Hugs}/oldlib +G +L"test.c" Test.hs
and generates Test.c and Test.so
Hugs loads correctly the module but fails one of the tests:
[vezzoli at web:883] ffi ->hugs -P{Hugs}/libraries/:{Hugs}/oldlib Test.hs
__ __ __ __ ____ ___
_________________________________________
|| || || || || || ||__ Hugs 98: Based on the Haskell 98
standard
||___|| ||__|| ||__|| __|| Copyright (c) 1994-2002
||---|| ___|| World Wide Web: http://haskell.org/hugs
|| || Report bugs to: hugs-bugs at haskell.org
|| || Version: November 2002
_________________________________________
Haskell 98 mode: Restart with command line option -98 to enable
extensions
[loading prints removed]
Test.hs
Type :? for help
Test> testIncr
2
Test> testTimes
Unexpected signal
[vezzoli at web:884] ffi ->
The C code compiles and works correctly with a stand-alone test.
Thank you in advance for any help.
Marco
--
Marco Vezzoli tel. +39 039 603 6852
STMicroelectronics fax. +39 039 603 5055
--
Marco Vezzoli tel. +39 039 603 6852
STMicroelectronics fax. +39 039 603 5055
More information about the FFI
mailing list