Add tinytest support

.gitignore

@@ -7,3 +7,4 @@ src/*.dll
 GPATH
 GRTAGS
 GTAGS
+*~

ChangeLog

@@ -1,3 +1,18 @@
+2020-02-07  Dirk Eddelbuettel  <edd@debian.org>
+
+	* R/read.R: Always close connection in readASCII
+
+2020-02-06  Dirk Eddelbuettel  <edd@debian.org>
+
+	* DESCRIPTION (Suggests): Add tinytest
+
+	* inst/tinytest/*: Converted from RUnit to tinytest
+	* inst/unitTests/*: Idem
+	* tests/tinytest.R: Idem
+	* tests/doRUnit.R: Idem
+
+	* docker/ci/Dockerfile: Add tinytest
+
 2020-02-04  Dirk Eddelbuettel  <edd@debian.org>
 
 	* DESCRIPTION (Version, Date): Roll minor version

DESCRIPTION

@@ -13,7 +13,7 @@ Description: Protocol Buffers are a way of encoding structured data in an
 Depends: R (>= 3.0.0), methods
 Imports: utils, stats, tools, Rcpp, RCurl
 LinkingTo: Rcpp
-Suggests: RUnit, rmarkdown, knitr, pinp
+Suggests: tinytest, RUnit, rmarkdown, knitr, pinp
 VignetteBuilder: knitr
 SystemRequirements: ProtoBuf libraries and compiler version 2.2.0 or later;
  version 3.0.0 or later is supported as well. On Debian/Ubuntu these can be

R/read.R

@@ -51,6 +51,6 @@ function( descriptor, input, partial=FALSE){
         stopifnot(summary(input)[["text"]] == "binary")
 	message <- .Call( "Descriptor__readASCIIFromConnection", descriptor@pointer, input,
                          partial, PACKAGE = "RProtoBuf" )
-	if( !wasopen ) close( input )
+        close(input)
 	message
 } )

inst/NEWS.Rd

@@ -7,7 +7,6 @@
   \itemize{
     \item Repeated Message and Group objects are now returned correctly
     (\ghit{62}).
-    }
   }
 }
 

inst/tinytest/test_addressbook.R

@@ -0,0 +1,86 @@
+
+library(RProtoBuf)
+
+## created as
+##   demo(addressbook)  ## creates 'book'
+##   serialize(book, "/tmp/addressbook.pb")
+
+# this is executed before each test function -- but somehow does not work
+#.setUp <- function() {
+file <- system.file( "examples", "addressbook.pb", package = "RProtoBuf" )
+book <- read( tutorial.AddressBook, file )
+assign("book", book, globalenv())
+#}
+
+#test.size <- function() {
+expect_equal(book$size("person"),        2,   info="Number of persons")
+expect_equal(bytesize(book),             125, info="Bytes in book")
+expect_equal(bytesize(book$person[[1]]), 60,  info="Bytes of first person message")
+#}
+
+#test.fileDescriptor <- function() {
+expect_equal(name(book$fileDescriptor()), "addressbook.proto")
+#}
+
+#test.personOne <- function() {
+expect_equal(book$person[[1]]$name,              "Romain Francois",   info="First person name")
+expect_equal(book$person[[2]]$name,              "Dirk Eddelbuettel", info="First person name")
+expect_equal(book$person[[1]]$id,                1,   		 info="First person id")
+expect_equal(book$person[[2]]$id,                2,			 info="First person id")
+expect_equal(book$person[[1]]$email,             "romain@r-enthusiasts.com",   info="First person email")
+expect_equal(book$person[[2]]$email,             "edd@debian.org",    info="Second person email")
+expect_equal(length(book$person[[1]]$phone),     1,                   info="First person phones")
+expect_equal(length(book$person[[2]]$phone),     2,                   info="Second person phones")
+expect_equal(book$person[[1]]$phone[[1]]$number, "+33(0)...",         info="First person phone number")
+expect_equal(book$person[[2]]$phone[[1]]$number, "+01...",            info="Second person phone number")
+expect_equal(book$person[[2]]$phone[[1]]$type,   0,                   info="Second person phone number")
+#}
+
+#test.ascii <- function() {
+## Output in text format to a temporary file
+out.file <- tempfile()
+writeLines( as.character(book), file(out.file))
+
+## Verify that we can read back in the message from a text file.
+book2 <- readASCII( tutorial.AddressBook, file(out.file, "rb"))
+expect_equal(as.character(book), as.character(book2) )
+
+## Verify that we can read in messages from unopened connections.
+book3 <- readASCII( tutorial.AddressBook, file(out.file))
+expect_equal(as.character(book), as.character(book3) )
+
+## Verify that we get an exception if we try to read from a text connection.
+## (better than silently getting an empty proto.)
+book4 <- expect_error( readASCII( tutorial.AddressBook, file(out.file, "rt")))
+
+## # Test does not work on windows because of chmod
+## if(!grepl("mingw", R.Version()$platform)){
+##     # Verify that we get an exception if the file is not readable.
+##     old.mode <- file.info(out.file)[["mode"]]
+##     Sys.chmod(out.file, "0000")
+##     book5 <- checkException( readASCII( tutorial.AddressBook, file(out.file, "rb")))
+##     # Set the permissions back to ensure the file is cleaned up properly.
+##     Sys.chmod(out.file, old.mode)
+## }
+
+## Verify that we get an exception if the file is not parseable.
+out.file2 <- tempfile()
+writeLines("jibberish", file(out.file2))
+book6 <- expect_error( readASCII( tutorial.AddressBook, file(out.file2)))
+
+## Verify that we get an exception if we forget the file() and thus treat the
+## path as a protobuf string.
+expect_error( readASCII( tutorial.AddressBook, out.file2))
+
+incomplete.msg <- new(tutorial.Person, name="Murray", email="murray@stokely.org")
+tmp.file <- tempfile()
+writeLines(as.character(incomplete.msg), file(tmp.file))
+
+expect_true(!incomplete.msg$isInitialized())
+## Verify we normally get an exception if we try to read an incomplete ASCII protocol buffer
+expect_error(tutorial.Person$readASCII(file(tmp.file)))
+
+## Verify we can however read it if we set partial=TRUE.
+new.msg <- tutorial.Person$readASCII(file(tmp.file), TRUE)
+expect_equal(incomplete.msg$name, new.msg$name)
+#}

inst/tinytest/test_bool.R

@@ -0,0 +1,47 @@
+
+# Copyright 2013 Google Inc.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+library(RProtoBuf)
+
+#test.bool <- function() {
+if (!exists("protobuf_unittest.TestAllTypes",
+            "RProtoBuf:DescriptorPool")) {
+    unittest.proto.file <- system.file("tinytest", "data", "unittest.proto", package="RProtoBuf")
+    readProtoFiles(file=unittest.proto.file)
+}
+
+a <- new(protobuf_unittest.TestAllTypes)
+a$optional_bool <- TRUE
+a$optional_bool <- FALSE
+## Verify we can not set a protocol buffer bool to NA.
+expect_error(a$optional_bool <- NA)
+
+## Verify we can set character strings
+a$repeated_bool <- c(TRUE, FALSE, TRUE)
+expect_equal(length(unique(a$repeated_bool)), 2)
+
+## Verify we can't set any garbage string to a bool.
+expect_error(a$optional_bool <- "100")
+expect_error(a$optional_bool <- "invalid")
+
+## Verify we can't set any garbage string to a repeated bool.
+expect_error(a$repeated_bool <-c("invalid", "invalid"))
+expect_error(a$repeated_bool <-c("33-"))
+
+## Verify we can set NA
+expect_error(a$repeated_bool <- c(TRUE, FALSE, TRUE, NA))
+#}

inst/tinytest/test_bytes.R

@@ -0,0 +1,30 @@
+
+library(RProtoBuf)
+
+#.setUp <- function(){
+if( ! exists( "TestBytes", "RProtoBuf:DescriptorPool" ) ){
+    unitest.proto.file <- system.file( "tinytest", "data", "bytes.proto", package = "RProtoBuf" )
+    readProtoFiles(file = unitest.proto.file)
+}
+#}
+
+#test.all <- function() {
+test <- new(TestBytes, req = "abc", rep = list(charToRaw("def"), raw(10)))
+expect_equal(rawToChar(test$req), "abc")
+test$req <- charToRaw("abc")
+expect_equal(rawToChar(test$req), "abc")
+expect_equal(rawToChar(test$opt), "hello world")
+expect_equal(test$rep, list(charToRaw("def"), raw(10)))
+test$rep[[3]]=charToRaw("ghi")
+expect_equal(test$rep, list(charToRaw("def"), raw(10), charToRaw("ghi")))
+ser <- serialize(test, NULL)
+test1 <- read(TestBytes, ser)
+expect_equal(rawToChar(test1$req), "abc")
+expect_equal(rawToChar(test1$opt), "hello world")
+expect_equal(test1$rep, list(charToRaw("def"), raw(10), charToRaw("ghi")))
+
+## Test raw(10) can be set to a single req field.
+test$req <- raw(10)
+expect_equal(length(test$req), 10)
+expect_true(all(test$req == raw(10)))
+#}

inst/unitTests/runit.descriptors.R → inst/tinytest/test_descriptors.R

@@ -14,14 +14,16 @@
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 
-test.descriptor <- function() {
-  checkTrue(inherits(tutorial.Person$email, "FieldDescriptor"))
-  checkTrue(inherits(tutorial.Person[["email"]], "FieldDescriptor"))
-  checkTrue(inherits(tutorial.Person[[1]], "FieldDescriptor"))
-  # Currently, the $ extractor for fields returns NULL for invalid reference
-  # stop() probably better.
-  checkEquals(tutorial.Person$nonexistantfoobarbaz, NULL)
-  # But we raise an error with invalid indices with '[['.
-  checkException(tutorial.Person[[909]])
-  checkException(tutorial.Person[["nonexistantfoobarbaz"]])
-}
+library(RProtoBuf)
+
+#test.descriptor <- function() {
+expect_true(inherits(tutorial.Person$email, "FieldDescriptor"))
+expect_true(inherits(tutorial.Person[["email"]], "FieldDescriptor"))
+expect_true(inherits(tutorial.Person[[1]], "FieldDescriptor"))
+## Currently, the $ extractor for fields returns NULL for invalid reference
+## stop() probably better.
+expect_equal(tutorial.Person$nonexistantfoobarbaz, NULL)
+## But we raise an error with invalid indices with '[['.
+expect_error(tutorial.Person[[909]])
+expect_error(tutorial.Person[["nonexistantfoobarbaz"]])
+#}

inst/tinytest/test_enums.R

@@ -0,0 +1,60 @@
+# Copyright 2011 Google Inc.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+library(RProtoBuf)
+
+#test.enums <- function() {
+ProtoFormat <- P("tutorial.Person")
+
+## value(..) returns an EnumValueDescriptor object
+
+expect_equal(name(value(ProtoFormat$PhoneType, index=1)), "MOBILE")
+expect_equal(name(value(ProtoFormat$PhoneType, index=1), TRUE),
+            "tutorial.Person.MOBILE")
+expect_equal(number(value(ProtoFormat$PhoneType, index=1)), 0)
+expect_true(inherits(enum_type(value(ProtoFormat$PhoneType, index=1)),
+                   "EnumDescriptor"))
+expect_true(inherits(asMessage(value(ProtoFormat$PhoneType, index=1)),
+                   "Message"))
+
+## Now check the '$' interfaces
+expect_equal(name(value(ProtoFormat$PhoneType, index=1)),
+            value(ProtoFormat$PhoneType, index=1)$name())
+expect_equal(number(value(ProtoFormat$PhoneType, index=1)),
+            value(ProtoFormat$PhoneType, index=1)$number())
+
+expect_equal(name(value(ProtoFormat$PhoneType, index=2)), "HOME")
+
+
+expect_equal(length(ProtoFormat$PhoneType), 3)
+expect_true(has(ProtoFormat$PhoneType, "WORK"))
+expect_true(!has(ProtoFormat$PhoneType, "NONEXISTANT"))
+
+## Verify we can subset the EnumDescriptor class
+expect_equal(ProtoFormat$PhoneType[["WORK"]], 2)
+expect_equal(ProtoFormat$PhoneType[["MOBILE"]], 0)
+
+## Verify that invalid indices are returned as NULL.
+expect_true(is.null(value(ProtoFormat$PhoneType, index=900)))
+
+## Verify that we import top-level enums from .proto files.
+if (!exists("protobuf_unittest.TestAllTypes",
+            "RProtoBuf:DescriptorPool")) {
+    unittest.proto.file <- system.file("tinytest", "data", "unittest.proto", package="RProtoBuf")
+    readProtoFiles(file=unittest.proto.file)
+}
+expect_true(inherits(P("protobuf_unittest.ForeignEnum"), "EnumDescriptor"))
+#}

inst/tinytest/test_extensions.R

@@ -0,0 +1,89 @@
+# Copyright 2013 Google Inc.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+library(RProtoBuf)
+
+#test.extension <- function() {
+if (!exists("protobuf_unittest.TestAllTypes", "RProtoBuf:DescriptorPool")) {
+    unittest.proto.file <- system.file("tinytest", "data", "unittest.proto",
+                                       package="RProtoBuf")
+    readProtoFiles(file=unittest.proto.file)
+}
+
+expect_true(inherits(protobuf_unittest.optional_uint32_extension,
+                   "FieldDescriptor"))
+
+## Verify we can pull in other extensions with P()
+expect_true(inherits(P("protobuf_unittest.optional_uint32_extension"),
+                   "FieldDescriptor"))
+
+## Test setting and getting singular extensions.
+test <- new(protobuf_unittest.TestAllExtensions)
+test$setExtension(protobuf_unittest.optional_int32_extension,
+                  as.integer(1))
+expect_equal(test$getExtension(protobuf_unittest.optional_int32_extension),
+            as.integer(1))
+## Unset extensions should return NULL.
+expect_equal(test$getExtension(protobuf_unittest.optional_double_extension),
+            NULL)
+
+
+## Test setting and getting repeated extensions.
+expect_equal(test$getExtension(protobuf_unittest.repeated_int32_extension),
+            NULL)
+test$setExtension(protobuf_unittest.repeated_int32_extension, 1:10)
+expect_equal(test$getExtension(protobuf_unittest.repeated_int32_extension),
+            1:10)
+
+## Test nested extensions.
+expect_equal(test$getExtension(protobuf_unittest.TestNestedExtension.test),
+            NULL)
+test$setExtension(protobuf_unittest.TestNestedExtension.test, "foo")
+expect_equal(test$getExtension(protobuf_unittest.TestNestedExtension.test),
+            "foo")
+
+## Test setting and getting enums.
+test$setExtension(protobuf_unittest.optional_nested_enum_extension,
+                  protobuf_unittest.TestAllTypes.NestedEnum$BAR)
+
+## Test foreign message extensions
+foo <- new(protobuf_unittest.ForeignMessage)
+foo$c <- 3
+test$setExtension(protobuf_unittest.optional_foreign_message_extension,
+                  foo)
+expect_equal(test$getExtension(protobuf_unittest.optional_foreign_message_extension)$c,
+            3)
+
+# This causes an Rcpp exception, but not an R stop error as of my
+# version of Rcpp, so we can't checkError unfortunately, but we
+# can at least make sure it doesn't crash R.
+# TODO(edd): Commented out now
+# test$setExtension(protobuf_unittest.optional_nested_enum_extension, 9)
+
+## Test nested message extensions.
+tmp <- new( protobuf_unittest.TestAllTypes.NestedMessage )
+tmp$bb <- 3
+test$setExtension(protobuf_unittest.optional_nested_message_extension, tmp)
+expect_equal(test$getExtension(protobuf_unittest.optional_nested_message_extension)$bb, 3)
+
+## Check that we do something sensible if invalid field descriptors are passed
+expect_error(test$getExtension(protobuf_unittest.TestAllExtensions))
+expect_error(test$setExtension(protobuf_unittest.TestAllExtensions, 3))
+
+## Check that we don't CHECK fail in C++, but instead give a reasonable
+## error message if incorrect extensions types are provided.
+expect_error(test$getExtension(protobuf_unittest.my_extension_string))
+#}