ASM allowed in Fortran? and OpenDir?

[Christopher D. Rickett]

hi Tobias, all,

i looked over the code below and found a couple bugs.  first, the 
parameter to readdir needs to be a c_ptr passed by value.  also, the 
parameter to opendir is not null terminated!  and, the same problem exists 
in the print *, Result line where the d%d_name may be null terminated, but 
i doubt the fortran print routine cares; the printf routine of C is 
probably the safest thing to call here.

the following code should fix the bugs i found:

module mod
   use iso_c_binding
   implicit none
end module mod

program test
use iso_c_binding
use mod
implicit none

type, bind(C) :: dirent
   integer(c_long)    :: d_ino
   integer(c_long)    :: d_off; ! __off_t, check size
   integer(c_short)   :: d_reclen
   character(len=1,kind=c_char) :: d_name(256)
end type
interface
   function opendir(a) bind(C,name='opendir')
     import
     type(c_ptr)                  :: opendir
     character(len=1,kind=c_char), intent(in) :: a(*)
   end function opendir
   function readdir(dir) bind(C,name='readdir')
     import
     type(c_ptr), value :: dir
     type(c_ptr)             :: readdir
   end function readdir

   subroutine print_string(format_string, string) bind(c, name='printf')
     import :: c_ptr, c_char
     type(c_ptr), value :: format_string
     character(c_char) :: string(*)
   end subroutine print_string
end interface

type(c_ptr) :: dir, dc
type(dirent), pointer :: d
type(c_ptr) :: f_ptr
character(len=20), target :: format_string

format_string = 'Result: %s\n' // C_NULL_CHAR

f_ptr = c_loc(format_string(1:1))

dir = opendir("."//C_NULL_CHAR)
if(.not.c_associated(dir)) then
   print *, 'Error opening "."'
else
    do
       dc = readdir (dir)
       if(.not. c_associated(dc)) exit
       call c_f_pointer(dc,d)
       call print_string(f_ptr, d%d_name)
    end do
end if
end program


this code compiled and executed on my linux box with no problems, even 
giving me the expected output.  hope this helps.

Chris

On Tue, 7 Aug 2007, Tobias Burnus wrote:

> RadSurfer wrote:
>> I was just curious if there was such a thing as discreet assembly code ever
>> being allowed inside a Fortran program...
>> Perhpas that seems like a ludicrous question -- but I'll have to wait to see
>> what the replies are.
>>
> This slowly becomes a frequently ask question:
> http://gcc.gnu.org/ml/fortran/2007-07/msg00470.html
>
>> One other question, seriously:
>> I did not notice any functions/extensions/etc. which permit the getting of
>> directory information which allows to "walk through" files...
>> I refer to "opendir" or "findfirst" type of directory-walking functions.
>> I realize there are extensions which allow information about _known_ files
>> to be returned... but not retreiving files from a directory to be placed
>> into a list for processing and that sort of functionality.
>>
>
> In principle the following program should do this; however, I only get
> NULL returned by opendir (with gfortran), a compiler error (g95) or an
> endless loop (NAG f95). Besides compiler errors, I think I made a
> mistake somewhere too.
>
> Tobias
>
>
> module mod
>  use iso_c_binding
>  implicit none
>  integer(c_int), bind(c,name="errno") :: errno
> end module mod
>
> program test
> use iso_c_binding
> use mod
> implicit none
> type, bind(C) :: dirent
>  integer(c_long)    :: d_ino
>  integer(c_long)    :: d_off; ! __off_t, check size
>  integer(c_short)   :: d_reclen
>  character(len=1,kind=c_char) :: d_name(256)
> end type
> interface
>  function opendir(a) bind(C,name='opendir')
>    import
>    type(c_ptr)                  :: opendir
>    character(len=1,kind=c_char), intent(in) :: a(*)
>  end function opendir
>  function readdir(dir) bind(C,name='readdir')
>    import
>    type(c_ptr), intent(in) :: dir
>    type(c_ptr)             :: readdir
>  end function readdir
> end interface
> type(c_ptr) :: dir, dc
> type(dirent), pointer :: d
> errno = 0
> dir = opendir(".")
> if(.not.c_associated(dir)) then
>  print *, 'Error opening "."', errno
> else
>  do
>    dc = readdir (dir)
>    if(.not. c_associated(dc)) exit
>    call c_f_pointer(dc,d)
>    print *, "Result: ", d%d_name
>  end do
> end if
> end program
>
>
>