Guile test-ffi uses an unportable assumption

Guile test-ffi uses an unportable assumption

[Eli Zaretskii]

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.

So this test currently fails on MS-Windows.

Re: Guile test-ffi uses an unportable assumption

[Andy Wingo]

On Sat 23 Jul 2016 13:51, Eli Zaretskii <eliz@gnu.org> writes:

> 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?

Andy

Re: Guile test-ffi uses an unportable assumption

[Eli Zaretskii]

> 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.

Re: Guile test-ffi uses an unportable assumption

[Mark H Weaver]

[-- 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

Re: Guile test-ffi uses an unportable assumption

[Eli Zaretskii]

> From: Mark H Weaver <mhw@netris.org>
> Cc: Andy Wingo <wingo@pobox.com>,  guile-devel@gnu.org
> Date: Wed, 10 Aug 2016 04:31:15 -0400
> 
> > 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?

It still fails, see the error messages below.  I think that's
expected, since scm_c_hook_add is in libguile, which is built as a
dynamic library, so should be accessed via dl_open'ing libguile.  What
I suggested above is to access a function whose code is inside the
executable itself, i.e. some function in test-ffi-lib.c, such as
test_make_c_hook.

Here's the error message I got:

  Backtrace:
  In ice-9/boot-9.scm:
   160: 11 [catch #t #<catch-closure d9f670> ...]
  In unknown file:
     ?: 10 [apply-smob/1 #<catch-closure d9f670>]
  In ice-9/boot-9.scm:
    66: 9 [call-with-prompt prompt0 ...]
  In ice-9/eval.scm:
   432: 8 [eval # #]
  In ice-9/boot-9.scm:
  2404: 7 [save-module-excursion #<procedure db6c60 at ice-9/boot-9.scm:4051:3 ()>]
  4056: 6 [#<procedure db6c60 at ice-9/boot-9.scm:4051:3 ()>]
  1727: 5 [%start-stack load-stack #<procedure c9b410 at ice-9/boot-9.scm:4047:10 ()>]
  1732: 4 [#<procedure c10ba0 ()>]
  In unknown file:
     ?: 3 [primitive-load "d:/gnu/guile-2.0.12/test-suite/standalone/test-ffi"]
  In ice-9/eval.scm:
   453: 2 [eval # ()]
   387: 1 [eval # ()]
  In unknown file:
     ?: 0 [dynamic-func "scm_c_hook_add" #<dynamic-object #f>]

  ERROR: In procedure dynamic-func:
  ERROR: In procedure dynamic-pointer: Symbol not found: scm_c_hook_add
  FAIL: test-ffi