[Phylobase-commits] r935 - in pkg: inst/unitTests tests/testthat

[noreply at r-forge.r-project.org]

Author: francois
Date: 2014-05-06 22:27:46 +0200 (Tue, 06 May 2014)
New Revision: 935

Added:
   pkg/tests/testthat/test.checkdata.R
Removed:
   pkg/inst/unitTests/runit.checkdata.R
Log:
converted checkdata tests to testthat

Deleted: pkg/inst/unitTests/runit.checkdata.R
===================================================================
--- pkg/inst/unitTests/runit.checkdata.R	2014-05-06 20:26:51 UTC (rev 934)
+++ pkg/inst/unitTests/runit.checkdata.R	2014-05-06 20:27:46 UTC (rev 935)
@@ -1,69 +0,0 @@
-#
-# --- Test checkdata.R ---
-#
-
-if (Sys.getenv("RCMDCHECK") == FALSE) {
-    pth <- file.path(getwd(), "..", "inst", "nexusfiles")
-} else {
-    pth <- system.file(package="phylobase", "nexusfiles")
-}
-## co1.nex -- typical output from MrBayes. Contains 2 identical trees, the first
-## one having posterior probabilities as node labels
-co1File <- file.path(pth, "co1.nex")
-
-# create phylo4 object with a full complement of valid slots
-ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
-descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
-edge <- cbind(ancestor, descendant)
-nid.tip <- 1:5
-nid.int <- 6:9
-nid.all <- c(nid.tip, nid.int)
-lab.tip <- paste("t", nid.tip, sep="")
-lab.int <- paste("n", nid.int, sep="")
-lab.all <- c(lab.tip, lab.int)
-elen <- descendant/10
-elab <- paste("e", ancestor, descendant, sep="-")
-phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
-    edge.length=elen, edge.label=elab)
-
-op <- phylobase.options()
-
-checkPhylo4 <- function() {
-}
-
-checkTree <- function() {
-    ## test polytomies
-    phylobase.options(poly="fail")
-    checkException(readNexus(file=co1File, check.node.labels="drop"))
-    phylobase.options(op)
-
-    ## test retic
-    phylobase.options(retic="fail")
-    edgeRetic <- rbind(edge, c(6, 3))
-    checkException(phy <- phylo4(x=edgeRetic))
-    phylobase.options(op)
-
-    ## test multiroot
-    phylobase.options(multiroot="fail")
-    edgeMultiRoot <- rbind(edge, c(7, 0))
-    checkException(phy <- phylo4(x=edgeMultiRoot))
-    phylobase.options(op)
-
-    ## test singleton
-    phylobase.options(singleton="fail")
-    edgeSingleton <- cbind(c(9,7,7,6,6,8,8,10,10,0), 1:10)
-    checkException(phylo4(x=edgeSingleton))
-    phylobase.options(op)
-}
-
-checkPhylo4Data <- function() {
-}
-
-formatData <- function() {
-    # function(phy, dt, type=c("tip", "internal", "all"),
-    #   match.data=TRUE, label.type=c("rownames", "column"),
-    #   label.column=1, missing.data=c("fail", "warn", "OK"),
-    #   extra.data=c("warn", "OK", "fail"), rownamesAsLabels=FALSE)
-}
-
-

Copied: pkg/tests/testthat/test.checkdata.R (from rev 880, pkg/inst/unitTests/runit.checkdata.R)
===================================================================
--- pkg/tests/testthat/test.checkdata.R	                        (rev 0)
+++ pkg/tests/testthat/test.checkdata.R	2014-05-06 20:27:46 UTC (rev 935)
@@ -0,0 +1,70 @@
+#
+# --- Test checkdata.R ---
+#
+
+if (Sys.getenv("RCMDCHECK") == FALSE) {
+    pth <- file.path(getwd(), "..", "inst", "nexusfiles")
+} else {
+    pth <- system.file(package="phylobase", "nexusfiles")
+}
+## co1.nex -- typical output from MrBayes. Contains 2 identical trees, the first
+## one having posterior probabilities as node labels
+co1File <- file.path(pth, "co1.nex")
+
+# create phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+lab.all <- c(lab.tip, lab.int)
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+    edge.length=elen, edge.label=elab)
+
+op <- phylobase.options()
+
+context("test phylo4 validator/phylobase.options()")
+
+test_that("test polytomies", {
+    phylobase.options(poly="fail")
+    expect_error(readNexus(file=co1File, check.node.labels="drop"))
+    phylobase.options(op)
+})
+
+test_that("test retic", {
+    phylobase.options(retic="fail")
+    edgeRetic <- rbind(edge, c(6, 3))
+    expect_error(phy <- phylo4(x=edgeRetic))
+    phylobase.options(op)
+})
+
+test_that("test multiroot", {
+    phylobase.options(multiroot="fail")
+    edgeMultiRoot <- rbind(edge, c(0, 7))
+    expect_error(phy <- phylo4(x=edgeMultiRoot))
+    phylobase.options(op)
+})
+
+test_that("test singleton", {
+    phylobase.options(singleton="fail")
+    edgeSingleton <- cbind(c(9,7,7,6,6,8,8,10,10,0), 1:10)
+    expect_error(phylo4(x=edgeSingleton))
+    phylobase.options(op)
+})
+
+## checkPhylo4Data <- function() {
+## }
+
+## formatData <- function() {
+##     # function(phy, dt, type=c("tip", "internal", "all"),
+##     #   match.data=TRUE, label.type=c("rownames", "column"),
+##     #   label.column=1, missing.data=c("fail", "warn", "OK"),
+##     #   extra.data=c("warn", "OK", "fail"), rownamesAsLabels=FALSE)
+## }
+
+