Refactor migrate.project() and fix version tests (#162)

* add relevant files from cacherawdata branch to seperate out migrate.project() and test-version files * Refactored migrate.project() to allow more precise checks, actions and messages during migration * Added user messages instead of warnings to migrate.project. Also updated existing test to expect message rather than warning * Added some migration specific tests. Needed a refactor of default.config function and also moved the tidy_up() function into the run-all script so it can be accessed in different tests * remove rogue project template created in test folder * moved tidy_up() into each of the testing contexts due to failures on the travis checks on github * fixed a missing man file for default.config
KentonWhite · Oct 31, 2016 · 62937da · 62937da
1 parent 73652e6
commit 62937da
Show file tree

Hide file tree

Showing 5 changed files with 256 additions and 34 deletions.
diff --git a/R/default.config.R b/R/default.config.R
@@ -1,7 +1,10 @@
+.default.config.file <- system.file('defaults/config/default.dcf', package = 'ProjectTemplate')
+
+
 #' Default configuration
 #'
 #' This list stores the configuration used for missing items
 #' in the configuration of the current project.
 #'
 #' @include translate.dcf.R
-default.config <- translate.dcf(system.file('defaults/config/default.dcf', package = 'ProjectTemplate'))
+default.config <- translate.dcf(.default.config.file)
diff --git a/R/load.project.R b/R/load.project.R
@@ -262,12 +262,13 @@ load.project <- function(override.config = NULL)
   }
 }
 
+.config.path <- file.path('config', 'global.dcf')
+
 .load.config <- function(override.config = NULL) {
-  config.path <- file.path('config', 'global.dcf')
-  config <- if (file.exists(config.path)) {
-    translate.dcf(config.path)
+  config <- if (file.exists(.config.path)) {
+    translate.dcf(.config.path)
   } else {
-    warning('You are missing a configuration file: ', config.path, ' . Defaults will be used.')
+    warning('You are missing a configuration file: ', .config.path, ' . Defaults will be used.')
     default.config
   }
 

diff --git a/R/migrate.project.R b/R/migrate.project.R
@@ -21,14 +21,118 @@ migrate.project <- function()
 
   message('Migrating project configuration')
 
-  config <- .load.config()
+  # Load the config and look for specific problems in the configuration that
+  # should be fixed (e.g. missing files, missing config item)
+  # Also flag up if any items need special handling during migration (for example
+  # if something other than the default is appropriate for existing projects)
+
+  # Initialise migration flags
+  config_conflicts <- FALSE
+  config_warnings <- NULL
+
+
+  # Flags stored in environment env
+  env <- environment()
+
+  # Detect any conflicts with the existing config file once it has been processed
+  # during load.project() (flag for now and handle later on)
+
+  loaded.config <- tryCatch(.load.config(),
+                      warning=function(w) {
+                          # set up some variables to help process the 
+                          # migration warnings later
+
+                          assign("config_conflicts", TRUE, envir = env)
+                          assign("config_warnings", w$message, envir = env)
+                          suppressWarnings(.load.config())
+                      })
+
+  # Detect other migration issues 
+
+
 
-  if (.check.version(config, warn.migrate = FALSE) == 0) {
-    message("Already up to date.")
-    return(invisible(NULL))
+  # Exit if everything up to date
+  if ((
+          .check.version(loaded.config, warn.migrate = FALSE) == 0) 
+       && !config_conflicts
+      ) {
+          message("Already up to date.")
+          return(invisible(NULL))
   }
+
+  # Otherwise ....
+
+  # Process config conflicts
+  if (config_conflicts) {
+
+          # Tell the user about problems with their old config
+
+          message(paste0(c(
+                  "Your existing project configuration in globals.dcf does not contain up to",
+                  paste0("date configuration settings in this version ",
+                  .package.version(),
+                  " of ProjectTemplate.  They will"),
+                  "be added automatically during migration, but you should review afterward."
+                  ),
+                  collapse="\n"))
+
+          if(grepl("missing a configuration file", config_warnings)) {
+                  message(paste0(c(
+                          "You didn't have a config.dcf file.  One has been created",
+                          "for you using default values"
+                          ),
+                  collapse="\n"))
+          }
+
+
+          if(grepl("missing the following entries", config_warnings)) {
+                  message(paste0(c(
+                          "Your config.dcf file was missing entries and defaults",
+                          "have been used.  The missing entries are:"
+                          ),
+                  collapse="\n"))
+                  missing <- sub(".*missing the following entries:([^.]*)\\.(.*)$", "\\1", config_warnings)
+                  message(missing)
+          }
+
+          if(grepl("contains the following unused entries", config_warnings)) {
+                  message(paste0(c(
+                          "Your config.dcf file contained unused entries which have been",
+                          "removed.  The unused entries are:"
+                          ),
+                  collapse="\n"))
+                  unused <- sub(".*contains the following unused entries:([^.]*)\\.(.*)$", "\\1", config_warnings)
+                  message(unused)
+          }
+
+
+          # Specific logic here for new config items that need special migration treatment
+
+
+  }
+
+  # Process other migration conflicts
+
+
+
+  # Finally, save the validated configuration with the updated version number
+  .save.config(loaded.config)   
+
+}
 
-  config$version <- .package.version()
-  write.dcf(config, 'config/global.dcf')
 
+# save config and update package version
+.save.config <- function (config) {
+        config$version <- .package.version()
+        write.dcf(config, .config.path)
 }
+
+# read in a config file and return a config object
+.read.config <- function (file=.config.path) {
+        config <- translate.dcf(file)
+        config <- .normalize.config(config,
+                          setdiff(names(default.config), c("version", "libraries", "logging_level")),
+                          .boolean.cfg)
+        config
+}
+
diff --git a/tests/testthat/test-migration.R b/tests/testthat/test-migration.R
@@ -1,5 +1,12 @@
 context('Migration')
 
+# Function to tidy up at the end of tests
+tidy_up <- function () {
+        objs <- setdiff(ls(envir = .TargetEnv), "tidy_up")
+        rm(list = objs, envir = .TargetEnv)
+}
+
+
 expect_defaults <- function(config) {
   expect_true(is.character(config$version))
   expect_true(config$attach_internal_libraries)
@@ -18,9 +25,109 @@ lapply(
       expect_that(suppressMessages(load.project()), gives_warning("migrate.project"))
       on.exit(.unload.project(), add = TRUE)
 
-      expect_warning(suppressMessages(migrate.project()), "missing the following entries")
+      expect_message(migrate.project(), "file was missing entries")
       expect_warning(suppressMessages(load.project()), NA)
       expect_defaults(get.project()$config)
     })
   }
 )
+
+test_that('migrating a project which doesnt need config update results in an Up to date message', {
+
+        test_project <- tempfile('test_project')
+        suppressMessages(create.project(test_project, minimal = FALSE))
+        on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+        oldwd <- setwd(test_project)
+        on.exit(setwd(oldwd), add = TRUE)
+
+        # should be nothing
+        expect_message(migrate.project(), "Already up to date")
+        tidy_up()
+})
+
+
+test_that('migrating a project with a missing config file results in a message to user', {
+
+        test_project <- tempfile('test_project')
+        suppressMessages(create.project(test_project, minimal = FALSE))
+        on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+        oldwd <- setwd(test_project)
+        on.exit(setwd(oldwd), add = TRUE)
+
+        # remove the config file
+        unlink('config/global.dcf')
+
+        # should be a message to say no config file
+        expect_message(migrate.project(), "didn't have a config\\.dcf file")
+
+
+        suppressMessages(load.project())
+
+        # Get the default config
+        default_config <- .read.config(.default.config.file)
+        default_config$version <- .package.version()
+
+        # check the config is all the default
+        expect_equal(get.project()$config, default_config)
+
+        tidy_up()
+})
+
+
+
+test_that('migrating a project with a missing config item results in a message to user', {
+
+        test_project <- tempfile('test_project')
+        suppressMessages(create.project(test_project, minimal = FALSE))
+        on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+        oldwd <- setwd(test_project)
+        on.exit(setwd(oldwd), add = TRUE)
+
+        suppressMessages(load.project())
+
+        # remove the config item
+        config$data_loading <- NULL
+        .save.config(config)
+
+        # should be a message to say no config item
+        expect_message(migrate.project(), "data_loading")
+
+        suppressMessages(load.project())
+
+        # check the missing config item is the default value
+        default_config <- .read.config(.default.config.file)
+        expect_equal(get.project()$config$data_loading, default_config$data_loading)
+
+        tidy_up()
+})
+
+
+test_that('migrating a project with a dummy config item results in a message to user', {
+
+        test_project <- tempfile('test_project')
+        suppressMessages(create.project(test_project, minimal = FALSE))
+        on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+        oldwd <- setwd(test_project)
+        on.exit(setwd(oldwd), add = TRUE)
+
+        suppressMessages(load.project())
+
+        # add the dummy config item
+        config$dummy <- TRUE
+        .save.config(config)
+
+        # should be a message to say no config item
+        expect_message(migrate.project(), "dummy")
+
+        suppressMessages(load.project())
+
+        # check that the dummy config item is not in the config
+        expect_null(get.project()$config$dummy)
+
+        tidy_up()
+})
+
diff --git a/tests/testthat/test-version.R b/tests/testthat/test-version.R
@@ -1,23 +1,25 @@
 context('Version field')
 
 test_that('Test matching version field', {
-
-  suppressMessages(create.project('test_project', minimal = TRUE))
-  setwd('test_project')
-  on.exit(setwd('..'), add = TRUE)
-  on.exit(unlink('test_project', recursive = TRUE), add = TRUE)
-
+  test_project <- tempfile('test_project')
+  suppressMessages(create.project(test_project, minimal = TRUE))
+  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+  oldwd <- setwd(test_project)
+  on.exit(setwd(oldwd), add = TRUE)
+
   expect_warning(suppressMessages(load.project()), NA)
 
 })
 
 test_that('Test too old version of ProjectTemplate', {
-
-  suppressMessages(create.project('test_project', minimal = TRUE))
-  setwd('test_project')
-  on.exit(setwd('..'), add = TRUE)
-  on.exit(unlink('test_project', recursive = TRUE), add = TRUE)
-
+  test_project <- tempfile('test_project')
+  suppressMessages(create.project(test_project, minimal = TRUE))
+  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+  oldwd <- setwd(test_project)
+  on.exit(setwd(oldwd), add = TRUE)
+
   config <- new.config
   config$version <- paste0('1', config$version)
   write.dcf(config, 'config/global.dcf')
@@ -28,10 +30,12 @@ test_that('Test too old version of ProjectTemplate', {
 
 test_that('Test new version of ProjectTemplate', {
 
-  suppressMessages(create.project('test_project', minimal = TRUE))
-  setwd('test_project')
-  on.exit(setwd('..'), add = TRUE)
-  on.exit(unlink('test_project', recursive = TRUE), add = TRUE)
+  test_project <- tempfile('test_project')
+  suppressMessages(create.project(test_project, minimal = TRUE))
+  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+  oldwd <- setwd(test_project)
+  on.exit(setwd(oldwd), add = TRUE)
 
   config <- new.config
   config$version <- '0.4'
@@ -43,12 +47,15 @@ test_that('Test new version of ProjectTemplate', {
 })
 
 test_that('Test migration', {
-
-  suppressMessages(create.project('test_project', minimal = TRUE))
-  setwd('test_project')
-  on.exit(setwd('..'), add = TRUE)
-  on.exit(unlink('test_project', recursive = TRUE), add = TRUE)
-
+
+  test_project <- tempfile('test_project')
+  suppressMessages(create.project(test_project, minimal = TRUE))
+  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+  oldwd <- setwd(test_project)
+  on.exit(setwd(oldwd), add = TRUE)
+
+
   config <- new.config
   expect_true("version" %in% names(config))
   config$version <- '0.4'