Clicky
Showing changes from revision #14 to #15:
(追記) Added (追記ここまで) | (削除) Removed (削除ここまで) | (削除) Chan (削除ここまで)(追記) ged (追記ここまで)
This example shows using the ISO_C_BINDING module to pass a CHARACTER variable to a C routine, and to return a char[] array to a CHARACTER variable.
If your program reads lines from the user interactively, you can let them use the GNU C routine readline(3c), which has extensive command line editing and history capabilities, and is used by shells, common ftp(1) commands, gnuplot(1), and many others. You can also use the simpler JUCMD(3f) routines, or utilities like rlwrap(1).
The GNU readline(3c) routine (at the time of this writing) is licensed under the GPL license, which basically means that any code you use it in must also be made available under a similar license. See the readline(3c) site for further information. If that is a problem, wrapping your program with a script that calls rlwrap(1) might be a solution.
The libedit/editline package and tecla package are very similar to readline(3c), but use the BSD and MIT licenses instead of the more restrictive GPL license.
Because of some of the differences in the ways Fortran and C handle text, I found a direct call to the C routine was not portable. So first, compile up a simple C routine like the following:
/*
@(#) Fortran-callable C routine that calls(削除) readline(3c) (削除ここまで)(追記) readline(3c)
(追記ここまで)(削除)
(削除ここまで) The Fortran routine can use the f2003 ISO_C_BINDING module
to do this in a portable manner.
assumes you have the GNU readline library libreadline.a available
(削除) /*
(削除ここまで)(削除) #include (削除ここまで)(削除) <stdlib.h>
(削除ここまで)(削除) #include (削除ここまで)(削除) <unistd.h>
(削除ここまで)(削除) #include (削除ここまで)(削除) <stdio.h>
(削除ここまで)(削除) #include (削除ここまで)(削除) <string.h>
(削除ここまで)(削除) #include (削除ここまで)(削除) <readline/readline.h>
(削除ここまで)(削除) #include (削除ここまで)(削除) <readline/history.h>
(削除ここまで)(削除) #
(削除ここまで)(削除) /* (削除ここまで)(削除) -------------------------------------------------------------------------- (削除ここまで) */
(追記) #include <stdlib.h>
#include <unistd.h>
#include <stdio.h>
#include <string.h>
#include <readline/readline.h>
#include <readline/history.h>
(追記ここまで)(追記) /* --------------------------------------------------------------------- */ (追記ここまで)(追記)
(追記ここまで)void show_history_list() {
HISTORY_STATE *state = history_get_history_state();
int i;
printf("History list now:\n");
for (i=0; i < state->length; i++) {
printf("%d: '%s'%s\n", i, state->entries[i]->line, (i == state->offset? "*":(追記)
(追記ここまで)""));
}(削除) (削除ここまで)(削除) (削除ここまで)(削除) (削除ここまで)(削除) (削除ここまで)(削除) (削除ここまで)
}(削除) (削除ここまで)
/* -------------------------------------------------------------------------- */
(追記) // void FCreadline(int *len, char *myline, char prompt[]){ (追記ここまで)(追記)
(追記ここまで)void FCreadline(int (削除) * (削除ここまで)len, char *myline, (追記) const (追記ここまで)(追記) (追記ここまで)char (追記) * (追記ここまで)prompt(削除) []){ (削除ここまで)(追記) ){ (追記ここまで)
/*
(削除) @(#)FCreadline.sh (削除ここまで)(追記) @(#)FCreadline.c (追記ここまで)(削除) (削除ここまで) return line from readline(3c) to Fortran. John S. Urban,(削除) 20100323
(削除ここまで)(追記) 2010
(追記ここまで)(追記) 0323
(追記ここまで)
Simple procedure that uses readline in "normal" (i.e. non-callback)(削除) mode. (削除ここまで)(追記) mode.
(追記ここまで)
(削除)
(削除ここまで) len -- number of characters in argument "myline"
myline -- Fortran CHARACTER variable to receive the line read by(削除) readline(3c) (削除ここまで)(追記) readline(3c)
(追記ここまで)
prompt -- prompt string to precede read
*/
/* readline(3c) will return the read line to this pointer */
char *line;
/* counter for padding returned line with spaces */
int i;
using_history();(削除) (削除ここまで)(削除) (削除ここまで)
/* use readline(3c) to read a line of input in edit mode */
line=readline(prompt);
add_history(line);
/* if the "h" command is on a line by itself show history */
if(strcmp(line,"h")==0){
show_history_list();
}
/* copy line returned by readline(3c) to MYLINE up to length of MYLINE */
(追記) // ersetzt: strncpy(myline,line,(size_t)*len); (追記ここまで)(追記)
(追記ここまで)strncpy(myline,line,(size_t(削除) )* (削除ここまで)(追記) ) (追記ここまで)len);
/* starting with null, pad with spaces to end */
(追記) // ersetzt: for(i=strlen(line);i<(int)*len;i++){ (追記ここまで)(追記)
(追記ここまで)for(i=strlen(line(削除) );i<( (削除ここまで)(追記) );i< (追記ここまで)(削除) int (削除ここまで)(削除) )* (削除ここまで)len;i++){
myline[i]=' ';
}
/* free memory used to return line from readline(3c) */
(追記) if (追記ここまで)(追記) (追記ここまで)(追記) ( (追記ここまで)(追記) line (追記ここまで)(追記) ) (追記ここまで)(追記) (追記ここまで)(追記) // neu: als sicherheit wenn readline mal // New: as a safety measure in case readline (追記ここまで)(追記)
(追記ここまで)(追記) // NULL zurÃ1⁄4ckgeben sollte. Dann wÃ1⁄4rde ohne diese Abfrage // returns NULL. Without this query, the (追記ここまで)(追記)
(追記ここまで)(追記) // der Aufruf von free() crashen. // call to free() would crash. (追記ここまで)(追記)
(追記ここまで)free(line);(削除) (削除ここまで)(削除) (削除ここまで)(削除) (削除ここまで)(削除) (削除ここまで)(削除) (削除ここまで)(削除) (削除ここまで)(削除) (削除ここまで)
}Then, compile up a Fortran module that calls the C routine. Then, as the sample test program shows, you can call "iso_readline" from Fortran with a simple subroutine call.
!-------------------------------------------------------------------------------
MODULE jsu_readline
USE ISO_C_BINDING
IMPLICIT NONE
PRIVATE
PUBLIC iso_readline
!-------------------------------------------------------------------------------
! define the call to the C routine
! extern char *Freadline(int ilen, char *buf, char prompt[]);
PUBLIC :: Freadline
INTERFACE
SUBROUTINE Freadline(ilen,buf,prompt) BIND(C,NAME='FCreadline')
USE ISO_C_BINDING
IMPLICIT NONE
INTEGER(KIND=C_INT),INTENT(IN),VALUE :: ilen
CHARACTER(KIND=C_CHAR),intent(out) :: buf(*)
CHARACTER(KIND=C_CHAR),intent(in) :: prompt(*)
END SUBROUTINE Freadline
END INTERFACE
!-------------------------------------------------------------------------------
contains
! the routine that calls the C routine
SUBROUTINE iso_readline(line,prompt)
USE ISO_C_BINDING
IMPLICIT NONE
CHARACTER(KIND=C_CHAR,LEN=*),INTENT(OUT) :: line
CHARACTER(KIND=C_CHAR,LEN=*),INTENT(IN) :: prompt
! trim to last non-blank character and append null for C
CALL Freadline(LEN(line),line,prompt(:LEN_TRIM(prompt))//ACHAR(0))
END SUBROUTINE iso_readline
!-------------------------------------------------------------------------------
END MODULE jsu_readline
!-------------------------------------------------------------------------------Now you can call ISO_READLINE(3f) from Fortran as easily as you can directly call readline(3c) from C...
! the test program
PROGRAM testit
USE jsu_readline
IMPLICIT NONE
CHARACTER(LEN=256):: line
WRITE(*,*)' ____________________________________________________________'
WRITE(*,*)' Your input lines are now editable using the GNU'
WRITE(*,*)' readline(3C) procedure. By default, up-arrow and'
WRITE(*,*)' down-arrow go thru the history lines; left and right arrow'
WRITE(*,*)' keys and delete and just typing characters let you do'
WRITE(*,*)' simple editing. Far more input control is available.'
WRITE(*,*)' See the browser pages and man(1) pages for readline(3c).'
WRITE(*,*)' ____________________________________________________________'
WRITE(*,*)' Enter text and then edit it. "q" quits; "h" display history:'
DO
CALL iso_readline(line,'readline>') ! read editable input line
IF(line.EQ.'q') STOP
!CALL system(line(:LEN_TRIM(line))) ! common extension
!CALL execute_command_line(line(:LEN_TRIM(line))) ! f08 equivalent
ENDDO
END PROGRAM testit
!-------------------------------------------------------------------------------The following version of the above example is from Joe Krahn. It does not use a C wrapper function. It demonstrates accessing C data structures from Fortran. However, the Gnu history structures may change, so the C wrapper version is more portable.
!-------------------------------------------------------------------------------
module jmk_readline_module
use ISO_C_Binding
implicit none
private
public readline
!-------------------------------------------------------------------------------
! The structure used to store a history entry.
type, bind(C) :: hist_entry_c
type(C_ptr) :: line, timestamp, data
end type hist_entry_c
! A structure used to pass the current state of the history stuff around.
type, bind(C) :: hist_state_c
type(C_ptr) :: entries; ! (hist_entry**) Pointer to the entries themselves.
integer(C_int) :: offset ! The location pointer within this array.
integer(C_int) :: length ! Number of elements within this array.
integer(C_int) :: size ! Number of slots allocated to this array.
integer(C_int) :: flags
end type hist_state_c
!-------------------------------------------------------------------------------
interface
function readline_c(prompt) result(line_ptr) bind(C,name="readline")
import
type(C_ptr) :: line_ptr
character(kind=C_char), intent(in) :: prompt(*)
end function readline_c
subroutine using_history() bind(C)
import
end subroutine using_history
subroutine add_history_c(line_ptr) bind(C,name="add_history")
import
type(C_ptr), value, intent(in) :: line_ptr
end subroutine add_history_c
function history_get_history_state() result(state_ptr) bind(C)
import
type(C_ptr) :: state_ptr
end function history_get_history_state
subroutine free(ptr) bind(C)
import
type(C_ptr), value, intent(in) :: ptr
end subroutine free
function strlen(s) bind(C)
import
integer(C_size_t) :: strlen
type(C_ptr), value, intent(in) :: s
end function strlen
end interface
!-------------------------------------------------------------------------------
contains
subroutine readline(line,prompt)
implicit none
character(len=*), intent(out) :: line
character(len=*), intent(in) :: prompt
! local
type(C_ptr) :: line_ptr
character(kind=C_char), pointer :: char_ptr(:)
integer i
! begin
call using_history()
! trim to last non-blank character and append null for C, and
! call readline(3c) to read a line of input in edit mode
line_ptr = readline_c(trim(prompt)//C_NULL_char)
call add_history_c(line_ptr)
! Copy the result to 'line'
line=' '
call C_F_pointer(line_ptr,char_ptr,(/len(line)/))
do i=1,len(line)
if (iachar(char_ptr(i))==0) exit
line(i:i)=char_ptr(i)
end do
! if the "h" command is on a line by itself, show history
if (line=='h') call show_history_list()
! free allocated result line returned from readline(3c)
call free(line_ptr)
end subroutine readline
subroutine show_history_list()
type(C_ptr) :: ptr
type(hist_state_c), pointer :: state_ptr
type(C_ptr), pointer :: entries(:)
type(hist_entry_c), pointer :: entry
character(kind=C_char,len=huge(0)), pointer :: line
integer :: i, line_len
ptr = history_get_history_state()
call C_F_pointer(ptr,state_ptr)
call C_F_pointer(state_ptr%entries,entries,(/state_ptr%length/))
write(*,*) 'History list now:'
do i=1,size(entries,1)
call C_F_pointer(entries(i),entry)
call C_F_pointer(entry%line,line)
line_len=strlen(entry%line)
write(*,'(I0,4A)') i,": '",line(:line_len),"'",merge('*',' ',i==state_ptr%offset)
end do
end subroutine show_history_list
!-------------------------------------------------------------------------------
end module jmk_readline_module
!-------------------------------------------------------------------------------
! the test program
program test_program
use jmk_readline_module
character(len=256):: line
! begin
write(*,*) &
'____________________________________________________________', &
' Your input lines are now editable using the GNU', &
' readline(3C) procedure. By default, up-arrow and', &
' down-arrow go thru the history lines; left and right arrow', &
' keys and delete and just typing characters let you do', &
' simple editing. Far more input control is available.', &
' See the browser pages and man(1) pages for readline(3c).', &
' ____________________________________________________________', &
' Enter text and then edit it. "q" quits; "h" display history:'
do
call readline(line,'readline>') ! read editable input line
if (line=='q') stop
enddo
end program test_program
!-------------------------------------------------------------------------------