382 lines
10 KiB
Factor
382 lines
10 KiB
Factor
! (c) 2009 Joe Groff, see BSD license
|
|
USING: accessors alien alien.c-types alien.complex
|
|
alien.fortran alien.fortran.private alien.strings alien.structs
|
|
arrays assocs byte-arrays combinators fry
|
|
generalizations io.encodings.ascii kernel macros
|
|
macros.expander namespaces sequences shuffle tools.test ;
|
|
IN: alien.fortran.tests
|
|
|
|
<< intel-unix-abi "(alien.fortran-tests)" (add-fortran-library) >>
|
|
LIBRARY: (alien.fortran-tests)
|
|
RECORD: FORTRAN_TEST_RECORD
|
|
{ "INTEGER" "FOO" }
|
|
{ "REAL(2)" "BAR" }
|
|
{ "CHARACTER*4" "BAS" } ;
|
|
|
|
intel-unix-abi fortran-abi [
|
|
|
|
! fortran-name>symbol-name
|
|
|
|
[ "fun_" ] [ "FUN" fortran-name>symbol-name ] unit-test
|
|
[ "fun_times_" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
|
|
[ "funtimes__" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
|
|
|
|
! fortran-type>c-type
|
|
|
|
[ "short" ]
|
|
[ "integer*2" fortran-type>c-type ] unit-test
|
|
|
|
[ "int" ]
|
|
[ "integer*4" fortran-type>c-type ] unit-test
|
|
|
|
[ "int" ]
|
|
[ "INTEGER" fortran-type>c-type ] unit-test
|
|
|
|
[ "longlong" ]
|
|
[ "iNteger*8" fortran-type>c-type ] unit-test
|
|
|
|
[ "int[0]" ]
|
|
[ "integer(*)" fortran-type>c-type ] unit-test
|
|
|
|
[ "int[0]" ]
|
|
[ "integer(3,*)" fortran-type>c-type ] unit-test
|
|
|
|
[ "int[3]" ]
|
|
[ "integer(3)" fortran-type>c-type ] unit-test
|
|
|
|
[ "int[6]" ]
|
|
[ "integer(3,2)" fortran-type>c-type ] unit-test
|
|
|
|
[ "int[24]" ]
|
|
[ "integer(4,3,2)" fortran-type>c-type ] unit-test
|
|
|
|
[ "char" ]
|
|
[ "character" fortran-type>c-type ] unit-test
|
|
|
|
[ "char" ]
|
|
[ "character*1" fortran-type>c-type ] unit-test
|
|
|
|
[ "char[17]" ]
|
|
[ "character*17" fortran-type>c-type ] unit-test
|
|
|
|
[ "char[17]" ]
|
|
[ "character(17)" fortran-type>c-type ] unit-test
|
|
|
|
[ "int" ]
|
|
[ "logical" fortran-type>c-type ] unit-test
|
|
|
|
[ "float" ]
|
|
[ "real" fortran-type>c-type ] unit-test
|
|
|
|
[ "double" ]
|
|
[ "double-precision" fortran-type>c-type ] unit-test
|
|
|
|
[ "float" ]
|
|
[ "real*4" fortran-type>c-type ] unit-test
|
|
|
|
[ "double" ]
|
|
[ "real*8" fortran-type>c-type ] unit-test
|
|
|
|
[ "complex-float" ]
|
|
[ "complex" fortran-type>c-type ] unit-test
|
|
|
|
[ "complex-double" ]
|
|
[ "double-complex" fortran-type>c-type ] unit-test
|
|
|
|
[ "complex-float" ]
|
|
[ "complex*8" fortran-type>c-type ] unit-test
|
|
|
|
[ "complex-double" ]
|
|
[ "complex*16" fortran-type>c-type ] unit-test
|
|
|
|
[ "fortran_test_record" ]
|
|
[ "fortran_test_record" fortran-type>c-type ] unit-test
|
|
|
|
! fortran-arg-type>c-type
|
|
|
|
[ "int*" { } ]
|
|
[ "integer" fortran-arg-type>c-type ] unit-test
|
|
|
|
[ "int*" { } ]
|
|
[ "integer(3)" fortran-arg-type>c-type ] unit-test
|
|
|
|
[ "int*" { } ]
|
|
[ "integer(*)" fortran-arg-type>c-type ] unit-test
|
|
|
|
[ "fortran_test_record*" { } ]
|
|
[ "fortran_test_record" fortran-arg-type>c-type ] unit-test
|
|
|
|
[ "char*" { } ]
|
|
[ "character" fortran-arg-type>c-type ] unit-test
|
|
|
|
[ "char*" { } ]
|
|
[ "character(1)" fortran-arg-type>c-type ] unit-test
|
|
|
|
[ "char*" { "long" } ]
|
|
[ "character(17)" fortran-arg-type>c-type ] unit-test
|
|
|
|
! fortran-ret-type>c-type
|
|
|
|
[ "char" { } ]
|
|
[ "character(1)" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "char*" "long" } ]
|
|
[ "character(17)" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "int" { } ]
|
|
[ "integer" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "int" { } ]
|
|
[ "logical" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "float" { } ]
|
|
[ "real" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "float*" } ]
|
|
[ "real(*)" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "double" { } ]
|
|
[ "double-precision" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "complex-float*" } ]
|
|
[ "complex" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "complex-double*" } ]
|
|
[ "double-complex" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "int*" } ]
|
|
[ "integer(*)" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "fortran_test_record*" } ]
|
|
[ "fortran_test_record" fortran-ret-type>c-type ] unit-test
|
|
|
|
! fortran-sig>c-sig
|
|
|
|
[ "float" { "int*" "char*" "float*" "double*" "long" } ]
|
|
[ "real" { "integer" "character*17" "real" "real*8" } fortran-sig>c-sig ]
|
|
unit-test
|
|
|
|
[ "char" { "char*" "char*" "int*" "long" } ]
|
|
[ "character(1)" { "character*17" "character" "integer" } fortran-sig>c-sig ]
|
|
unit-test
|
|
|
|
[ "void" { "char*" "long" "char*" "char*" "int*" "long" } ]
|
|
[ "character*18" { "character*17" "character" "integer" } fortran-sig>c-sig ]
|
|
unit-test
|
|
|
|
[ "void" { "complex-float*" "char*" "char*" "int*" "long" } ]
|
|
[ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
|
|
unit-test
|
|
|
|
! fortran-record>c-struct
|
|
|
|
[ {
|
|
{ "double" "ex" }
|
|
{ "float" "wye" }
|
|
{ "int" "zee" }
|
|
{ "char[20]" "woo" }
|
|
} ] [
|
|
{
|
|
{ "DOUBLE-PRECISION" "EX" }
|
|
{ "REAL" "WYE" }
|
|
{ "INTEGER" "ZEE" }
|
|
{ "CHARACTER(20)" "WOO" }
|
|
} fortran-record>c-struct
|
|
] unit-test
|
|
|
|
! RECORD:
|
|
|
|
[ 16 ] [ "fortran_test_record" heap-size ] unit-test
|
|
[ 0 ] [ "foo" "fortran_test_record" offset-of ] unit-test
|
|
[ 4 ] [ "bar" "fortran_test_record" offset-of ] unit-test
|
|
[ 12 ] [ "bas" "fortran_test_record" offset-of ] unit-test
|
|
|
|
! (fortran-invoke)
|
|
|
|
[ [
|
|
! [fortran-args>c-args]
|
|
{
|
|
[ {
|
|
[ ascii string>alien ]
|
|
[ <longlong> ]
|
|
[ <float> ]
|
|
[ <complex-float> ]
|
|
[ 1 0 ? <short> ]
|
|
} spread ]
|
|
[ { [ length ] [ drop ] [ drop ] [ drop ] [ drop ] } spread ]
|
|
} 5 ncleave
|
|
! [fortran-invoke]
|
|
[
|
|
"void" "funpack" "funtimes_"
|
|
{ "char*" "longlong*" "float*" "complex-float*" "short*" "long" }
|
|
alien-invoke
|
|
] 6 nkeep
|
|
! [fortran-results>]
|
|
shuffle( aa ba ca da ea ab -- aa ab ba ca da ea )
|
|
{
|
|
[ drop ]
|
|
[ drop ]
|
|
[ drop ]
|
|
[ *float ]
|
|
[ drop ]
|
|
[ drop ]
|
|
} spread
|
|
] ] [
|
|
f "funpack" "FUNTIMES" { "CHARACTER*12" "INTEGER*8" "!REAL" "COMPLEX" "LOGICAL*2" }
|
|
(fortran-invoke)
|
|
] unit-test
|
|
|
|
[ [
|
|
! [fortran-args>c-args]
|
|
{
|
|
[ { [ ] } spread ]
|
|
[ { [ drop ] } spread ]
|
|
} 1 ncleave
|
|
! [fortran-invoke]
|
|
[ "float" "funpack" "fun_times_" { "float*" } alien-invoke ]
|
|
1 nkeep
|
|
! [fortran-results>]
|
|
shuffle( reta aa -- reta aa )
|
|
{ [ ] [ drop ] } spread
|
|
] ] [
|
|
"REAL" "funpack" "FUN_TIMES" { "REAL(*)" }
|
|
(fortran-invoke)
|
|
] unit-test
|
|
|
|
[ [
|
|
! [<fortran-result>]
|
|
[ "complex-float" <c-object> ] 1 ndip
|
|
! [fortran-args>c-args]
|
|
{ [ { [ ] } spread ] [ { [ drop ] } spread ] } 1 ncleave
|
|
! [fortran-invoke]
|
|
[
|
|
"void" "funpack" "fun_times_"
|
|
{ "complex-float*" "float*" }
|
|
alien-invoke
|
|
] 2 nkeep
|
|
! [fortran-results>]
|
|
shuffle( reta aa -- reta aa )
|
|
{ [ *complex-float ] [ drop ] } spread
|
|
] ] [
|
|
"COMPLEX" "funpack" "FUN_TIMES" { "REAL(*)" }
|
|
(fortran-invoke)
|
|
] unit-test
|
|
|
|
[ [
|
|
! [<fortran-result>]
|
|
[ 20 <byte-array> 20 ] 0 ndip
|
|
! [fortran-invoke]
|
|
[
|
|
"void" "funpack" "fun_times_"
|
|
{ "char*" "long" }
|
|
alien-invoke
|
|
] 2 nkeep
|
|
! [fortran-results>]
|
|
shuffle( reta retb -- reta retb )
|
|
{ [ ] [ ascii alien>nstring ] } spread
|
|
] ] [
|
|
"CHARACTER*20" "funpack" "FUN_TIMES" { }
|
|
(fortran-invoke)
|
|
] unit-test
|
|
|
|
[ [
|
|
! [<fortran-result>]
|
|
[ 10 <byte-array> 10 ] 3 ndip
|
|
! [fortran-args>c-args]
|
|
{
|
|
[ {
|
|
[ ascii string>alien ]
|
|
[ <float> ]
|
|
[ ascii string>alien ]
|
|
} spread ]
|
|
[ { [ length ] [ drop ] [ length ] } spread ]
|
|
} 3 ncleave
|
|
! [fortran-invoke]
|
|
[
|
|
"void" "funpack" "fun_times_"
|
|
{ "char*" "long" "char*" "float*" "char*" "long" "long" }
|
|
alien-invoke
|
|
] 7 nkeep
|
|
! [fortran-results>]
|
|
shuffle( reta retb aa ba ca ab cb -- reta retb aa ab ba ca cb )
|
|
{
|
|
[ ]
|
|
[ ascii alien>nstring ]
|
|
[ ]
|
|
[ ascii alien>nstring ]
|
|
[ *float ]
|
|
[ ]
|
|
[ ascii alien>nstring ]
|
|
} spread
|
|
] ] [
|
|
"CHARACTER*10" "funpack" "FUN_TIMES" { "!CHARACTER*20" "!REAL" "!CHARACTER*30" }
|
|
(fortran-invoke)
|
|
] unit-test
|
|
|
|
] with-variable ! intel-unix-abi
|
|
|
|
intel-windows-abi fortran-abi [
|
|
|
|
[ "FUN" ] [ "FUN" fortran-name>symbol-name ] unit-test
|
|
[ "FUN_TIMES" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
|
|
[ "FUNTIMES_" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
|
|
|
|
] with-variable
|
|
|
|
f2c-abi fortran-abi [
|
|
|
|
[ "char[1]" ]
|
|
[ "character(1)" fortran-type>c-type ] unit-test
|
|
|
|
[ "char*" { "long" } ]
|
|
[ "character" fortran-arg-type>c-type ] unit-test
|
|
|
|
[ "void" { "char*" "long" } ]
|
|
[ "character" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "double" { } ]
|
|
[ "real" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "float*" } ]
|
|
[ "real(*)" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "fun_" ] [ "FUN" fortran-name>symbol-name ] unit-test
|
|
[ "fun_times__" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
|
|
[ "funtimes___" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
|
|
|
|
] with-variable
|
|
|
|
gfortran-abi fortran-abi [
|
|
|
|
[ "float" { } ]
|
|
[ "real" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "float*" } ]
|
|
[ "real(*)" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "complex-float" { } ]
|
|
[ "complex" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "complex-double" { } ]
|
|
[ "double-complex" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "char[1]" ]
|
|
[ "character(1)" fortran-type>c-type ] unit-test
|
|
|
|
[ "char*" { "long" } ]
|
|
[ "character" fortran-arg-type>c-type ] unit-test
|
|
|
|
[ "void" { "char*" "long" } ]
|
|
[ "character" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "complex-float" { } ]
|
|
[ "complex" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "complex-double" { } ]
|
|
[ "double-complex" fortran-ret-type>c-type ] unit-test
|
|
|
|
[ "void" { "complex-double*" } ]
|
|
[ "double-complex(3)" fortran-ret-type>c-type ] unit-test
|
|
|
|
] with-variable
|