basis/alien/fortran/fortran-tests.factor

   1 ! (c) 2009 Joe Groff, see BSD license
   2 USING: accessors alien alien.c-types alien.complex
   3 alien.fortran alien.fortran.private alien.strings classes.struct
   4 arrays assocs byte-arrays combinators fry
   5 generalizations io.encodings.ascii kernel macros
   6 macros.expander namespaces sequences shuffle tools.test ;
   7 IN: alien.fortran.tests
   8
   9 << intel-unix-abi "(alien.fortran-tests)" (add-fortran-library) >>
  10 LIBRARY: (alien.fortran-tests)
  11 STRUCT: FORTRAN_TEST_RECORD
  12     { FOO int }
  13     { BAR double[2] }
  14     { BAS char[4] } ;
  15
  16 intel-unix-abi fortran-abi [
  17
  18     ! fortran-name>symbol-name
  19
  20     [ "fun_" ] [ "FUN" fortran-name>symbol-name ] unit-test
  21     [ "fun_times_" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
  22     [ "funtimes__" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
  23
  24     ! fortran-type>c-type
  25
  26     [ "short" ]
  27     [ "integer*2" fortran-type>c-type ] unit-test
  28
  29     [ "int" ]
  30     [ "integer*4" fortran-type>c-type ] unit-test
  31
  32     [ "int" ]
  33     [ "INTEGER" fortran-type>c-type ] unit-test
  34
  35     [ "longlong" ]
  36     [ "iNteger*8" fortran-type>c-type ] unit-test
  37
  38     [ "int[0]" ]
  39     [ "integer(*)" fortran-type>c-type ] unit-test
  40
  41     [ "int[0]" ]
  42     [ "integer(3,*)" fortran-type>c-type ] unit-test
  43
  44     [ "int[3]" ]
  45     [ "integer(3)" fortran-type>c-type ] unit-test
  46
  47     [ "int[6]" ]
  48     [ "integer(3,2)" fortran-type>c-type ] unit-test
  49
  50     [ "int[24]" ]
  51     [ "integer(4,3,2)" fortran-type>c-type ] unit-test
  52
  53     [ "char" ]
  54     [ "character" fortran-type>c-type ] unit-test
  55
  56     [ "char" ]
  57     [ "character*1" fortran-type>c-type ] unit-test
  58
  59     [ "char[17]" ]
  60     [ "character*17" fortran-type>c-type ] unit-test
  61
  62     [ "char[17]" ]
  63     [ "character(17)" fortran-type>c-type ] unit-test
  64
  65     [ "int" ]
  66     [ "logical" fortran-type>c-type ] unit-test
  67
  68     [ "float" ]
  69     [ "real" fortran-type>c-type ] unit-test
  70
  71     [ "double" ]
  72     [ "double-precision" fortran-type>c-type ] unit-test
  73
  74     [ "float" ]
  75     [ "real*4" fortran-type>c-type ] unit-test
  76
  77     [ "double" ]
  78     [ "real*8" fortran-type>c-type ] unit-test
  79
  80     [ "complex-float" ]
  81     [ "complex" fortran-type>c-type ] unit-test
  82
  83     [ "complex-double" ]
  84     [ "double-complex" fortran-type>c-type ] unit-test
  85
  86     [ "complex-float" ]
  87     [ "complex*8" fortran-type>c-type ] unit-test
  88
  89     [ "complex-double" ]
  90     [ "complex*16" fortran-type>c-type ] unit-test
  91
  92     [ "fortran_test_record" ]
  93     [ "fortran_test_record" fortran-type>c-type ] unit-test
  94
  95     ! fortran-arg-type>c-type
  96
  97     [ "int*" { } ]
  98     [ "integer" fortran-arg-type>c-type ] unit-test
  99
 100     [ "int*" { } ]
 101     [ "integer(3)" fortran-arg-type>c-type ] unit-test
 102
 103     [ "int*" { } ]
 104     [ "integer(*)" fortran-arg-type>c-type ] unit-test
 105
 106     [ "fortran_test_record*" { } ]
 107     [ "fortran_test_record" fortran-arg-type>c-type ] unit-test
 108
 109     [ "char*" { } ]
 110     [ "character" fortran-arg-type>c-type ] unit-test
 111
 112     [ "char*" { } ]
 113     [ "character(1)" fortran-arg-type>c-type ] unit-test
 114
 115     [ "char*" { "long" } ]
 116     [ "character(17)" fortran-arg-type>c-type ] unit-test
 117
 118     ! fortran-ret-type>c-type
 119
 120     [ "char" { } ]
 121     [ "character(1)" fortran-ret-type>c-type ] unit-test
 122
 123     [ "void" { "char*" "long" } ]
 124     [ "character(17)" fortran-ret-type>c-type ] unit-test
 125
 126     [ "int" { } ]
 127     [ "integer" fortran-ret-type>c-type ] unit-test
 128
 129     [ "int" { } ]
 130     [ "logical" fortran-ret-type>c-type ] unit-test
 131
 132     [ "float" { } ]
 133     [ "real" fortran-ret-type>c-type ] unit-test
 134
 135     [ "void" { "float*" } ]
 136     [ "real(*)" fortran-ret-type>c-type ] unit-test
 137
 138     [ "double" { } ]
 139     [ "double-precision" fortran-ret-type>c-type ] unit-test
 140
 141     [ "void" { "complex-float*" } ]
 142     [ "complex" fortran-ret-type>c-type ] unit-test
 143
 144     [ "void" { "complex-double*" } ]
 145     [ "double-complex" fortran-ret-type>c-type ] unit-test
 146
 147     [ "void" { "int*" } ]
 148     [ "integer(*)" fortran-ret-type>c-type ] unit-test
 149
 150     [ "void" { "fortran_test_record*" } ]
 151     [ "fortran_test_record" fortran-ret-type>c-type ] unit-test
 152
 153     ! fortran-sig>c-sig
 154
 155     [ "float" { "int*" "char*" "float*" "double*" "long" } ]
 156     [ "real" { "integer" "character*17" "real" "real*8" } fortran-sig>c-sig ]
 157     unit-test
 158
 159     [ "char" { "char*" "char*" "int*" "long" } ]
 160     [ "character(1)" { "character*17" "character" "integer" } fortran-sig>c-sig ]
 161     unit-test
 162
 163     [ "void" { "char*" "long" "char*" "char*" "int*" "long" } ]
 164     [ "character*18" { "character*17" "character" "integer" } fortran-sig>c-sig ]
 165     unit-test
 166
 167     [ "void" { "complex-float*" "char*" "char*" "int*" "long" } ]
 168     [ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
 169     unit-test
 170
 171     ! (fortran-invoke)
 172
 173     [ [
 174         ! [fortran-args>c-args]
 175         {
 176             [ {
 177                 [ ascii string>alien ]
 178                 [ <longlong> ]
 179                 [ <float> ]
 180                 [ <complex-float> ]
 181                 [ 1 0 ? <short> ]
 182             } spread ]
 183             [ { [ length ] [ drop ] [ drop ] [ drop ] [ drop ] } spread ]
 184         } 5 ncleave
 185         ! [fortran-invoke]
 186         [
 187             "void" "funpack" "funtimes_"
 188             { "char*" "longlong*" "float*" "complex-float*" "short*" "long" }
 189             alien-invoke
 190         ] 6 nkeep
 191         ! [fortran-results>]
 192         shuffle( aa ba ca da ea ab -- aa ab ba ca da ea )
 193         {
 194             [ drop ]
 195             [ drop ]
 196             [ drop ]
 197             [ *float ]
 198             [ drop ]
 199             [ drop ]
 200         } spread
 201     ] ] [
 202         f "funpack" "FUNTIMES" { "CHARACTER*12" "INTEGER*8" "!REAL" "COMPLEX" "LOGICAL*2" }
 203         (fortran-invoke)
 204     ] unit-test
 205
 206     [ [
 207         ! [fortran-args>c-args]
 208         {
 209             [ { [ ] } spread ]
 210             [ { [ drop ] } spread ]
 211         } 1 ncleave
 212         ! [fortran-invoke]
 213         [ "float" "funpack" "fun_times_" { "float*" } alien-invoke ]
 214         1 nkeep
 215         ! [fortran-results>]
 216         shuffle( reta aa -- reta aa )
 217         { [ ] [ drop ] } spread
 218     ] ] [
 219         "REAL" "funpack" "FUN_TIMES" { "REAL(*)" }
 220         (fortran-invoke)
 221     ] unit-test
 222
 223     [ [
 224         ! [<fortran-result>]
 225         [ "complex-float" <c-object> ] 1 ndip
 226         ! [fortran-args>c-args]
 227         { [ { [ ] } spread ] [ { [ drop ] } spread ] } 1 ncleave
 228         ! [fortran-invoke]
 229         [
 230             "void" "funpack" "fun_times_"
 231             { "complex-float*" "float*" }
 232             alien-invoke
 233         ] 2 nkeep
 234         ! [fortran-results>]
 235         shuffle( reta aa -- reta aa )
 236         { [ *complex-float ] [ drop ] } spread
 237     ] ] [
 238         "COMPLEX" "funpack" "FUN_TIMES" { "REAL(*)" }
 239         (fortran-invoke)
 240     ] unit-test
 241
 242     [ [
 243         ! [<fortran-result>]
 244         [ 20 <byte-array> 20 ] 0 ndip
 245         ! [fortran-invoke]
 246         [
 247             "void" "funpack" "fun_times_"
 248             { "char*" "long" }
 249             alien-invoke
 250         ] 2 nkeep
 251         ! [fortran-results>]
 252         shuffle( reta retb -- reta retb )
 253         { [ ] [ ascii alien>nstring ] } spread
 254     ] ] [
 255         "CHARACTER*20" "funpack" "FUN_TIMES" { }
 256         (fortran-invoke)
 257     ] unit-test
 258
 259     [ [
 260         ! [<fortran-result>]
 261         [ 10 <byte-array> 10 ] 3 ndip
 262         ! [fortran-args>c-args]
 263         {
 264             [ {
 265                 [ ascii string>alien ]
 266                 [ <float> ]
 267                 [ ascii string>alien ]
 268             } spread ]
 269             [ { [ length ] [ drop ] [ length ] } spread ]
 270         } 3 ncleave
 271         ! [fortran-invoke]
 272         [
 273             "void" "funpack" "fun_times_"
 274             { "char*" "long" "char*" "float*" "char*" "long" "long" }
 275             alien-invoke
 276         ] 7 nkeep
 277         ! [fortran-results>]
 278         shuffle( reta retb aa ba ca ab cb -- reta retb aa ab ba ca cb )
 279         {
 280             [ ]
 281             [ ascii alien>nstring ]
 282             [ ]
 283             [ ascii alien>nstring ]
 284             [ *float ]
 285             [ ]
 286             [ ascii alien>nstring ]
 287         } spread
 288     ] ] [
 289         "CHARACTER*10" "funpack" "FUN_TIMES" { "!CHARACTER*20" "!REAL" "!CHARACTER*30" }
 290         (fortran-invoke)
 291     ] unit-test
 292
 293 ] with-variable ! intel-unix-abi
 294
 295 intel-windows-abi fortran-abi [
 296
 297     [ "FUN" ] [ "FUN" fortran-name>symbol-name ] unit-test
 298     [ "FUN_TIMES" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
 299     [ "FUNTIMES_" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
 300
 301 ] with-variable
 302
 303 f2c-abi fortran-abi [
 304
 305     [ "char[1]" ]
 306     [ "character(1)" fortran-type>c-type ] unit-test
 307
 308     [ "char*" { "long" } ]
 309     [ "character" fortran-arg-type>c-type ] unit-test
 310
 311     [ "void" { "char*" "long" } ]
 312     [ "character" fortran-ret-type>c-type ] unit-test
 313
 314     [ "double" { } ]
 315     [ "real" fortran-ret-type>c-type ] unit-test
 316
 317     [ "void" { "float*" } ]
 318     [ "real(*)" fortran-ret-type>c-type ] unit-test
 319
 320     [ "fun_" ] [ "FUN" fortran-name>symbol-name ] unit-test
 321     [ "fun_times__" ] [ "Fun_Times" fortran-name>symbol-name ] unit-test
 322     [ "funtimes___" ] [ "FunTimes_" fortran-name>symbol-name ] unit-test
 323
 324 ] with-variable
 325
 326 gfortran-abi fortran-abi [
 327
 328     [ "float" { } ]
 329     [ "real" fortran-ret-type>c-type ] unit-test
 330
 331     [ "void" { "float*" } ]
 332     [ "real(*)" fortran-ret-type>c-type ] unit-test
 333
 334     [ "complex-float" { } ]
 335     [ "complex" fortran-ret-type>c-type ] unit-test
 336
 337     [ "complex-double" { } ]
 338     [ "double-complex" fortran-ret-type>c-type ] unit-test
 339
 340     [ "char[1]" ]
 341     [ "character(1)" fortran-type>c-type ] unit-test
 342
 343     [ "char*" { "long" } ]
 344     [ "character" fortran-arg-type>c-type ] unit-test
 345
 346     [ "void" { "char*" "long" } ]
 347     [ "character" fortran-ret-type>c-type ] unit-test
 348
 349     [ "complex-float" { } ]
 350     [ "complex" fortran-ret-type>c-type ] unit-test
 351
 352     [ "complex-double" { } ]
 353     [ "double-complex" fortran-ret-type>c-type ] unit-test
 354
 355     [ "void" { "complex-double*" } ]
 356     [ "double-complex(3)" fortran-ret-type>c-type ] unit-test
 357
 358 ] with-variable