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