Committing R-SWIG

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

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")
+}