Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
9052b85f
Commit
9052b85f
authored
Dec 10, 2008
by
tomac@pacific.net.au
Browse files
FIX
#1364
: added tests for C finalizers.
Patch amended by Simon Marlow: - Test addForeignPtrFinalizerEnv too
parent
b3b52eac
Changes
10
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/ffi/should_run/all.T
View file @
9052b85f
...
...
@@ -127,3 +127,10 @@ test('2276_ghci', [ skip_if_not_windows, only_ways(['ghci']),
test
('
2469
',
normal
,
compile_and_run
,
['
-optc-std=gnu99
'])
test
('
2594
',
omit_ways
(['
ghci
']),
compile_and_run
,
['
2594_c.c
'])
test
('
fptr01
',
[
omit_ways
(['
ghci
']),
extra_clean
(['
fptr01_c.o
'])
],
compile_and_run
,
['
fptr01_c.c
'])
test
('
fptrfail01
',
[
compose
(
omit_ways
(['
ghci
']),
exit_code
(
1
)),
extra_clean
(['
fptrfail01_c.o
'])
],
compile_and_run
,
['
fptrfail01_c.c
'])
testsuite/tests/ghc-regress/ffi/should_run/fptr01.h
0 → 100644
View file @
9052b85f
#ifndef FPTR01_H_INCLUDED
#define FPTR01_H_INCLUDED
void
f
(
HsInt
*
);
void
g
(
HsInt
*
);
void
h
(
HsInt
*
);
void
f_env
(
HsInt
*
,
HsInt
*
);
#endif // FPTR01_H_INCLUDED
testsuite/tests/ghc-regress/ffi/should_run/fptr01.hs
0 → 100644
View file @
9052b85f
{-# LANGUAGE ForeignFunctionInterface #-}
module
Main
where
import
Foreign
{-# INCLUDE "fptr01.h" #-}
foreign
import
ccall
"&f"
fptr
::
FunPtr
(
Ptr
Int
->
IO
()
)
foreign
import
ccall
"&g"
gptr
::
FunPtr
(
Ptr
Int
->
IO
()
)
foreign
import
ccall
"&h"
hptr
::
FunPtr
(
Ptr
Int
->
IO
()
)
foreign
import
ccall
"&f_env"
fenvptr
::
FunPtr
(
Ptr
Int
->
Ptr
Int
->
IO
()
)
main
::
IO
()
main
=
do
with
(
33
::
Int
)
((
>>=
finalizeForeignPtr
)
.
test
)
with
(
34
::
Int
)
((
>>
return
()
)
.
test
)
with
(
35
::
Int
)
((
>>=
finalizeForeignPtr
)
.
test_env
)
with
(
36
::
Int
)
((
>>
return
()
)
.
test_env
)
-- finalizers must all be run at program exit.
where
-- the finalizers must be run in the correct order, starting with
-- the most recently-added.
test
p
=
do
f
<-
newForeignPtr_
p
addForeignPtrFinalizer
fptr
f
addForeignPtrFinalizer
gptr
f
addForeignPtrFinalizer
hptr
f
return
f
test_env
p
=
do
f
<-
newForeignPtr_
p
envp1
<-
new
1
envp2
<-
new
2
envp3
<-
new
3
addForeignPtrFinalizerEnv
fenvptr
envp1
f
addForeignPtrFinalizerEnv
fenvptr
envp2
f
addForeignPtrFinalizerEnv
fenvptr
envp3
f
return
f
testsuite/tests/ghc-regress/ffi/should_run/fptr01.stdout
0 → 100644
View file @
9052b85f
h33
g33
f33
f_env 3 35
f_env 2 35
f_env 1 35
f_env 3 36
f_env 2 36
f_env 1 36
h34
g34
f34
testsuite/tests/ghc-regress/ffi/should_run/fptr01_c.c
0 → 100644
View file @
9052b85f
#include <stdio.h>
#include "HsFFI.h"
#include "fptr01.h"
void
f
(
HsInt
*
i
)
{
printf
(
"f%d
\n
"
,
(
int
)
*
i
);
fflush
(
stdout
);
}
void
g
(
HsInt
*
i
)
{
printf
(
"g%d
\n
"
,
(
int
)
*
i
);
fflush
(
stdout
);
}
void
h
(
HsInt
*
i
)
{
printf
(
"h%d
\n
"
,
(
int
)
*
i
);
fflush
(
stdout
);
}
void
f_env
(
HsInt
*
env
,
HsInt
*
i
)
{
printf
(
"f_env %d %d
\n
"
,
*
env
,
(
int
)
*
i
);
fflush
(
stdout
);
}
testsuite/tests/ghc-regress/ffi/should_run/fptrfail01.h
0 → 100644
View file @
9052b85f
#ifndef FPTRFAIL01_H_INCLUDED
#define FPTRFAIL01_H_INCLUDED
void
f
(
HsInt
*
);
#endif // FPTRFAIL01_H_INCLUDED
testsuite/tests/ghc-regress/ffi/should_run/fptrfail01.hs
0 → 100644
View file @
9052b85f
{-# LANGUAGE ForeignFunctionInterface #-}
module
Main
where
import
Foreign
import
GHC.ForeignPtr
{-# INCLUDE "fptrfail01.h" #-}
foreign
import
ccall
"&f"
fptr
::
FunPtr
(
Ptr
Int
->
IO
()
)
main
::
IO
()
main
=
do
with
(
33
::
Int
)
test
where
test
p
=
do
f
<-
newForeignPtr_
p
addForeignPtrFinalizer
fptr
f
addForeignPtrConcFinalizer
f
(
putStrLn
"Haskell finalizer"
)
testsuite/tests/ghc-regress/ffi/should_run/fptrfail01.stderr
0 → 100644
View file @
9052b85f
fptrfail01: GHC.ForeignPtr: attempt to mix Haskell and C finalizers in the same ForeignPtr
testsuite/tests/ghc-regress/ffi/should_run/fptrfail01.stdout
0 → 100644
View file @
9052b85f
f33
testsuite/tests/ghc-regress/ffi/should_run/fptrfail01_c.c
0 → 100644
View file @
9052b85f
#include <stdio.h>
#include "HsFFI.h"
#include "fptrfail01.h"
void
f
(
HsInt
*
i
)
{
printf
(
"f%d
\n
"
,
(
int
)
*
i
);
fflush
(
stdout
);
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment