Committing R-SWIG

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@9175 626c5289-ae23-0410-ae9c-e8d60b6d4f22

Examples/Makefile.in

@@ -1017,3 +1017,26 @@ uffi_clean:
 	rm -f core @EXTRA_CLEAN@
 	rm -f *.@OBJEXT@ *@SO@
 
+##################################################################
+#####                      R                                ######
+##################################################################
+
+R = R
+RSRCS = $(INTERFACE:.i=_wrap.c) #special code for R build system
+RCXXSRCS = $(INTERFACE:.i=_wrap.cpp) #special code for R build system
+
+r: $(SRCS)
+	$(SWIG) -r $(SWIGOPT)  -o $(RSRCS) $(INTERFACE)
+	PKG_LIBS="$(SRCS)" PKG_CPPFLAGS="$(INCLUDES)" \
+             $(R) CMD SHLIB $(RSRCS)
+
+r_cpp: $(CXXSRCS)
+	$(SWIG) -c++ -r $(SWIGOPT) -o $(RCXXSRCS) $(INTERFACE)
+	PKG_LIBS="$(CXXSRCS)" PKG_CPPFLAGS="$(INCLUDES)" \
+	     $(R) CMD SHLIB $(RCXXSRCS)
+
+r_clean:
+	rm -f *_wrap* *~ .~* $(RSRCS) $(RCXXSRCS)
+	rm -f core @EXTRA_CLEAN@
+	rm -f *.@OBJEXT@ *@SO@
+

Examples/r/class/Makefile

@@ -0,0 +1,18 @@
+TOP        = ../..
+SWIG       = $(TOP)/../preinst-swig
+CXXSRCS    = example.cxx
+TARGET     = example
+INTERFACE  = example.i
+LIBS       = -lm
+ARGS = SRCS='$(SRCS)' SWIG='$(SWIG)' \
+	TARGET='$(TARGET)' INTERFACE='$(INTERFACE)'
+
+all::
+	$(MAKE) -f $(TOP)/Makefile CXXSRCS='$(CXXSRCS)' SWIG='$(SWIG)' \
+	TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' r_cpp
+
+clean::
+	$(MAKE) -f $(TOP)/Makefile $(ARGS) r_clean
+
+check: all
+	R CMD BATCH runme.R

Examples/r/class/example.cxx

@@ -0,0 +1,28 @@
+/* File : example.c */
+
+#include "example.h"
+#define M_PI 3.14159265358979323846
+
+/* Move the shape to a new location */
+void Shape::move(double dx, double dy) {
+  x += dx;
+  y += dy;
+}
+
+int Shape::nshapes = 0;
+
+double Circle::area(void) {
+  return M_PI*radius*radius;
+}
+
+double Circle::perimeter(void) {
+  return 2*M_PI*radius;
+}
+
+double Square::area(void) {
+  return width*width;
+}
+
+double Square::perimeter(void) {
+  return 4*width;
+}

Examples/r/class/example.h

@@ -0,0 +1,39 @@
+/* File : example.h */
+
+class Shape {
+public:
+  Shape() {
+    nshapes++;
+  }
+  virtual ~Shape() {
+    nshapes--;
+  };
+  double  x, y;   
+  void    move(double dx, double dy);
+  virtual double area(void) = 0;
+  virtual double perimeter(void) = 0;
+  static  int nshapes;
+};
+
+class Circle : public Shape {
+private:
+  double radius;
+public:
+  Circle(double r) : radius(r) { };
+  virtual double area(void);
+  virtual double perimeter(void);
+};
+
+class Square : public Shape {
+private:
+  double width;
+public:
+  Square(double w) : width(w) { };
+  virtual double area(void);
+  virtual double perimeter(void);
+};
+
+
+
+
+  

Examples/r/class/example.i

@@ -0,0 +1,9 @@
+/* File : example.i */
+%module example
+
+%inline %{
+#include "example.h"
+%}
+%include "example.h"
+
+

Examples/r/class/runme.R

@@ -0,0 +1,49 @@
+# This file illustrates the shadow-class C++ interface generated
+# by SWIG.
+
+dyn.load('example_wrap.so')
+source('example_wrap.R')
+cacheMetaData(1)
+
+# ----- Object creation -----
+
+print("Creating some objects:")
+circle <- Circle(10)
+print ("    Created circle")
+square <- Square(10)
+print ("    Created square")
+
+# ----- Access a static member -----
+
+sprintf("A total of %d shapes were created", Shape_nshapes())
+
+# ----- Member data access -----
+
+# Set the location of the object
+
+circle$x <- 20
+circle$y <- 30
+
+square$x <- -10
+square$y <- 5
+
+print("Here is their current position:")
+sprintf("    Circle = (%f, %f)", circle$x,circle$y)
+sprintf("    Square = (%f, %f)", square$x,square$y)
+
+# ----- Call some methods -----
+
+print ("Here are some properties of the shapes:")
+
+sapply(c(circle, square), 
+		 function(o) {
+sprintf("       area = %f perimeter = %f", o$area(),  o$perimeter())
+})
+
+print("Guess I'll clean up now")
+delete(circle)
+delete(square)
+
+sprintf("%d shapes remain", Shape_nshapes())
+print ("Goodbye");
+

Examples/r/simple/Makefile

@@ -0,0 +1,16 @@
+TOP        = ../..
+SWIG       = $(TOP)/../preinst-swig
+SRCS       = example.c
+TARGET     = example
+INTERFACE  = example.i
+ARGS = SRCS='$(SRCS)' SWIG='$(SWIG)' \
+	TARGET='$(TARGET)' INTERFACE='$(INTERFACE)'
+
+all::
+	$(MAKE) -f $(TOP)/Makefile $(ARGS) r
+
+clean::
+	$(MAKE) -f $(TOP)/Makefile $(ARGS) r_clean
+
+check: all
+	R CMD BATCH runme.R

Examples/r/simple/example.c

@@ -0,0 +1,18 @@
+/* File : example.c */
+
+/* A global variable */
+double Foo = 3.0;
+
+/* Compute the greatest common divisor of positive integers */
+int gcd(int x, int y) {
+  int g;
+  g = y;
+  while (x > 0) {
+    g = x;
+    x = y % x;
+    y = g;
+  }
+  return g;
+}
+
+

Examples/r/simple/example.i

@@ -0,0 +1,7 @@
+/* File : example.i */
+%module example
+
+%inline %{
+extern int    gcd(int x, int y);
+extern double Foo;
+%}

Examples/r/simple/runme.R

@@ -0,0 +1,24 @@
+# file: runme.R
+
+dyn.load('example_wrap.so')
+source('example_wrap.R')
+cacheMetaData(1)
+
+# Call our gcd() function
+
+x <- 42
+y <- 105
+g <- gcd(x,y)
+sprintf("The gcd of %d and %d is %d", x, y, g)
+
+# Manipulate the Foo global variable
+
+# Output its current value
+Foo()
+
+# Change its value
+Foo(3.1415926)
+
+# See if the change took effect
+Foo()
+

Examples/test-suite/common.mk

@@ -35,7 +35,7 @@ CXXSRCS    =
 CSRCS      = 
 TARGETPREFIX = 
 TARGETSUFFIX = 
-SWIGOPT    = -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)/$(LANGUAGE) -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)
+SWIGOPT    = -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)/$(LANGUAGE) -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE) -DSWIG_NOEXTRA_QUALIFICATION
 INCLUDES   = -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)/$(LANGUAGE) -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)
 LIBS       = -L.
 LIBPREFIX  = lib

Examples/test-suite/constructor_copy.i

@@ -77,7 +77,7 @@ public:
 SWIG_STD_VECTOR_SPECIALIZE_MINIMUM(Flow, Space::Flow)
 #endif
 
-#if defined(SWIGJAVA) || defined(SWIGCSHARP) || defined(SWIGPYTHON)
+#if defined(SWIGJAVA) || defined(SWIGCSHARP) || defined(SWIGPYTHON)||defined(SWIGR)
 #define SWIG_GOOD_VECTOR
 %ignore std::vector<Space::Flow>::vector(size_type);
 %ignore std::vector<Space::Flow>::resize(size_type);

Examples/test-suite/global_vars.i

@@ -19,7 +19,11 @@
 
   int x;
   int *xp;
+#ifdef SWIGR
+  int& c_member = x;
+#else
   int& c = x;
+#endif
 
   void *vp;
 

Examples/test-suite/name_warnings.i

@@ -61,7 +61,10 @@ namespace std
 
 %inline {
   /* silently rename the parameter names in csharp/java */
-
+#ifdef SWIGR
+  double foo(double inparam, double out) { return 1.0; }
+#else
   double foo(double in, double out) { return 1.0; }
+#endif
   double bar(double native, bool boolean) { return 1.0; }
 }

Examples/test-suite/r/Makefile.in

@@ -0,0 +1,54 @@
+#######################################################################
+# $Header$
+# Makefile for mzscheme test-suite
+#######################################################################
+
+LANGUAGE     = r
+SCRIPTSUFFIX = _runme.R
+WRAPSUFFIX   = _wrap.R
+RUNR         = R CMD BATCH --no-save --no-restore
+srcdir       = @srcdir@
+top_srcdir   = @top_srcdir@
+top_builddir = @top_builddir@
+
+C_TEST_CASES = copyStruct simpleArray legacy
+CPP_TEST_CASES = funcptr double_delete
+
+include $(srcdir)/../common.mk
+
+# Overridden variables here
+
+# Rules for the different types of tests
+%.cpptest: 
+	$(setup) \
+	($(swig_and_compile_cpp); ) && \
+	$(run_testcase)
+
+%.ctest:
+	$(setup) \
+	($(swig_and_compile_c); ) && \
+	$(run_testcase)
+
+%.multicpptest: 
+	$(setup) \
+	($(swig_and_compile_multi_cpp); ) && \
+	$(run_testcase)
+
+# Runs the testcase.
+# 
+# Run the runme if it exists.  If not just load the R wrapper to 
+# check for syntactic correctness
+run_testcase = \
+	if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then ( \
+	  env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH \
+               $(RUNR) $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ;) \
+	else \
+	  ($(RUNR) $(srcdir)/$(SCRIPTPREFIX)$*$(WRAPSUFFIX);) \
+	fi;
+
+# Clean
+clean:
+	$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile r_clean
+
+%.clean:
+	@rm -f $*_wrap.R $*_wrap.so $*_wrap.cpp $*_wrap.c $*_runme.Rout

Examples/test-suite/r/copyStruct_runme.R

@@ -0,0 +1,55 @@
+source('unittest.R')
+dyn.load('copyStruct_wrap.so')
+source('copyStruct_wrap.R')
+cacheMetaData(1)
+
+a <- getA()
+
+r = getARef()
+
+unittest(A_d_get(r), 42)
+unittest(r$d, 42)
+unittest(r$i, 20)
+
+# An error in trying to access a field that doesn't exist.
+try(r$foo) 
+
+r$d <- pi
+unittesttol(r$d, 3.141593, 0.0001)
+r$i <- -100
+
+r$ui
+r$ui <- 10
+
+ # An error since i is unsigned and so must  be positive.
+try(r$ui <- -10)
+
+
+a = A()
+unittest(a$i,0)
+unittest(a$d,0)
+unittest(a$ui,0)
+a$ui <- 100
+unittest(a$ui,100)
+a$d = 1
+unittest(a$d,1)
+
+d <- bar()
+unittest(class(d), "_p_D")
+unittest(d$x, 1)
+unittest(d$u, 0)
+
+
+la <- new("A");
+la@ui <- 5
+
+other = A()
+foo <- copyToC(la, other)
+
+aa = A()
+aa$i = 201
+aa$d = pi
+aa$str = 'foo'
+copyToR(aa)
+
+

Examples/test-suite/r/double_delete.i

@@ -0,0 +1,15 @@
+/* File : example.i */
+%module double_delete
+
+%inline %{
+
+class Foo {
+private:
+  double r;
+public:
+  Foo(double rin) : r(rin) {}; 
+};
+%}
+
+
+

Examples/test-suite/r/double_delete_runme.R

@@ -0,0 +1,12 @@
+# This file illustrates the shadow-class C++ interface generated
+# by SWIG.
+
+dyn.load('double_delete_wrap.so')
+source('double_delete_wrap.R')
+cacheMetaData(1)
+
+# ----- Object creation -----
+
+f <- Foo(2.0)
+delete(f);
+delete(f);

Examples/test-suite/r/funcptr_runme.R

@@ -0,0 +1,7 @@
+source('unittest.R')
+dyn.load('funcptr_wrap.so')
+source('funcptr_wrap.R')
+cacheMetaData(1)
+unittest(do_op(1, 3, add), 4)
+unittest(do_op(2, 3, mul), 6)
+unittest(do_op(2, 3, funcvar()), 5)

Examples/test-suite/r/ignore_parameter_runme.R

@@ -0,0 +1,10 @@
+source('unittest.R')
+dyn.load('ignore_parameter_wrap.so')
+source('ignore_parameter_wrap.R')
+cacheMetaData(1)
+
+unittest(jaguar(1, 1.0), "hello")
+q(save='no')
+
+
+

Examples/test-suite/r/legacy_runme.R

@@ -0,0 +1,30 @@
+source('unittest.R')
+dyn.load('legacy_wrap.so')
+source('legacy_wrap.R')
+cacheMetaData(1)
+
+obj <- getObject(1,3)
+unittest(class(obj), "_p_Obj")
+unittest(obj$i, 1)
+unittesttol(obj$d, 3, 0.001)
+unittest(obj$str, "a test string")
+obj$i <- 2
+unittest(obj$i, 2)
+obj$d <- 4
+unittesttol(obj$d, 4, 0.001)
+obj$str <- "a new string"
+unittest(obj$str, "a new string")
+
+unittest(getInt(), 42)
+unittesttol(getDouble(),3.14159, 0.001)
+unittesttol(getFloat(),3.14159/2.0, 0.001)
+unittest(getLong(), -321313)  
+unittest(getUnsignedLong(), 23123)
+unittest(getChar(), "A")
+
+q(save='no')
+
+
+
+
+

Examples/test-suite/r/simpleArray_runme.R

@@ -0,0 +1,9 @@
+source('unittest.R')
+dyn.load('simpleArray_wrap.so')
+source('simpleArray_wrap.R')
+cacheMetaData(1)
+initArray()
+
+q(save='no')
+
+

Examples/test-suite/r/unions_runme.R

@@ -0,0 +1,12 @@
+source('unittest.R')
+dyn.load('unions_wrap.so')
+source('unions_wrap.R')
+cacheMetaData(1)
+
+ss <- SmallStruct()
+
+bstruct <- BigStruct()
+
+q(save='no')
+
+

Examples/test-suite/r/unittest.R

@@ -0,0 +1,9 @@
+unittest <- function (x,y) {
+if (x==y) print("PASS") 
+else print("FAIL") 
+}
+
+unittesttol <- function(x,y,z) {
+if (abs(x-y) < z) print("PASS")
+else print("FAIL")
+}