Re: Guile test-ffi uses an unportable assumption

[Mark H Weaver <mhw@netris.org>]

[-- Attachment #1: Type: text/plain, Size: 1739 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Andy Wingo <wingo@pobox.com>
>> Cc: guile-devel@gnu.org
>> DATE: sat, 23 Jul 2016 23:17:58 +0200
>> 
>> > It assumes that libltdl can only produce a handle for a symbol in the
>> > the program itself, as opposed to those loaded from shared libraries.
>> > It tries 'strerror'.  This cannot work on MS-Windows, unless the
>> > program was linked with -export-dynamic, which is not true for
>> > the test program.
>> 
>> Interesting.  The test program is a Scheme script which looks up
>> strerror in the dlopen(NULL).  Libguile is compiled with -export-dynamic
>> but the guile binary is not.  Which part needs to be compiled with
>> -export-dynamic, do you think?
>
> The guile binary.  Here's what the libltdl documentation has to say
> about this:
>
>  -- Function: lt_dlhandle lt_dlopen (const char *FILENAME)
>     [...]
>      If FILENAME is `NULL' and the program was linked with
>      `-export-dynamic' or `-dlopen self', `lt_dlopen' will return a
>      handle for the program itself, which can be used to access its
>      symbols.
>     [...]
>      If you use `lt_dlopen (NULL)' to get a HANDLE for the running
>      binary, that handle will always be marked as resident, and
>      consequently cannot be successfully `lt_dlclose'd.
>
> However, in the case in point even compiling guile with -export-dynamic
> won't help, because the function being used by the test, strerror,
> comes from the C library, and is not statically linked into the guile
> binary.  So I suggest to modify the test to use a function that is
> part of the guile binary's own sources.

Sounds good to me.  Here's a proposed patch.  Can you test it on MinGW
and report back?

     Thanks,
       Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] test-ffi: In global symbol test, use functions from libguile only. --]
[-- Type: text/x-patch, Size: 4059 bytes --]

From 053ee60977392e9e406da4e3f1f289e31632b30b Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Wed, 10 Aug 2016 04:20:48 -0400
Subject: [PATCH] test-ffi: In global symbol test, use functions from libguile
 only.

* test-suite/standalone/test-ffi-lib.c (test_make_c_hook): New function.
* test-suite/standalone/test-ffi: Rewrite global symbol test to use
only functions from libguile.
---
 test-suite/standalone/test-ffi       | 49 +++++++++++++++++++++++-------------
 test-suite/standalone/test-ffi-lib.c | 13 +++++++++-
 2 files changed, 44 insertions(+), 18 deletions(-)

diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index 0a91f63..f201625 100755
--- a/test-suite/standalone/test-ffi
+++ b/test-suite/standalone/test-ffi
@@ -3,7 +3,7 @@ exec guile -q -s "$0" "$@"
 !#
 ;;; test-ffi --- Foreign function interface.         -*- Scheme -*-
 ;;;
-;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2016 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -257,27 +257,42 @@ exec guile -q -s "$0" "$@"
 ;;;
 ;;; Global symbols.
 ;;;
+;;; Only test functions from libguile, to allow this test to work
+;;; properly on MinGW.  We must avoid functions that accept or return
+;;; SCM values, since we lack a way to portably represent that type in
+;;; the FFI.
+;;;
 
-(use-modules ((rnrs bytevectors) #:select (utf8->string)))
+(define test-make-c-hook
+  (pointer->procedure '* (dynamic-func "test_make_c_hook" lib)
+                      (list '*)))
 
-(if (defined? 'setlocale)
-    (setlocale LC_ALL "C"))
 
 (define global (dynamic-link))
 
-(define strerror
-  (pointer->procedure '* (dynamic-func "strerror" global)
-                      (list int)))
-
-(define strlen
-  (pointer->procedure size_t (dynamic-func "strlen" global)
-                      (list '*)))
-
-(let* ((ptr (strerror ENOENT))
-       (len (strlen ptr))
-       (bv  (pointer->bytevector ptr len 0 'u8))
-       (str (utf8->string bv)))
-  (test #t (not (not (string-contains str "file")))))
+(define scm-c-hook-add
+  (pointer->procedure void (dynamic-func "scm_c_hook_add" global)
+                      (list '* '* '* int)))
+
+(define scm-c-hook-run
+  (pointer->procedure '* (dynamic-func "scm_c_hook_run" global)
+                      (list '* '*)))
+
+(let* ((hook-data  (string->pointer "hook-data" "UTF-8"))
+       (func-data  (string->pointer "func-data" "UTF-8"))
+       (data       (string->pointer "data" "UTF-8"))
+       (hook       (test-make-c-hook hook-data))
+       (func       (procedure->pointer
+                    '* (lambda args
+                         (string->pointer
+                          (if (equal? '("hook-data" "func-data" "data")
+                                      (map pointer->string args))
+                              "good"
+                              "bad")
+                          "UTF-8"))
+                    (list '* '* '*))))
+  (scm-c-hook-add hook func func-data 0)
+  (test "good" (pointer->string (scm-c-hook-run hook data))))
 
 (exit (not failed?))
 
diff --git a/test-suite/standalone/test-ffi-lib.c b/test-suite/standalone/test-ffi-lib.c
index f265339..8a2f884 100644
--- a/test-suite/standalone/test-ffi-lib.c
+++ b/test-suite/standalone/test-ffi-lib.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2010, 2011, 2016 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -244,3 +244,14 @@ double test_ffi_callback_2 (double (*f) (float, int, double),
 {
   return f (x, y, z);
 }
+
+
+scm_t_c_hook *test_make_c_hook (void *hook_data);
+scm_t_c_hook *test_make_c_hook (void *hook_data)
+{
+  scm_t_c_hook *hook;
+
+  hook = scm_malloc (sizeof (scm_t_c_hook));
+  scm_c_hook_init (hook, hook_data, SCM_C_HOOK_OR);
+  return hook;
+}
-- 
2.9.2