|
| 1 | +# Copyright (c) 2019, Oracle and/or its affiliates. All rights reserved. |
| 2 | +# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. |
| 3 | +# |
| 4 | +# This code is free software; you can redistribute it and/or modify it |
| 5 | +# under the terms of the GNU General Public License version 3 only, as |
| 6 | +# published by the Free Software Foundation. |
| 7 | +# |
| 8 | +# This code is distributed in the hope that it will be useful, but WITHOUT |
| 9 | +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
| 10 | +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
| 11 | +# version 3 for more details (a copy is included in the LICENSE file that |
| 12 | +# accompanied this code). |
| 13 | +# |
| 14 | +# You should have received a copy of the GNU General Public License version |
| 15 | +# 3 along with this work; if not, write to the Free Software Foundation, |
| 16 | +# Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. |
| 17 | +# |
| 18 | +# Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA |
| 19 | +# or visit www.oracle.com if you need additional information or have any |
| 20 | +# questions. |
| 21 | + |
| 22 | +# Contains unit-tests of the individual R API functions |
| 23 | + |
| 24 | +assertEquals <- function(expected, actual) { |
| 25 | + width <- 80L |
| 26 | + name <- substr(deparse(sys.call(), width)[[1L]], 1, width) |
| 27 | + cat(name, paste(rep('.', width + 3L - nchar(name)), collapse='')) |
| 28 | + cat(if (identical(expected, actual)) 'pass' else 'fail', '\n') |
| 29 | +} |
| 30 | + |
| 31 | +ignore <- function(...) {} |
| 32 | + |
| 33 | +library(testrffi) |
| 34 | + |
| 35 | +# --------------------------------------------------------------------------------------- |
| 36 | +# SET_ATTRIB |
| 37 | + |
| 38 | +x <- c(1,3,10) |
| 39 | +assertEquals(NULL, api.SET_ATTRIB(x, pairlist(names=c('a','b','q')))) |
| 40 | +assertEquals(c('a','b','q'), names(x)) |
| 41 | + |
| 42 | +# there is no validation |
| 43 | +x <- c(1,3,10) |
| 44 | +assertEquals(NULL, api.SET_ATTRIB(x, as.pairlist(list(names=c('a','b'))))) |
| 45 | +assertEquals(c('a','b'), names(x)) |
| 46 | +# note: printing x on GNU-R causes segfault |
| 47 | + |
| 48 | +# --------------------------------------------------------------------------------------- |
| 49 | +# Rf_mkCharLenCE, note: last arg is encoding and 0 ~ native encoding |
| 50 | + |
| 51 | +assertEquals("hello world", api.Rf_mkCharLenCE("hello world", 11, 0)) |
| 52 | +ignore("FastR bug", assertEquals("hello", api.Rf_mkCharLenCE("hello this will be cut away", 5, 0))) |
0 commit comments