steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

gfortran returns float for REAL functions, not double like f2c

db4
Joe Groff 2009-02-09 16:36:46 -06:00
parent 08b02fadc9
commit ebdd135d62
2 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/alien/fortran/fortran-tests.factor
View File

@ -116,7 +116,7 @@ RECORD: FORTRAN_TEST_RECORD
[ "int" { } ] [ "int" { } ]
[ "logical" fortran-ret-type>c-type ] unit-test [ "logical" fortran-ret-type>c-type ] unit-test
[ "double" { } ] [ "float" { } ]
[ "real" fortran-ret-type>c-type ] unit-test [ "real" fortran-ret-type>c-type ] unit-test
[ "double" { } ] [ "double" { } ]
@ -136,7 +136,7 @@ RECORD: FORTRAN_TEST_RECORD
! fortran-sig>c-sig ! fortran-sig>c-sig
[ "double" { "int*" "char*" "float*" "double*" "long" } ] [ "float" { "int*" "char*" "float*" "double*" "long" } ]
[ "real" { "integer" "character*17" "real" "real*8" } fortran-sig>c-sig ] [ "real" { "integer" "character*17" "real" "real*8" } fortran-sig>c-sig ]
unit-test unit-test
@ -213,7 +213,7 @@ unit-test
[ { [ drop ] } spread ] [ { [ drop ] } spread ]
} 1 ncleave } 1 ncleave
! [fortran-invoke] ! [fortran-invoke]
[ "double" "funpack" "fun_times__" { "float*" } alien-invoke ] [ "float" "funpack" "fun_times__" { "float*" } alien-invoke ]
1 nkeep 1 nkeep
! [fortran-results>] ! [fortran-results>]
shuffle( reta aa -- reta aa ) shuffle( reta aa -- reta aa )

6
basis/alien/fortran/fortran.factor
View File

@ -155,7 +155,9 @@ GENERIC: (fortran-ret-type>c-type) ( type -- c-type )
M: f (fortran-ret-type>c-type) drop "void" ; M: f (fortran-ret-type>c-type) drop "void" ;
M: fortran-type (fortran-ret-type>c-type) (fortran-type>c-type) ; M: fortran-type (fortran-ret-type>c-type) (fortran-type>c-type) ;
M: real-type (fortran-ret-type>c-type) drop "double" ; ! XXX F2C claims to return double for REAL typed functions
! XXX OSX Accelerate.framework uses float
! M: real-type (fortran-ret-type>c-type) drop "double" ;
: suffix! ( seq elt -- seq ) over push ; inline : suffix! ( seq elt -- seq ) over push ; inline
: append! ( seq-a seq-b -- seq-a ) over push-all ; inline : append! ( seq-a seq-b -- seq-a ) over push-all ; inline
@ -374,7 +376,7 @@ MACRO: fortran-invoke ( return library function parameters -- )
:: define-fortran-function ( return library function parameters -- ) :: define-fortran-function ( return library function parameters -- )
function create-in dup reset-generic function create-in dup reset-generic
return library function parameters return parse-arglist return library function parameters return [ "void" ] unless* parse-arglist
[ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ; [ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
: SUBROUTINE: : SUBROUTINE: