Minor updates.

interkosmos · Aug 12, 2023 · b922690 · b922690
1 parent f418fa7
commit b922690
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 32 deletions.
diff --git 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
@@ -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
@@ -1,5 +1,9 @@
 #include <tcl.h>
 
+#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