R version 3.5.3 (2019-03-11) -- "Great Truth"
Copyright (C) 2019 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> if( require( "RUnit", quietly=TRUE ) ) {
+   pkg <- "xmapbridge"
+ 
+   if( Sys.getenv( "RCMDCHECK" ) == "FALSE" ) {
+     path <- file.path( getwd(), "..", "inst", "unitTests" )
+   }
+   else {
+     path <- system.file( package=pkg, "unitTests" )
+   }
+ 
+   cat( "\nRunning unit tests\n" )
+   print( list( pkg=pkg, getwd=getwd(), pathToUnitTests=path ) )
+   library( package=pkg, character.only=TRUE )
+  
+   testSuite <- defineTestSuite( name=paste( pkg, "unit testing" ), dirs=path )
+   tests <- runTestSuite( testSuite )
+  
+   pathReport <- file.path( path, "report" )
+  
+   cat( "------------------- UNIT TEST SUMMARY ---------------------\n\n" )
+   printTextProtocol( tests, showDetails=FALSE )
+   printTextProtocol( tests, showDetails=FALSE, fileName=paste( pathReport, "Summary.txt", sep="" ) )
+   printTextProtocol( tests, showDetails=TRUE,  fileName=paste( pathReport, ".txt", sep="" ) )
+  
+   printHTMLProtocol( tests, fileName=paste( pathReport, ".html", sep="" ) )
+  
+   tmp <- getErrors( tests )
+   if( tmp$nFail > 0 | tmp$nErr > 0 ) {
+     stop( paste( "\n\nunit testing failed (#test failures: ", tmp$nFail, ", #R errors: ",  tmp$nErr, ")\n\n", sep="" ) )
+   }
+ } else {
+   warning( "cannot run unit tests -- package RUnit is not available" )
+ }

Running unit tests
$pkg
[1] "xmapbridge"

$getwd
[1] "C:/Users/biocbuild/bbs-3.8-bioc/meat/xmapbridge.Rcheck/tests_i386"

$pathToUnitTests
[1] "C:/Users/biocbuild/bbs-3.8-bioc/R/library/xmapbridge/unitTests"



Executing test function test.get.xmap.cache.dir  ...  done successfully.



Executing test function test.graph  ...  done successfully.



Executing test function test.plots  ...  done successfully.



Executing test function test.projects  ...  done successfully.



Executing test function test.utils  ...  done successfully.



Executing test function test.validate.x.and.y  ...  done successfully.

------------------- UNIT TEST SUMMARY ---------------------

RUNIT TEST PROTOCOL -- Sat Apr 13 06:15:39 2019 
*********************************************** 
Number of test functions: 6 
Number of errors: 0 
Number of failures: 0 

 
1 Test Suite : 
xmapbridge unit testing - 6 test functions, 0 errors, 0 failures
> 
> proc.time()
   user  system elapsed 
   1.06    0.40    1.57 

R version 3.5.3 (2019-03-11) -- "Great Truth"
Copyright (C) 2019 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> if( require( "RUnit", quietly=TRUE ) ) {
+   pkg <- "xmapbridge"
+ 
+   if( Sys.getenv( "RCMDCHECK" ) == "FALSE" ) {
+     path <- file.path( getwd(), "..", "inst", "unitTests" )
+   }
+   else {
+     path <- system.file( package=pkg, "unitTests" )
+   }
+ 
+   cat( "\nRunning unit tests\n" )
+   print( list( pkg=pkg, getwd=getwd(), pathToUnitTests=path ) )
+   library( package=pkg, character.only=TRUE )
+  
+   testSuite <- defineTestSuite( name=paste( pkg, "unit testing" ), dirs=path )
+   tests <- runTestSuite( testSuite )
+  
+   pathReport <- file.path( path, "report" )
+  
+   cat( "------------------- UNIT TEST SUMMARY ---------------------\n\n" )
+   printTextProtocol( tests, showDetails=FALSE )
+   printTextProtocol( tests, showDetails=FALSE, fileName=paste( pathReport, "Summary.txt", sep="" ) )
+   printTextProtocol( tests, showDetails=TRUE,  fileName=paste( pathReport, ".txt", sep="" ) )
+  
+   printHTMLProtocol( tests, fileName=paste( pathReport, ".html", sep="" ) )
+  
+   tmp <- getErrors( tests )
+   if( tmp$nFail > 0 | tmp$nErr > 0 ) {
+     stop( paste( "\n\nunit testing failed (#test failures: ", tmp$nFail, ", #R errors: ",  tmp$nErr, ")\n\n", sep="" ) )
+   }
+ } else {
+   warning( "cannot run unit tests -- package RUnit is not available" )
+ }

Running unit tests
$pkg
[1] "xmapbridge"

$getwd
[1] "C:/Users/biocbuild/bbs-3.8-bioc/meat/xmapbridge.Rcheck/tests_x64"

$pathToUnitTests
[1] "C:/Users/biocbuild/bbs-3.8-bioc/R/library/xmapbridge/unitTests"



Executing test function test.get.xmap.cache.dir  ...  done successfully.



Executing test function test.graph  ...  done successfully.



Executing test function test.plots  ...  done successfully.



Executing test function test.projects  ...  done successfully.



Executing test function test.utils  ...  done successfully.



Executing test function test.validate.x.and.y  ...  done successfully.

------------------- UNIT TEST SUMMARY ---------------------

RUNIT TEST PROTOCOL -- Sat Apr 13 06:15:43 2019 
*********************************************** 
Number of test functions: 6 
Number of errors: 0 
Number of failures: 0 

 
1 Test Suite : 
xmapbridge unit testing - 6 test functions, 0 errors, 0 failures
> 
> proc.time()
   user  system elapsed 
   1.39    0.42    1.79 

R version 3.5.3 (2019-03-11) -- "Great Truth"
Copyright (C) 2019 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> #                               8             o      8               
> #                               8                    8               
> #  `o  o' ooYoYo. .oPYo. .oPYo. 8oPYo. oPYo. o8 .oPYo8 .oPYo. .oPYo. 
> #   `bd'  8' 8  8 .oooo8 8    8 8    8 8  `'  8 8    8 8    8 8oooo8 
> #   d'`b  8  8  8 8    8 8    8 8    8 8      8 8    8 8    8 8.     
> #  o'  `o 8  8  8 `YooP8 8YooP' `YooP' 8      8 `YooP' `YooP8 `Yooo' 
> #                        8                                  8        
> #                        8                              YooP'
> #
> # Author:  Tim Yates and Crispin J Miller
> # Date:    2008/08/13
> # Licence: LGPL-v3
> #
> # This file tests all of the exported methods from the library to make sure
> # they work as expected (generate the correct files), fail cleanly as required,
> # and clean up after themselves in case of faliure after a particular file has
> # been created
> #
> 
> library( xmapbridge )
> 
> .test.env <- new.env( hash=TRUE, parent=emptyenv() )
> 
> ###############################################################################
> ## Assert methods (to make the code look a bit cleaner)
> ###############################################################################
> 
> assertEqual <- function( a, b, msg="not equal" ) {
+   if( class( a ) == "list" && class( b ) == "list" ) {
+     if( !isTRUE( all.equal( a, b ) ) ) {
+       stop( msg )
+     }
+   }
+   else if( a != b ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertNotEqual <- function( a, b, msg="equal" ) {
+   if( class( a ) == "list" && class( b ) == "list" ) {
+     if( isTRUE( all.equal( a, b ) ) ) {
+       stop( msg )
+     }
+   }
+   else if( a == b ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertLength <- function( a, len, msg="invalid length" ) {
+   if( length( a ) != len ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertNull <- function( a, msg="is null" ) {
+   if( !is.null( a ) ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertNotNull <- function( a, msg="is not null" ) {
+   if( is.null( a ) ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertNumeric <- function( a, msg="non-numeric" ) {
+   if( !is.number( a ) ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> shouldFail <- function( test, msg=paste( "FAIL:", test ) ) {
+   .ok <- FALSE
+   tryCatch( {
+     test()
+     .ok <- TRUE
+   }, warning=function(e) {
+     print( paste( "caught a warning '", e$message, "'" ) ) 
+   }, error=function(e) {
+     print( paste( "Failed (yay) '", e$message, "'" ) ) 
+   } )
+   if( .ok ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> ###############################################################################
> ## Setup and Teardown Methods
> ###############################################################################
> 
> .setup <- function() {
+   .test.env$tmp  <- tempdir()
+   .test.env$old  <- Sys.getenv( "XMAP_BRIDGE_CACHE" )
+   Sys.setenv( XMAP_BRIDGE_CACHE=.test.env$tmp )
+ }
> 
> .teardown <- function() {
+   # Delete the temp folder, and reset our environment
+   Sys.setenv( XMAP_BRIDGE_CACHE=.test.env$old )
+   unlink( .test.env$tmp, recursive=TRUE )
+ }
> 
> ###############################################################################
> ## And call the tests...
> ###############################################################################
> 
> # Set up the environment
> ###############################################################################
> 
> .setup()
> 
> # Project tests
> ###############################################################################
> 
> shouldFail( function() { xmap.project.load( "FAIL!" ) }, "Invalid project parameter shouldn't work!" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> shouldFail( function() { xmap.project.save( "FAIL!", list() ) }, "Invalid project parameter shouldn't work!" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> shouldFail( function() { xmap.project.delete( "FAIL!" ) }, "Invalid project parameter shouldn't work!" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> 
> .project <- xmap.project.new( "Project A" )
> .projects <- xmap.project.list()
> assertLength( .projects, 1, paste( "Got", length( .projects ), "projects.  Should have only 1" ) )
[1] TRUE
> assertEqual( .project, .projects[[1]], "Project not equal to project in list" )
[1] TRUE
> 
> .data <- xmap.project.load( .project )
> assertNotNull( .data, "Load failed for data" )
[1] TRUE
> assertLength( .data, 1, "Data should have 1 element" )
[1] TRUE
> assertEqual( "Project A", .data$NAME )
[1] TRUE
> .data$NAME <- "Project Z"
> xmap.project.save( .project, .data )
> .data2 <- xmap.project.load( .project )
> assertEqual( "Project Z", .data2$NAME, "Did not load altered project name" )
[1] TRUE
> assertEqual( .data, .data2, "Saved and loaded data not identical!" )
[1] TRUE
> 
> .project2 <- xmap.project.new( "Project B" )
> .projects <- xmap.project.list()
> assertLength( .projects, 2, paste( "Got", length( .projects ), "projects.  Should have 2" ) )
[1] TRUE
> 
> shouldFail( function() { assertEqual( .project, .project2 ) }, paste( "Project 1 and 2 should not be equal" ) )
[1] "Failed (yay) ' not equal '"
[1] TRUE
> assertNotEqual( .project, .project2, paste( "Project 1 and 2 should not be equal" ) )
[1] TRUE
> 
> xmap.project.delete( .project2 )
> 
> .projects <- xmap.project.list()
> assertLength( .projects, 1, paste( "Got", length( .projects ), "projects.  Should have only 1" ) )
[1] TRUE
> 
> # Graph tests
> ###############################################################################
> 
> shouldFail( function() {    xmap.graph.new( "NonProjectObject", "A Graph", "desc", -10, 10, "1", 1000000, 2000000, ylab="label", species="homo_sapiens" ) }, "Invalid project parameter" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> shouldFail( function() {   xmap.graph.load( "FAIL!" )         }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() {   xmap.graph.list( "FAIL!" )         }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> shouldFail( function() {   xmap.graph.save( "FAIL!", list() ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() { xmap.graph.delete( "FAIL!" )         }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() {    xmap.graph.new( .project2, "A Graph", "desc", -10, 10, "1", 1000000, 2000000, ylab="label", species="homo_sapiens" ) }, "Writing to a missing project seeme to work?" )
xmapbridge:Project( C:\Users\biocbuild\bbs-3.8-bioc\tmpdir\RtmpCCfAN9/2019.Apr.13.06.15.40_0.34.xmb ) 
[1] "Failed (yay) ' non-string argument to internal 'paste' '"
[1] TRUE
> 
> .graph <- xmap.graph.new( .project, "A Graph", "desc", -10, 10, "1", 1000000, 2000000, ylab="label", species="homo_sapiens" )
> 
> .graphs <- xmap.graph.list( .project )
> assertLength( .graphs, 1, paste( "Got", length( .graphs ), "graphs.  Should have only 1" ) )
[1] TRUE
> assertEqual( .graph, .graphs[[1]], "Graph not equal to first graph in list" )
[1] TRUE
> 
> .data <- xmap.graph.load( .graph )
> assertNotNull( .data, "Load failed for data" )
[1] TRUE
> assertLength( .data, 9, "Graph data should have 9 elements" )
[1] TRUE
> assertEqual( .data$MIN, -10 )
[1] TRUE
> .data$MIN <- 0
> xmap.graph.save( .graph, .data )
> .data2 <- xmap.graph.load( .graph )
> assertEqual( .data2$MIN, 0 )
[1] TRUE
> assertEqual( .data, .data2, "Saved and loaded graph data not identical!" )
[1] TRUE
> 
> .graph2 <- xmap.graph.new( .project, "A Graph", "desc", -10, 10, "1", 1000000, 2000000, ylab="label", species="homo_sapiens" )
> 
> .graphs <- xmap.graph.list( .project )
> assertLength( .graphs, 2, paste( "Got", length( .graphs ), "graphs.  Should have 2" ) )
[1] TRUE
> 
> xmap.graph.delete( .graph2 )
> 
> # Plot tests
> ###############################################################################
> 
> .X <- seq( 1000000, 2000000, by=1000 )
> .Y <- runif( length( .X ), -10, 10 )
> .badY <- runif( ( length( .X ) - 1 ), -10, 10 )
> .alphaY <- rep( letters, ceiling( length( .X ) / length( letters ) ) )[ 1:length( .X ) ]
> 
> print( paste( ".X has", length( .X ), "elements, .Y has", length( .Y ), ", .badY has", length( .badY ), "elements, and .alphaY has", length( .alphaY ), "elements" ) )
[1] ".X has 1001 elements, .Y has 1001 , .badY has 1000 elements, and .alphaY has 1001 elements"
> 
> shouldFail( function() {    xmap.plot.new( "FAIL!", "A Plot", .X, .Y, type="line" ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() {   xmap.plot.load( "FAIL!" )                 }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' plotid should be an object of class Plot, not character '"
[1] TRUE
> shouldFail( function() {   xmap.plot.list( "FAIL!" )                 }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() {   xmap.plot.save( "FAIL!", list(), .X, .Y ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' plotid should be an object of class Plot, not character '"
[1] TRUE
> shouldFail( function() { xmap.plot.delete( "FAIL!" )                 }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' plotid should be an object of class Plot, not character '"
[1] TRUE
> shouldFail( function() {    xmap.plot.new( .graph2, "A Plot", .X, .Y, type="line" ) }, "Invalid graph parameter shouldn't work!" )
xmapbridge:Project( C:\Users\biocbuild\bbs-3.8-bioc\tmpdir\RtmpCCfAN9/2019.Apr.13.06.15.40_0.26.xmb ) 
[1] "Failed (yay) ' non-string argument to internal 'paste' '"
[1] TRUE
> shouldFail( function() {    xmap.plot.new( .graph, "A Plot", .X, .badY, type="line" ) }, "Invalid y list size shouldn't work!" )
[1] "Failed (yay) ' 'x' and 'y' lengths differ '"
[1] TRUE
> 
> .plot <- xmap.plot.new( .graph, "A Plot", .X, .Y, type="line" )
> 
> .plots <- xmap.plot.list( .graph )
> assertLength( .plots, 1, paste( "Got", length( .plots ), "plots.  Should have only 1" ) )
[1] TRUE
> assertEqual( .plot, .plots[[1]], "Plot does not equal the first plot in the list" )
[1] TRUE
> 
> .data <- xmap.plot.load( .plot )
> assertNotNull( .data, "Load failed for plot data" )
[1] TRUE
> shouldFail( function() { assertLength( .data, 0 ) }, "Plot data should have more than 0 elements" )
[1] "Failed (yay) ' invalid length '"
[1] TRUE
> assertEqual( .data$TYPE, "line", "Plot type should be 'line'" )
[1] TRUE
> .data$TYPE <- "area"
> xmap.plot.save( .plot, .data, .X, .Y )
> .data2 <- xmap.plot.load( .plot )
> assertEqual( .data2$TYPE, "area", "Plot type should now be 'area'" )
[1] TRUE
> assertEqual( .data, .data2, "Saved and loaded plot data not identical!" )
[1] TRUE
> 
> .plot2 <- xmap.plot.new( .graph, "A Plot", .X, .Y, type="line" )
> 
> .plots <- xmap.plot.list( .graph )
> assertLength( .plots, 2, paste( "Got", length( .plots ), "plots.  Should have only 2" ) )
[1] TRUE
> 
> xmap.plot.delete( .plot )
> .plots <- xmap.plot.list( .graph )
> assertLength( .plots, 1, paste( "Got", length( .plots ), "plots.  Should have only 1" ) )
[1] TRUE
> 
> # Util tests
> ###############################################################################
> 
> shouldFail( function() { xmap.plot( .X, .badY, species="homo_sapiens", "1", type="line" ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' 'x' and 'y' lengths differ '"
[1] TRUE
> shouldFail( function() { xmap.plot( .X, .alphaY, species="homo_sapiens", "1", type="line" ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' y seems to contain non-numerics '"
[1] TRUE
> shouldFail( function() { xmap.plot( .X, .Y, species="homo_sapiens", "1", type="INVALID" ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' 'arg' should be one of \"scatter\", \"line\", \"bar\", \"step\", \"area\", \"steparea\" [dg] [dp] '"
[1] TRUE
> shouldFail( function() { xmap.plot( .X, .Y, species="MONKEY", "1" ) }, "Invalid species parameter shouldn't work!" )
[1] "Failed (yay) ' 'arg' should be one of \"homo_sapiens\", \"mus_musculus\", \"rattus_norvegicus\" '"
[1] TRUE
> shouldFail( function() { xmap.plot( .X, .Y, species="homo_sapiens" ) }, "Missing chromosome should have failed!" )
[1] "Failed (yay) ' You need to specify a chromosome for this plot '"
[1] TRUE
> .projects <- xmap.project.list()
> assertLength( .projects, 1, paste( "Got", length( .projects ), "projects.  There should still just be 1" ) )
[1] TRUE
> 
> .plot <- xmap.plot( .X, .Y, chr="1" )
> .projects <- xmap.project.list()
> assertLength( .projects, 2, paste( "Got", length( .projects ), "projects.  There should be 2" ) )
[1] TRUE
> 
> .graphs <- xmap.graph.list( .plot )
> assertLength( .graphs, 1, paste( "Got", length( .graphs ), "graphs.  There should be 1" ) )
[1] TRUE
> 
> .graph <- xmap.points( .X, .Y )
> .plots <- xmap.plot.list( .plot )
> assertLength( .plots, 2, paste( "Got", length( .plots ), "plots.  There should be 2" ) )
[1] TRUE
> 
> xmap.project.delete( .project )
> xmap.project.delete( .plot )
> .projects <- xmap.project.list()
> assertLength( .projects, 0, paste( "Got", length( .projects ), "projects.  There shouldn't be any" ) )
[1] TRUE
> 
> # Cleanup
> ###############################################################################
> 
> .teardown()
> 
> proc.time()
   user  system elapsed 
   0.92    0.48    1.39 

R version 3.5.3 (2019-03-11) -- "Great Truth"
Copyright (C) 2019 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> #                               8             o      8               
> #                               8                    8               
> #  `o  o' ooYoYo. .oPYo. .oPYo. 8oPYo. oPYo. o8 .oPYo8 .oPYo. .oPYo. 
> #   `bd'  8' 8  8 .oooo8 8    8 8    8 8  `'  8 8    8 8    8 8oooo8 
> #   d'`b  8  8  8 8    8 8    8 8    8 8      8 8    8 8    8 8.     
> #  o'  `o 8  8  8 `YooP8 8YooP' `YooP' 8      8 `YooP' `YooP8 `Yooo' 
> #                        8                                  8        
> #                        8                              YooP'
> #
> # Author:  Tim Yates and Crispin J Miller
> # Date:    2008/08/13
> # Licence: LGPL-v3
> #
> # This file tests all of the exported methods from the library to make sure
> # they work as expected (generate the correct files), fail cleanly as required,
> # and clean up after themselves in case of faliure after a particular file has
> # been created
> #
> 
> library( xmapbridge )
> 
> .test.env <- new.env( hash=TRUE, parent=emptyenv() )
> 
> ###############################################################################
> ## Assert methods (to make the code look a bit cleaner)
> ###############################################################################
> 
> assertEqual <- function( a, b, msg="not equal" ) {
+   if( class( a ) == "list" && class( b ) == "list" ) {
+     if( !isTRUE( all.equal( a, b ) ) ) {
+       stop( msg )
+     }
+   }
+   else if( a != b ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertNotEqual <- function( a, b, msg="equal" ) {
+   if( class( a ) == "list" && class( b ) == "list" ) {
+     if( isTRUE( all.equal( a, b ) ) ) {
+       stop( msg )
+     }
+   }
+   else if( a == b ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertLength <- function( a, len, msg="invalid length" ) {
+   if( length( a ) != len ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertNull <- function( a, msg="is null" ) {
+   if( !is.null( a ) ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertNotNull <- function( a, msg="is not null" ) {
+   if( is.null( a ) ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> assertNumeric <- function( a, msg="non-numeric" ) {
+   if( !is.number( a ) ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> shouldFail <- function( test, msg=paste( "FAIL:", test ) ) {
+   .ok <- FALSE
+   tryCatch( {
+     test()
+     .ok <- TRUE
+   }, warning=function(e) {
+     print( paste( "caught a warning '", e$message, "'" ) ) 
+   }, error=function(e) {
+     print( paste( "Failed (yay) '", e$message, "'" ) ) 
+   } )
+   if( .ok ) {
+     stop( msg )
+   }
+   TRUE
+ }
> 
> ###############################################################################
> ## Setup and Teardown Methods
> ###############################################################################
> 
> .setup <- function() {
+   .test.env$tmp  <- tempdir()
+   .test.env$old  <- Sys.getenv( "XMAP_BRIDGE_CACHE" )
+   Sys.setenv( XMAP_BRIDGE_CACHE=.test.env$tmp )
+ }
> 
> .teardown <- function() {
+   # Delete the temp folder, and reset our environment
+   Sys.setenv( XMAP_BRIDGE_CACHE=.test.env$old )
+   unlink( .test.env$tmp, recursive=TRUE )
+ }
> 
> ###############################################################################
> ## And call the tests...
> ###############################################################################
> 
> # Set up the environment
> ###############################################################################
> 
> .setup()
> 
> # Project tests
> ###############################################################################
> 
> shouldFail( function() { xmap.project.load( "FAIL!" ) }, "Invalid project parameter shouldn't work!" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> shouldFail( function() { xmap.project.save( "FAIL!", list() ) }, "Invalid project parameter shouldn't work!" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> shouldFail( function() { xmap.project.delete( "FAIL!" ) }, "Invalid project parameter shouldn't work!" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> 
> .project <- xmap.project.new( "Project A" )
> .projects <- xmap.project.list()
> assertLength( .projects, 1, paste( "Got", length( .projects ), "projects.  Should have only 1" ) )
[1] TRUE
> assertEqual( .project, .projects[[1]], "Project not equal to project in list" )
[1] TRUE
> 
> .data <- xmap.project.load( .project )
> assertNotNull( .data, "Load failed for data" )
[1] TRUE
> assertLength( .data, 1, "Data should have 1 element" )
[1] TRUE
> assertEqual( "Project A", .data$NAME )
[1] TRUE
> .data$NAME <- "Project Z"
> xmap.project.save( .project, .data )
> .data2 <- xmap.project.load( .project )
> assertEqual( "Project Z", .data2$NAME, "Did not load altered project name" )
[1] TRUE
> assertEqual( .data, .data2, "Saved and loaded data not identical!" )
[1] TRUE
> 
> .project2 <- xmap.project.new( "Project B" )
> .projects <- xmap.project.list()
> assertLength( .projects, 2, paste( "Got", length( .projects ), "projects.  Should have 2" ) )
[1] TRUE
> 
> shouldFail( function() { assertEqual( .project, .project2 ) }, paste( "Project 1 and 2 should not be equal" ) )
[1] "Failed (yay) ' not equal '"
[1] TRUE
> assertNotEqual( .project, .project2, paste( "Project 1 and 2 should not be equal" ) )
[1] TRUE
> 
> xmap.project.delete( .project2 )
> 
> .projects <- xmap.project.list()
> assertLength( .projects, 1, paste( "Got", length( .projects ), "projects.  Should have only 1" ) )
[1] TRUE
> 
> # Graph tests
> ###############################################################################
> 
> shouldFail( function() {    xmap.graph.new( "NonProjectObject", "A Graph", "desc", -10, 10, "1", 1000000, 2000000, ylab="label", species="homo_sapiens" ) }, "Invalid project parameter" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> shouldFail( function() {   xmap.graph.load( "FAIL!" )         }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() {   xmap.graph.list( "FAIL!" )         }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' projectid should be an object of class Project, not character '"
[1] TRUE
> shouldFail( function() {   xmap.graph.save( "FAIL!", list() ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() { xmap.graph.delete( "FAIL!" )         }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() {    xmap.graph.new( .project2, "A Graph", "desc", -10, 10, "1", 1000000, 2000000, ylab="label", species="homo_sapiens" ) }, "Writing to a missing project seeme to work?" )
xmapbridge:Project( C:\Users\biocbuild\bbs-3.8-bioc\tmpdir\RtmpkzTaVA/2019.Apr.13.06.15.43_0.4.xmb ) 
[1] "Failed (yay) ' non-string argument to internal 'paste' '"
[1] TRUE
> 
> .graph <- xmap.graph.new( .project, "A Graph", "desc", -10, 10, "1", 1000000, 2000000, ylab="label", species="homo_sapiens" )
> 
> .graphs <- xmap.graph.list( .project )
> assertLength( .graphs, 1, paste( "Got", length( .graphs ), "graphs.  Should have only 1" ) )
[1] TRUE
> assertEqual( .graph, .graphs[[1]], "Graph not equal to first graph in list" )
[1] TRUE
> 
> .data <- xmap.graph.load( .graph )
> assertNotNull( .data, "Load failed for data" )
[1] TRUE
> assertLength( .data, 9, "Graph data should have 9 elements" )
[1] TRUE
> assertEqual( .data$MIN, -10 )
[1] TRUE
> .data$MIN <- 0
> xmap.graph.save( .graph, .data )
> .data2 <- xmap.graph.load( .graph )
> assertEqual( .data2$MIN, 0 )
[1] TRUE
> assertEqual( .data, .data2, "Saved and loaded graph data not identical!" )
[1] TRUE
> 
> .graph2 <- xmap.graph.new( .project, "A Graph", "desc", -10, 10, "1", 1000000, 2000000, ylab="label", species="homo_sapiens" )
> 
> .graphs <- xmap.graph.list( .project )
> assertLength( .graphs, 2, paste( "Got", length( .graphs ), "graphs.  Should have 2" ) )
[1] TRUE
> 
> xmap.graph.delete( .graph2 )
> 
> # Plot tests
> ###############################################################################
> 
> .X <- seq( 1000000, 2000000, by=1000 )
> .Y <- runif( length( .X ), -10, 10 )
> .badY <- runif( ( length( .X ) - 1 ), -10, 10 )
> .alphaY <- rep( letters, ceiling( length( .X ) / length( letters ) ) )[ 1:length( .X ) ]
> 
> print( paste( ".X has", length( .X ), "elements, .Y has", length( .Y ), ", .badY has", length( .badY ), "elements, and .alphaY has", length( .alphaY ), "elements" ) )
[1] ".X has 1001 elements, .Y has 1001 , .badY has 1000 elements, and .alphaY has 1001 elements"
> 
> shouldFail( function() {    xmap.plot.new( "FAIL!", "A Plot", .X, .Y, type="line" ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() {   xmap.plot.load( "FAIL!" )                 }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' plotid should be an object of class Plot, not character '"
[1] TRUE
> shouldFail( function() {   xmap.plot.list( "FAIL!" )                 }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' graphid should be an object of class Graph, not character '"
[1] TRUE
> shouldFail( function() {   xmap.plot.save( "FAIL!", list(), .X, .Y ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' plotid should be an object of class Plot, not character '"
[1] TRUE
> shouldFail( function() { xmap.plot.delete( "FAIL!" )                 }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' plotid should be an object of class Plot, not character '"
[1] TRUE
> shouldFail( function() {    xmap.plot.new( .graph2, "A Plot", .X, .Y, type="line" ) }, "Invalid graph parameter shouldn't work!" )
xmapbridge:Project( C:\Users\biocbuild\bbs-3.8-bioc\tmpdir\RtmpkzTaVA/2019.Apr.13.06.15.43_0.32.xmb ) 
[1] "Failed (yay) ' non-string argument to internal 'paste' '"
[1] TRUE
> shouldFail( function() {    xmap.plot.new( .graph, "A Plot", .X, .badY, type="line" ) }, "Invalid y list size shouldn't work!" )
[1] "Failed (yay) ' 'x' and 'y' lengths differ '"
[1] TRUE
> 
> .plot <- xmap.plot.new( .graph, "A Plot", .X, .Y, type="line" )
> 
> .plots <- xmap.plot.list( .graph )
> assertLength( .plots, 1, paste( "Got", length( .plots ), "plots.  Should have only 1" ) )
[1] TRUE
> assertEqual( .plot, .plots[[1]], "Plot does not equal the first plot in the list" )
[1] TRUE
> 
> .data <- xmap.plot.load( .plot )
> assertNotNull( .data, "Load failed for plot data" )
[1] TRUE
> shouldFail( function() { assertLength( .data, 0 ) }, "Plot data should have more than 0 elements" )
[1] "Failed (yay) ' invalid length '"
[1] TRUE
> assertEqual( .data$TYPE, "line", "Plot type should be 'line'" )
[1] TRUE
> .data$TYPE <- "area"
> xmap.plot.save( .plot, .data, .X, .Y )
> .data2 <- xmap.plot.load( .plot )
> assertEqual( .data2$TYPE, "area", "Plot type should now be 'area'" )
[1] TRUE
> assertEqual( .data, .data2, "Saved and loaded plot data not identical!" )
[1] TRUE
> 
> .plot2 <- xmap.plot.new( .graph, "A Plot", .X, .Y, type="line" )
> 
> .plots <- xmap.plot.list( .graph )
> assertLength( .plots, 2, paste( "Got", length( .plots ), "plots.  Should have only 2" ) )
[1] TRUE
> 
> xmap.plot.delete( .plot )
> .plots <- xmap.plot.list( .graph )
> assertLength( .plots, 1, paste( "Got", length( .plots ), "plots.  Should have only 1" ) )
[1] TRUE
> 
> # Util tests
> ###############################################################################
> 
> shouldFail( function() { xmap.plot( .X, .badY, species="homo_sapiens", "1", type="line" ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' 'x' and 'y' lengths differ '"
[1] TRUE
> shouldFail( function() { xmap.plot( .X, .alphaY, species="homo_sapiens", "1", type="line" ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' y seems to contain non-numerics '"
[1] TRUE
> shouldFail( function() { xmap.plot( .X, .Y, species="homo_sapiens", "1", type="INVALID" ) }, "Invalid graph parameter shouldn't work!" )
[1] "Failed (yay) ' 'arg' should be one of \"scatter\", \"line\", \"bar\", \"step\", \"area\", \"steparea\" [dg] [dp] '"
[1] TRUE
> shouldFail( function() { xmap.plot( .X, .Y, species="MONKEY", "1" ) }, "Invalid species parameter shouldn't work!" )
[1] "Failed (yay) ' 'arg' should be one of \"homo_sapiens\", \"mus_musculus\", \"rattus_norvegicus\" '"
[1] TRUE
> shouldFail( function() { xmap.plot( .X, .Y, species="homo_sapiens" ) }, "Missing chromosome should have failed!" )
[1] "Failed (yay) ' You need to specify a chromosome for this plot '"
[1] TRUE
> .projects <- xmap.project.list()
> assertLength( .projects, 1, paste( "Got", length( .projects ), "projects.  There should still just be 1" ) )
[1] TRUE
> 
> .plot <- xmap.plot( .X, .Y, chr="1" )
> .projects <- xmap.project.list()
> assertLength( .projects, 2, paste( "Got", length( .projects ), "projects.  There should be 2" ) )
[1] TRUE
> 
> .graphs <- xmap.graph.list( .plot )
> assertLength( .graphs, 1, paste( "Got", length( .graphs ), "graphs.  There should be 1" ) )
[1] TRUE
> 
> .graph <- xmap.points( .X, .Y )
> .plots <- xmap.plot.list( .plot )
> assertLength( .plots, 2, paste( "Got", length( .plots ), "plots.  There should be 2" ) )
[1] TRUE
> 
> xmap.project.delete( .project )
> xmap.project.delete( .plot )
> .projects <- xmap.project.list()
> assertLength( .projects, 0, paste( "Got", length( .projects ), "projects.  There shouldn't be any" ) )
[1] TRUE
> 
> # Cleanup
> ###############################################################################
> 
> .teardown()
> 
> proc.time()
   user  system elapsed 
   1.12    0.62    1.73