Check C types of foreign imports

tweag · Apr 1, 2024 · fbaf032 · fbaf032
1 parent e77f06c
commit fbaf032
Show file tree

Hide file tree

Showing 3 changed files with 64 additions and 1 deletion.
diff --git a/inline-r/cbits/missing_r.c b/inline-r/cbits/missing_r.c
@@ -33,3 +33,65 @@ SEXP funPtrToSEXP(DL_FUNC pf)
 int isRInitialized = 2;
 
 HsStablePtr rVariables;
+
+
+// List the prototypes of functions and variables that inline-r
+// uses from R. The purpose of this is to catch changes in the
+// C interface when upgrading R.
+#include <Rembedded.h>
+int Rf_initEmbeddedR(int, char**);
+void Rf_endEmbeddedR(int);
+
+#ifndef mingw32_HOST_OS
+#include <R_ext/eventloop.h>
+static void test_R_PolledEvents(){ void (*a)(void) = R_PolledEvents; };
+static void test_R_wait_usec(){ int *a = &R_wait_usec; };
+
+static void test_R_InputHandlers(){ InputHandler *a = R_InputHandlers; };
+fd_set *R_checkActivity(int usec, int ignore_stdin);
+void R_runHandlers(InputHandler *handlers, fd_set *mask);
+InputHandler *addInputHandler(InputHandler *handlers, int fd, InputHandlerProc handler, int activity);
+int removeInputHandler(InputHandler **handlers, InputHandler *it);
+
+#include <Rinterface.h>
+static void test_R_Interactive(){
+    Rboolean *a = &R_Interactive;
+    int i=0;
+    *a=i;
+};
+#endif
+
+int TYPEOF(SEXP x);
+static void test_R_NilValue(){ SEXP *a = &R_NilValue; };
+static void test_R_UnboundValue(){ SEXP *a = &R_UnboundValue; };
+static void test_R_MissingArg(){ SEXP *a = &R_MissingArg; };
+static void test_R_BaseEnv(){ SEXP *a = &R_BaseEnv; };
+static void test_R_EmptyEnv(){ SEXP *a = &R_EmptyEnv; };
+static void test_R_GlobalEnv(){ SEXP *a = &R_GlobalEnv; };
+static void test_R_SignalHandlers(){ int *a = &R_SignalHandlers; };
+
+#include <R_ext/GraphicsEngine.h>
+static void test_R_interrupts_pending(){ int *a = &R_interrupts_pending; };
+int OBJECT(SEXP x);
+int NAMED(SEXP x);
+int LEVELS(SEXP x);
+int MARK(SEXP x);
+int RDEBUG(SEXP x);
+int RTRACE(SEXP x);
+int RSTEP(SEXP x);
+SEXP ATTRIB(SEXP x);
+void SET_ATTRIB(SEXP, SEXP);
+SEXP Rf_getAttrib(SEXP, SEXP);
+Rboolean Rf_isS4(SEXP x);
+
+#include <R_ext/Parse.h>
+static void test_ParseStatus() { ParseStatus a = (int)0; };
+SEXP R_ParseVector(SEXP, int, ParseStatus*, SEXP);
+
+// These variables are not in header files!
+extern void (*Rg_PolledEvents)(void);
+static void test_Rg_PolledEvents(){ void (*a)(void) = Rg_PolledEvents; };
+extern int Rg_wait_usec;
+static void test_Rg_wait_usec(){ int *a = &Rg_wait_usec; };
+extern int R_PPStackTop;
+static void test_R_PPStackTop(){ int *a = &R_PPStackTop; };
diff --git a/inline-r/inline-r.cabal b/inline-r/inline-r.cabal
@@ -128,6 +128,7 @@ library
   hs-source-dirs: src
   includes: cbits/missing_r.h
   c-sources: cbits/missing_r.c
+  cc-options: -Werror=incompatible-pointer-types
   include-dirs: cbits
   other-extensions:
     CPP

diff --git a/inline-r/src/Foreign/R/EventLoop.hsc b/inline-r/src/Foreign/R/EventLoop.hsc
@@ -72,7 +72,7 @@ foreign import ccall "&R_PolledEvents" polledEvents :: Ptr (FunPtr (IO ()))
 -- | @R_wait_usec@ global variable.
 foreign import ccall "&R_wait_usec" pollingPeriod :: Ptr CInt
 
--- | @R_PolledEvents@ global variable.
+-- | @Rg_PolledEvents@ global variable.
 foreign import ccall "&Rg_PolledEvents" graphicsPolledEvents :: Ptr (FunPtr (IO ()))
 
 -- | @R_wait_usec@ global variable.