1 ! (c) 2009 Joe Groff, see BSD license
2 USING: accessors alien alien.c-types alien.complex
3 alien.data alien.fortran alien.fortran.private alien.strings
4 classes.struct arrays assocs byte-arrays combinators fry
5 generalizations io.encodings.ascii kernel macros
6 macros.expander namespaces sequences shuffle tools.test vocabs.parser ;
7 FROM: alien.syntax => pointer: ;
8 QUALIFIED-WITH: alien.c-types c
9 IN: alien.fortran.tests
11 << intel-unix-abi "(alien.fortran-tests)" (add-fortran-library) >>
12 LIBRARY: (alien.fortran-tests)
13 STRUCT: fortran_test_record
18 intel-unix-abi fortran-abi [
20 ! fortran-name>symbol-name
22 [ "fun_" ] [ "FUN" fortran-name>symbol-name ] unit-test
23 [ "fun_times_" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
24 [ "funtimes__" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
29 [ "integer*2" fortran-type>c-type ] unit-test
32 [ "integer*4" fortran-type>c-type ] unit-test
35 [ "INTEGER" fortran-type>c-type ] unit-test
38 [ "iNteger*8" fortran-type>c-type ] unit-test
41 [ "integer(*)" fortran-type>c-type ] unit-test
44 [ "integer(3,*)" fortran-type>c-type ] unit-test
47 [ "integer(3)" fortran-type>c-type ] unit-test
50 [ "integer(3,2)" fortran-type>c-type ] unit-test
53 [ "integer(4,3,2)" fortran-type>c-type ] unit-test
56 [ "character" fortran-type>c-type ] unit-test
59 [ "character*1" fortran-type>c-type ] unit-test
62 [ "character*17" fortran-type>c-type ] unit-test
65 [ "character(17)" fortran-type>c-type ] unit-test
68 [ "logical" fortran-type>c-type ] unit-test
71 [ "real" fortran-type>c-type ] unit-test
74 [ "double-precision" fortran-type>c-type ] unit-test
77 [ "real*4" fortran-type>c-type ] unit-test
80 [ "real*8" fortran-type>c-type ] unit-test
83 [ "complex" fortran-type>c-type ] unit-test
86 [ "double-complex" fortran-type>c-type ] unit-test
89 [ "complex*8" fortran-type>c-type ] unit-test
92 [ "complex*16" fortran-type>c-type ] unit-test
94 [ fortran_test_record ]
97 "alien.fortran.tests" use-vocab
98 "fortran_test_record" fortran-type>c-type
102 ! fortran-arg-type>c-type
104 [ pointer: c:int { } ]
105 [ "integer" fortran-arg-type>c-type ] unit-test
107 [ pointer: { c:int 3 } { } ]
108 [ "integer(3)" fortran-arg-type>c-type ] unit-test
110 [ pointer: { c:int 0 } { } ]
111 [ "integer(*)" fortran-arg-type>c-type ] unit-test
113 [ pointer: fortran_test_record { } ]
116 "alien.fortran.tests" use-vocab
117 "fortran_test_record" fortran-arg-type>c-type
121 [ pointer: c:char { } ]
122 [ "character" fortran-arg-type>c-type ] unit-test
124 [ pointer: c:char { } ]
125 [ "character(1)" fortran-arg-type>c-type ] unit-test
127 [ pointer: { c:char 17 } { long } ]
128 [ "character(17)" fortran-arg-type>c-type ] unit-test
130 ! fortran-ret-type>c-type
133 [ "character(1)" fortran-ret-type>c-type ] unit-test
135 [ c:void { pointer: { c:char 17 } long } ]
136 [ "character(17)" fortran-ret-type>c-type ] unit-test
139 [ "integer" fortran-ret-type>c-type ] unit-test
142 [ "logical" fortran-ret-type>c-type ] unit-test
145 [ "real" fortran-ret-type>c-type ] unit-test
147 [ c:void { pointer: { c:float 0 } } ]
148 [ "real(*)" fortran-ret-type>c-type ] unit-test
151 [ "double-precision" fortran-ret-type>c-type ] unit-test
153 [ c:void { pointer: complex-float } ]
154 [ "complex" fortran-ret-type>c-type ] unit-test
156 [ c:void { pointer: complex-double } ]
157 [ "double-complex" fortran-ret-type>c-type ] unit-test
159 [ c:void { pointer: { c:int 0 } } ]
160 [ "integer(*)" fortran-ret-type>c-type ] unit-test
162 [ c:void { pointer: fortran_test_record } ]
165 "alien.fortran.tests" use-vocab
166 "fortran_test_record" fortran-ret-type>c-type
172 [ c:float { pointer: c:int pointer: { c:char 17 } pointer: c:float pointer: c:double c:long } ]
173 [ "real" { "integer" "character*17" "real" "real*8" } fortran-sig>c-sig ]
176 [ c:char { pointer: { c:char 17 } pointer: c:char pointer: c:int c:long } ]
177 [ "character(1)" { "character*17" "character" "integer" } fortran-sig>c-sig ]
180 [ c:void { pointer: { c:char 18 } c:long pointer: { c:char 17 } pointer: c:char pointer: c:int c:long } ]
181 [ "character*18" { "character*17" "character" "integer" } fortran-sig>c-sig ]
184 [ c:void { pointer: complex-float pointer: { c:char 17 } pointer: c:char pointer: c:int c:long } ]
185 [ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
191 ! [fortran-args>c-args]
194 [ ascii string>alien ]
198 [ 1 0 ? c:short <ref> ]
200 [ { [ length ] [ drop ] [ drop ] [ drop ] [ drop ] } spread ]
204 c:void "funpack" "funtimes_"
205 { pointer: { c:char 12 } pointer: c:longlong pointer: c:float pointer: complex-float pointer: c:short c:long } f
209 shuffle( aa ba ca da ea ab -- aa ab ba ca da ea )
219 f "funpack" "FUNTIMES" { "CHARACTER*12" "INTEGER*8" "!REAL" "COMPLEX" "LOGICAL*2" }
224 ! [fortran-args>c-args]
227 [ { [ drop ] } spread ]
230 [ c:float "funpack" "fun_times_" { pointer: { c:float 0 } } f alien-invoke ]
233 shuffle( reta aa -- reta aa )
234 { [ ] [ drop ] } spread
236 "REAL" "funpack" "FUN_TIMES" { "REAL(*)" }
242 [ complex-float heap-size <byte-array> ] 1 ndip
243 ! [fortran-args>c-args]
244 { [ { [ ] } spread ] [ { [ drop ] } spread ] } 1 ncleave
247 c:void "funpack" "fun_times_"
248 { pointer: complex-float pointer: { c:float 0 } } f
252 shuffle( reta aa -- reta aa )
253 { [ *complex-float ] [ drop ] } spread
255 "COMPLEX" "funpack" "FUN_TIMES" { "REAL(*)" }
261 [ 20 <byte-array> 20 ] 0 ndip
264 c:void "funpack" "fun_times_"
265 { pointer: { c:char 20 } long } f
269 shuffle( reta retb -- reta retb )
270 { [ ] [ ascii alien>nstring ] } spread
272 "CHARACTER*20" "funpack" "FUN_TIMES" { }
278 [ 10 <byte-array> 10 ] 3 ndip
279 ! [fortran-args>c-args]
282 [ ascii string>alien ]
284 [ ascii string>alien ]
286 [ { [ length ] [ drop ] [ length ] } spread ]
290 c:void "funpack" "fun_times_"
291 { pointer: { c:char 10 } long pointer: { c:char 20 } pointer: c:float pointer: { c:char 30 } c:long c:long } f
295 shuffle( reta retb aa ba ca ab cb -- reta retb aa ab ba ca cb )
298 [ ascii alien>nstring ]
300 [ ascii alien>nstring ]
303 [ ascii alien>nstring ]
306 "CHARACTER*10" "funpack" "FUN_TIMES" { "!CHARACTER*20" "!REAL" "!CHARACTER*30" }
310 ] with-variable ! intel-unix-abi
312 intel-windows-abi fortran-abi [
314 [ "FUN" ] [ "FUN" fortran-name>symbol-name ] unit-test
315 [ "FUN_TIMES" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
316 [ "FUNTIMES_" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
320 f2c-abi fortran-abi [
323 [ "character(1)" fortran-type>c-type ] unit-test
325 [ pointer: c:char { c:long } ]
326 [ "character" fortran-arg-type>c-type ] unit-test
328 [ c:void { pointer: c:char c:long } ]
329 [ "character" fortran-ret-type>c-type ] unit-test
332 [ "real" fortran-ret-type>c-type ] unit-test
334 [ c:void { pointer: { c:float 0 } } ]
335 [ "real(*)" fortran-ret-type>c-type ] unit-test
337 [ "fun_" ] [ "FUN" fortran-name>symbol-name ] unit-test
338 [ "fun_times__" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
339 [ "funtimes___" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
343 gfortran-abi fortran-abi [
346 [ "real" fortran-ret-type>c-type ] unit-test
348 [ c:void { pointer: { c:float 0 } } ]
349 [ "real(*)" fortran-ret-type>c-type ] unit-test
351 [ complex-float { } ]
352 [ "complex" fortran-ret-type>c-type ] unit-test
354 [ complex-double { } ]
355 [ "double-complex" fortran-ret-type>c-type ] unit-test
358 [ "character(1)" fortran-type>c-type ] unit-test
360 [ pointer: c:char { c:long } ]
361 [ "character" fortran-arg-type>c-type ] unit-test
363 [ c:void { pointer: c:char c:long } ]
364 [ "character" fortran-ret-type>c-type ] unit-test
366 [ complex-float { } ]
367 [ "complex" fortran-ret-type>c-type ] unit-test
369 [ complex-double { } ]
370 [ "double-complex" fortran-ret-type>c-type ] unit-test
372 [ c:void { pointer: { complex-double 3 } } ]
373 [ "double-complex(3)" fortran-ret-type>c-type ] unit-test