From 4829fbd42b161b0748f62c57156f04cee528027a Mon Sep 17 00:00:00 2001
From: Florian Angerer <florian.angerer@oracle.com>
Date: Mon, 11 Sep 2017 16:58:35 +0200
Subject: [PATCH] First version of snapshotting package w/o using variable
names.
---
com.oracle.truffle.r.pkgs/refcmp/NAMESPACE | 2 +
com.oracle.truffle.r.pkgs/refcmp/R/refcmp.R | 68 ++++++++++++++++-----
2 files changed, 55 insertions(+), 15 deletions(-)
diff --git a/com.oracle.truffle.r.pkgs/refcmp/NAMESPACE b/com.oracle.truffle.r.pkgs/refcmp/NAMESPACE
index 4fc3a467e1..211930545b 100644
--- a/com.oracle.truffle.r.pkgs/refcmp/NAMESPACE
+++ b/com.oracle.truffle.r.pkgs/refcmp/NAMESPACE
@@ -2,3 +2,5 @@
export(snapshot)
export(snapshot.init)
+export(snapshot_id)
+export(snapshot.show)
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/refcmp.R b/com.oracle.truffle.r.pkgs/refcmp/R/refcmp.R
index cfee528e3a..254bbe0c51 100644
--- a/com.oracle.truffle.r.pkgs/refcmp/R/refcmp.R
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/refcmp.R
@@ -22,7 +22,7 @@
##
refcmpEnv <- new.env(parent = emptyenv())
-refcmpEnv$reference_filename <- 'reference_values.obj'
+refcmpEnv$snapshot_dir <- 'snapshots'
refcmpEnv$snapshot_id <- 0L
snapshot.isFastR <- function() {
@@ -30,31 +30,69 @@ snapshot.isFastR <- function() {
}
refcmpEnv$isReferenceRun <- function() !snapshot.isFastR()
-snaphost.init <- function(filename) {
- if(!missing(filename)) {
- refcmpEnv$reference_filename <- filename
- } else {
- }
-}
-
-snaphost.has_reference_run <- function(...) {
+snapshot.init <- function(dir) {
+ if(!missing(dir)) {
+ refcmpEnv$snaphost_dir <- dir
+ }
+ refcmpEnv$snapshot_id <- 0
}
snapshot <- function(...) {
vars <- list(...)
+ try({
+ snapshot_id(refcmpEnv$snapshot_id, vars)
+ refcmpEnv$snapshot_id <- refcmpEnv$snapshot_id + 1
+ })
+}
- if(recmpEnv$isReferenceRun()) {
- snapshot.record(vars)
+snapshot_id <- function(id, vars) {
+ if(refcmpEnv$isReferenceRun()) {
+ snapshot.record(id, vars)
} else {
- snapshot.check(vars)
+ snapshot.check(id, vars)
}
}
-snapshot.record <- function(vars) {
- fcon <- file(refcmpEnv$reference_filename
+snapshot.record <- function(id, vars) {
+ dumpDir <- file.path(refcmpEnv$snapshot_dir)
+ if(!dir.exists(dumpDir)) {
+ dir.create(dumpDir)
+ }
+ fcon <- file(file.path(refcmpEnv$snapshot_dir, paste0("snapshot", id, ".obj")))
+ saveRDS(vars, file=fcon)
+ close(fcon)
+}
+snapshot.check <- function(id, vars) {
+ fcon <- file(file.path(refcmpEnv$snapshot_dir, paste0("snapshot", id, ".obj")))
+ restoredVars <- readRDS(file=fcon)
+ close(fcon)
+
+ if(length(restoredVars) < length(vars)) {
+ stop(paste("recorded snapshot has", length(restoredVars), "recorded variables but expected", length(vars)))
+ }
+
+ var_names <- names(vars)
+ restored_names <- names(restoredVars)
+ for(i in seq_along(var_names)) {
+ if(var_names[[i]] %in% restored_names) {
+ actualVal <- vars[[var_names[[i]]]]
+ expectedVal <- restoredVars[[var_names[[i]]]]
+ if(actualVal != expectedVal) {
+ stop(paste0("Value of variable '", var_names[[i]], "' differs. Expected ", expectedVal, " but was ", actualVal))
+ }
+ } else {
+ stop(paste0("Missing variable '", var_names[[i]], "' in recorded variables"))
+ }
+
+ }
}
-snapshot.check <- function(vars) {
+snapshot.show <- function(id = refcmpEnv$snapshot_id) {
+ fcon <- file(file.path(refcmpEnv$snapshot_dir, paste0("snapshot", id, ".obj")))
+ restoredVars <- readRDS(file=fcon)
+ close(fcon)
+
+ restoredVars
}
--
GitLab