[GR-16210] Fix parsing of doubles and update CHANGELOG.

PullRequest: fastr/2048

Author: steve-s

.gitignore

@@ -156,3 +156,4 @@ install.tmp.gnur
 lib.install.packages.fastr
 lib.install.packages.gnur
 /com.oracle.truffle.r.release/doc/
+.Rproj.user

CHANGELOG.md

@@ -1,3 +1,17 @@
+# 20.0.0-beta1
+
+New features:
+
+* `is.function` returns `true` for foreign executables
+* better error message when FastR cannot find its home directory
+
+Bug fixes:
+
+* strings '-Inf', '+NaN', and '-NaN' are correctly parsed to doubles including ignoring leading and trailing whitespace
+* avoid unhandled exceptions in `dev.set` #76
+* `for` loop creates and initializes the control variable even if there are no iterations #77
+* update the output of the `capabilities` builtin #78
+
 # 19.0.0
 
 New features:

com.oracle.truffle.r.pkgs/refcmp/R/snapshot.R

@@ -26,6 +26,8 @@ refcmpEnv$snapshot_dir <- 'snapshots'
 refcmpEnv$snapshot_id <- 0L
 refcmpEnv$equals <- all.equal
 
+log <- function(msg) cat("SNAPSHOT: ", msg, "\n")
+
 snapshot.isFastR <- function() {
     length(grep('FastR', R.Version()$version.string)) != 0
 }
@@ -35,14 +37,17 @@ snapshot.isFastR <- function() {
 #' @param dir The directory where to store snapshot to (default: 'snapshots')
 #' @param is_reference_run A function returning TRUE if snapshots should be taken and FALSE if values should be compared (default: snapshot dir does not exist)
 #' @param equalityFunction The function to use for comparing actual values to snapshotted values (default: 'all.equal')
+#' @param browserOnDiff Calls the "browser()" function on each difference to the reference run, this opens the 
+#' interactive command line debugger where you can further inspect the state.
 #' @examples
 #' # Only comparing using snapshots in directory "my/snapshot/dir" and using function 'identical' to compare values.
 #' snapshot.init(dir = "my/snapshot/dir", referenceRunPredicate = function() FALSE, equalityFunction = identical)
 #' 
 #' # This should do the job in most cases
 #' snapshot.init()
 #' @export
-snapshot.init <- function (dir, is_reference_run, equalityFunction) {
+snapshot.init <- function (dir, is_reference_run, equalityFunction, browserOnDiff = T) {
+    refcmpEnv$browser <- browserOnDiff
     if (!missing(dir)) {
         refcmpEnv$snaphost_dir <- dir
     }
@@ -51,6 +56,11 @@ snapshot.init <- function (dir, is_reference_run, equalityFunction) {
     } else {
         refcmpEnv$is_reference_run <- !file.exists(refcmpEnv$snapshot_dir)
     }
+    if (refcmpEnv$is_reference_run) {
+        log(paste0(" Mode is reference run. The data will be saved to ", refcmpEnv$snapshot_dir))
+    } else {
+        log(paste0(" Mode is check run. The data will be compared to reference run data from ", refcmpEnv$snapshot_dir))
+    }
     if (!missing(equalityFunction)) {
         refcmpEnv$equals <- equalityFunction
     }
@@ -73,12 +83,12 @@ snapshot.init <- function (dir, is_reference_run, equalityFunction) {
 #' 
 #' snapshot(x, y, z)
 #' @export
-snapshot <- function(...) {
+snapshot <- function(..., ignore = F) {
     # the actual parameter expessions
     actParExprs <- as.list(match.call()[-1])
     valueList <- actParsToList(actParExprs, parent.frame())
     try({
-        snapshot.id(refcmpEnv$snapshot_id, valueList)
+        snapshot.id(refcmpEnv$snapshot_id, valueList, ignore)
         refcmpEnv$snapshot_id <- refcmpEnv$snapshot_id + 1
     })
 }
@@ -95,23 +105,27 @@ snapshot <- function(...) {
 #' I contrast to function 'snapshot', this function does not try to automatically determine the name of a value.
 #' It uses the names as provided in the arguments.
 #'
+#' The ignore parameter allows to skip snapshots that were examined, but still increments the ID sequence so that following comparisons can work.
+#'
 #' @examples
 #' snapshot.named(a = 10 + 20, b = 30, c = function() print("hello"))
 #' @export
-snapshot.named <- function (...) {
+snapshot.named <- function (..., ignore = F) {
     args <- list(...)
     valueList <- args[names(args) != ""] 
     try({
-        snapshot.id(refcmpEnv$snapshot_id, valueList)
+        snapshot.id(refcmpEnv$snapshot_id, valueList, ignore)
         refcmpEnv$snapshot_id <- refcmpEnv$snapshot_id + 1 
     })  
 }
 
-snapshot.id <- function(id, valueList) {
-    if(refcmpEnv$is_reference_run) {
-        snapshot.record(id, valueList)
-    } else {
+snapshot.id <- function(id, valueList, ignore = F) {
+    if(!refcmpEnv$is_reference_run) {
+        log(paste0(" Checking: id ", id, " values named: ", paste(names(valueList), collapse=",")))
         snapshot.check(id, valueList)
+    } else if (!ignore) {
+        log(paste0(" Recording: id ", id, " values named: ", paste(names(valueList), collapse=",")))
+        snapshot.record(id, valueList)
     }
 }
 
@@ -142,10 +156,18 @@ snapshot.check <- function(id, valueList) {
             expectedVal <- restoredVars[[var_names[[i]]]]
             equalsResult <- refcmpEnv$equals(expectedVal, actualVal)
             if(!is.logical(equalsResult) || !equalsResult) {
-                stop(paste0("Value of variable '", var_names[[i]], "' differs. Expected ", expectedVal, " but was ", actualVal))
+                cat("-------------------------------\n")
+                cat("ERROR: Value of variable '", var_names[[i]], "' differs.\n")
+                cat("Expected:\n"); str(expectedVal)
+                cat("\n---\nActual:\n"); str(actualVal)
+                cat("\n---\nEquality function result: \n")
+                print(equalsResult)
+                cat("-------------------------------\n")
+                if (refcmpEnv$browser) { browser() }
             }
         } else {
-            stop(paste0("Missing variable '", var_names[[i]], "' in recorded variables"))
+            cat("ERROR: Missing variable '", var_names[[i]], "' in recorded variables\n")
+            if (refcmpEnv$browser) { browser() }
         }
     }
 }

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java

@@ -493,15 +493,18 @@ public static int string2int(String s) {
     @TruffleBoundary
     public static double string2doubleNoCheck(String v, boolean exceptionOnFail) {
         // FIXME use R rules
-        if ("Inf".equals(v)) {
+        String trimmed = v.trim();
+        if ("Inf".equals(trimmed) || "+Inf".equals(trimmed)) {
             return Double.POSITIVE_INFINITY;
-        } else if ("NaN".equals(v)) {
+        } else if ("-Inf".equals(trimmed)) {
+            return Double.NEGATIVE_INFINITY;
+        } else if ("NaN".equals(trimmed) || "+NaN".equals(trimmed) || "-NaN".equals(trimmed)) {
             return Double.NaN;
-        } else if ("NA_real_".equals(v)) {
+        } else if ("NA_real_".equals(trimmed)) {
             return DOUBLE_NA;
         }
         try {
-            return Double.parseDouble(v);
+            return Double.parseDouble(trimmed);
         } catch (NumberFormatException e) {
             if (hasHexPrefix(v)) {
                 switch (v.charAt(0)) {

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test

@@ -6798,6 +6798,36 @@ Time differences in hours
 #if (!any(R.version$engine == "FastR")) { [1] TRUE } else { { x <- c(1, 3.5); .fastr.identity(x) == .fastr.identity(as.double(x)); } }
 Error: unexpected '[' in "if (!any(R.version$engine == "FastR")) { ["
 
+##com.oracle.truffle.r.test.builtins.TestBuiltin_asdouble.testAsDouble#
+#as.double('	<<<NEWLINE>>> +Inf	<<<NEWLINE>>> ')
+[1] Inf
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_asdouble.testAsDouble#
+#as.double('	<<<NEWLINE>>> +NaN	<<<NEWLINE>>> ')
+[1] NaN
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_asdouble.testAsDouble#
+#as.double('	<<<NEWLINE>>> -Inf	<<<NEWLINE>>> ')
+[1] -Inf
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_asdouble.testAsDouble#
+#as.double('	<<<NEWLINE>>> -NaN	<<<NEWLINE>>> ')
+[1] NaN
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_asdouble.testAsDouble#
+#as.double('	<<<NEWLINE>>> Inf	<<<NEWLINE>>> ')
+[1] Inf
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_asdouble.testAsDouble#
+#as.double('	<<<NEWLINE>>> NaN	<<<NEWLINE>>> ')
+[1] NaN
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_asdouble.testAsDouble#
+#as.double('- Inf')
+[1] NA
+Warning message:
+NAs introduced by coercion
+
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_asdouble.testAsDouble#
 #{ as.double("1.27") }
 [1] 1.27
@@ -21250,7 +21280,7 @@ Error in f() :
 #{ f <- function() { delayedAssign("x", y); y <- 10; x  } ; f() }
 [1] 10
 
-##com.oracle.truffle.r.test.builtins.TestBuiltin_delayedAssign.testDelayedAssign#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_delayedAssign.testDelayedAssign#Output.IgnoreErrorContext#
 #{ f <- function() { delayedAssign("x",y); delayedAssign("y",x); g(x, y)}; g <- function(x, y) { x + y }; f() }
 Error in g(x, y) :
   promise already under evaluation: recursive default argument reference or earlier problems?
@@ -21260,7 +21290,7 @@ Error in g(x, y) :
 Error in f() :
   promise already under evaluation: recursive default argument reference or earlier problems?
 
-##com.oracle.truffle.r.test.builtins.TestBuiltin_delayedAssign.testDelayedAssign#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_delayedAssign.testDelayedAssign#Output.IgnoreErrorContext#
 #{ f <- function() { delayedAssign("x",y); delayedAssign("y",x); paste(x, y)}; f() }
 Error in paste(x, y) :
   promise already under evaluation: recursive default argument reference or earlier problems?

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_asdouble.java

@@ -14,7 +14,7 @@
  * Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  *
  * Copyright (c) 2012-2014, Purdue University
- * Copyright (c) 2013, 2018, Oracle and/or its affiliates
+ * Copyright (c) 2013, 2019, Oracle and/or its affiliates
  *
  * All rights reserved.
  */
@@ -201,6 +201,14 @@ public void testAsDouble() {
         assertEval("{ f <- function() as.double('aaa'); f() }");
         assertEval("{ f <- function() as.numeric('aaa'); f() }");
         assertEval("{ f1 <- function() {f<- function() as.double('aaa'); f()}; f1() }");
+
+        assertEval("as.double('\t\n Inf\t\n ')");
+        assertEval("as.double('\t\n +Inf\t\n ')");
+        assertEval("as.double('\t\n -Inf\t\n ')");
+        assertEval("as.double('\t\n NaN\t\n ')");
+        assertEval("as.double('\t\n +NaN\t\n ')");
+        assertEval("as.double('\t\n -NaN\t\n ')");
+        assertEval("as.double('- Inf')");
     }
 
     @Test