diff --git a/README.md b/README.md index 4820014..fa14fa5 100644 --- a/README.md +++ b/README.md @@ -26,11 +26,11 @@ There are some smaller differences to the original API: See [COVERAGE](COVERAGE.md) for a table of the bound procedures. ## Fortran Libraries -| Library | Description | -|-------------------|--------------------------------------------------------------------| -| `libftcl86.a` | Bindings to Tcl (`libtcl86.a`) | -| `libftclstub86.a` | Bindings to Tcl Stubs for extensions in Fortran (`libtclstub86.a`) | -| `libftk86.a` | Bindings to Tk (`libtk86.a`) | +| Library | Description | +|-------------------|------------------------------------------------------------------| +| `libftcl86.a` | Bindings to Tcl (`libtcl86`) | +| `libftclstub86.a` | Bindings to Tcl Stubs for extensions in Fortran (`libtclstub86`) | +| `libftk86.a` | Bindings to Tk (`libtk86`) | ## Build Instructions Tcl 8.6 and Tk 8.6 with development headers have to be present. On FreeBSD, @@ -62,9 +62,8 @@ with [fpm](https://github.com/fortran-lang/fpm): $ fpm build --profile=release --c-flag="`pkg-config --cflags tcl86`" ``` -The include and library search paths have to point to the correct directories. -Link against `libfortran-tcl86.a` instead of `libftcl86.a`, `libftclstub86.a`, -and `libftk86.a`. +The include and library search paths in `--c-flags` have to point to the correct +directories. ## Linking Tcl & Tk Linking depends on whether Fortran is called from Tcl or Tcl from Fortran. To @@ -119,7 +118,7 @@ program main ! Evaluate string as Tcl command. rc = tcl_eval_ex(interp, 'puts "Hello, from Tcl!"') - if (rc /= TCL_OK) print '("Error: Tcl_EvalEx failed")' + if (rc /= TCL_OK) print '("Error: Tcl_EvalEx() failed")' ! Delete Tcl interpreter. call tcl_delete_interp(interp) diff --git a/src/tcl.f90 b/src/tcl.f90 index 58b88cd..9cf50ff 100644 --- a/src/tcl.f90 +++ b/src/tcl.f90 @@ -263,7 +263,6 @@ module tcl public :: tcl_zlib_stream_get public :: tcl_zlib_stream_init - private :: copy private :: c_f_str_ptr integer, parameter :: c_unsigned_int = c_int @@ -2226,7 +2225,7 @@ function c_strlen(str) bind(c, name='strlen') import :: c_ptr, c_size_t implicit none type(c_ptr), intent(in), value :: str - integer(c_size_t) :: c_strlen + integer(kind=c_size_t) :: c_strlen end function c_strlen end interface contains @@ -2611,6 +2610,7 @@ end function tcl_get_double function tcl_get_host_name() result(str) character(len=:), allocatable :: str type(c_ptr) :: ptr + ptr = tcl_get_host_name_() call c_f_str_ptr(ptr, str) if (.not. allocated(str)) str = '' @@ -3032,29 +3032,28 @@ end subroutine tcl_wrong_num_args ! ************************************************************************** ! PRIVATE PROCEDURES ! ************************************************************************** - pure function copy(a) - character, intent(in) :: a(:) - character(len=size(a)) :: copy - integer(kind=i8) :: i - - do i = 1, size(a) - copy(i:i) = a(i) - end do - end function copy - subroutine c_f_str_ptr(c_str, f_str) - !! Utility routine that copies a C string, passed as a C pointer, to a - !! Fortran string. On error, `f_str` is not allocated. + !! Copies a C string, passed as a C pointer, to a Fortran string. type(c_ptr), intent(in) :: c_str character(len=:), allocatable, intent(out) :: f_str - character(kind=c_char), pointer :: ptrs(:) - integer(kind=i8) :: sz - - if (.not. c_associated(c_str)) return - sz = c_strlen(c_str) - if (sz < 0) return - call c_f_pointer(c_str, ptrs, [ sz ]) - allocate (character(len=sz) :: f_str) - f_str = copy(ptrs) + + character(kind=c_char), pointer :: ptrs(:) + integer(kind=c_size_t) :: i, sz + + copy_block: block + if (.not. c_associated(c_str)) exit copy_block + sz = c_strlen(c_str) + if (sz < 0) exit copy_block + call c_f_pointer(c_str, ptrs, [ sz ]) + allocate (character(len=sz) :: f_str) + + do i = 1, sz + f_str(i:i) = ptrs(i) + end do + + return + end block copy_block + + if (.not. allocated(f_str)) f_str = '' end subroutine c_f_str_ptr end module tcl diff --git a/src/tcl_macro.c b/src/tcl_macro.c index 30ba3e6..c0c8c81 100644 --- a/src/tcl_macro.c +++ b/src/tcl_macro.c @@ -1,5 +1,9 @@ #include +#ifdef __cplusplus +extern "C" { +#endif + /* * C macro wrappers. */ @@ -33,3 +37,7 @@ void Tcl_SetHashValue_(Tcl_HashEntry *entryPtr, ClientData value) { Tcl_SetHashValue(entryPtr, value); } + +#ifdef __cplusplus +} +#endif