diff --git a/CHANGELOG.md b/CHANGELOG.md index 5098ce2e88..9d00ae9ddb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,20 @@ +# 21.2.0 +* Support for packages in 2021-02-01 CRAN snapshot: + * testthat 3.0.1 is partially supported. + * FastR does not support parallel tests run, i.e. run testthat only with `Sys.setenv(TESTTHAT_PARALLEL="false")`. + * tibble 3.0.6 , vctrs 0.3.6, and data.table 1.13.6 are mostly supported. + * Support for dplyr 1.0.3, ggplot 3.3.3, and knitr 1.31 is a work in progress. + +Bug fixes: + +* `read.dcf` does not ignore whitespaces in fields any more. +* `list.files` gives correct result in a subdirectory with the same prefix as its parent directory. +* Whitespaces in quantifiers in regular expressions are ignored. + * GNU-R does not comply with PCRE with this behavior. +* `sys.frame` displays frames for `NextMethod` correctly. +* `parent.frame` is able to get the frame that is no longer on the stack. + * Which is not recommended due to the documentation of `parent.frame`, but some packages do that nonetheless. + # 21.1.0 * Upgraded FastR to R 4.0.3 diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java index 2c0517946d..82f27b72fc 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java @@ -437,19 +437,8 @@ public Object Rf_allocVector(int mode, long n) { } @Override - @TruffleBoundary public Object Rf_allocArray(int mode, Object dimsObj) { - RIntVector dims = (RIntVector) dimsObj; - int n = 1; - int[] newDims = new int[dims.getLength()]; - // TODO check long vector - for (int i = 0; i < newDims.length; i++) { - newDims[i] = dims.getDataAt(i); - n *= newDims[i]; - } - RAbstractVector result = (RAbstractVector) Rf_allocVector(mode, n); - setDims(newDims, result); - return result; + throw implementedAsNode(); } @Override diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/AsCharNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/AsCharNode.java index f960733bed..cb308b2d37 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/AsCharNode.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/AsCharNode.java @@ -1,5 +1,5 @@ /* - * Copyright (c) 2014, 2020, Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2014, 2021, Oracle and/or its affiliates. All rights reserved. * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. * * This code is free software; you can redistribute it and/or modify it @@ -26,17 +26,20 @@ import com.oracle.truffle.api.dsl.Fallback; import com.oracle.truffle.api.dsl.Specialization; import com.oracle.truffle.api.dsl.TypeSystemReference; +import com.oracle.truffle.api.interop.UnsupportedMessageException; +import com.oracle.truffle.api.library.CachedLibrary; import com.oracle.truffle.api.profiles.ConditionProfile; import com.oracle.truffle.r.nodes.unary.CastStringNode; import com.oracle.truffle.r.runtime.RInternalError; import com.oracle.truffle.r.runtime.RRuntime; import com.oracle.truffle.r.runtime.data.CharSXPWrapper; +import com.oracle.truffle.r.runtime.data.RComplexVector; import com.oracle.truffle.r.runtime.data.RDoubleVector; +import com.oracle.truffle.r.runtime.data.RStringVector; import com.oracle.truffle.r.runtime.data.RSymbol; import com.oracle.truffle.r.runtime.data.RTypes; +import com.oracle.truffle.r.runtime.data.VectorDataLibrary; import com.oracle.truffle.r.runtime.data.model.RAbstractAtomicVector; -import com.oracle.truffle.r.runtime.data.RComplexVector; -import com.oracle.truffle.r.runtime.data.RStringVector; @TypeSystemReference(RTypes.class) public abstract class AsCharNode extends FFIUpCallNode.Arg1 { @@ -51,14 +54,21 @@ protected CharSXPWrapper asChar(CharSXPWrapper obj) { } @Specialization - protected CharSXPWrapper asChar(RStringVector obj, @Cached("createBinaryProfile()") ConditionProfile profile, @Cached("createBinaryProfile()") ConditionProfile naProfile, - @Cached("createBinaryProfile()") ConditionProfile isNativized, - @Cached("createBinaryProfile()") ConditionProfile wrapProfile) { - if (profile.profile(obj.getLength() == 0)) { + protected CharSXPWrapper asChar(RStringVector obj, + @Cached("createBinaryProfile()") ConditionProfile zeroLengthProfile, + @Cached("createBinaryProfile()") ConditionProfile naProfile, + @CachedLibrary(limit = "getTypedVectorDataLibraryCacheSize()") VectorDataLibrary dataLib) { + if (zeroLengthProfile.profile(obj.getLength() == 0)) { return CharSXPWrapper_NA; } else { - obj.wrapStrings(isNativized, wrapProfile); - CharSXPWrapper result = obj.getWrappedDataAt(0); + Object newCharSXPData = null; + try { + newCharSXPData = dataLib.materializeCharSXPStorage(obj.getData()); + } catch (UnsupportedMessageException e) { + throw RInternalError.shouldNotReachHere(e); + } + obj.setData(newCharSXPData); + CharSXPWrapper result = dataLib.getCharSXPAt(obj.getData(), 0); return naProfile.profile(RRuntime.isNA(result.getContents())) ? CharSXPWrapper_NA : result; } } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfAllocArrayNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfAllocArrayNode.java new file mode 100644 index 0000000000..3975ee9fdc --- /dev/null +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfAllocArrayNode.java @@ -0,0 +1,80 @@ +/* + * Copyright (c) 2021, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 3 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 3 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 3 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +package com.oracle.truffle.r.ffi.impl.nodes; + +import com.oracle.truffle.api.CompilerAsserts; +import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.dsl.Cached; +import com.oracle.truffle.api.dsl.Specialization; +import com.oracle.truffle.api.library.CachedLibrary; +import com.oracle.truffle.r.runtime.RInternalError; +import com.oracle.truffle.r.runtime.data.RDataFactory; +import com.oracle.truffle.r.runtime.data.RIntVector; +import com.oracle.truffle.r.runtime.data.VectorDataLibrary; +import com.oracle.truffle.r.runtime.data.model.RAbstractContainer; +import com.oracle.truffle.r.runtime.data.nodes.attributes.SpecialAttributesFunctions.SetDimAttributeNode; +import com.oracle.truffle.r.runtime.gnur.SEXPTYPE; + +public abstract class RfAllocArrayNode extends FFIUpCallNode.Arg2 { + public static RfAllocArrayNode create() { + return RfAllocArrayNodeGen.create(); + } + + @Specialization(guards = "mode == type.code", limit = "getGenericDataLibraryCacheSize()") + protected static Object allocArrayCached(@SuppressWarnings("unused") int mode, RIntVector dims, + @Cached(value = "getType(mode)", allowUncached = true) SEXPTYPE type, + @CachedLibrary("dims.getData()") VectorDataLibrary dimsDataLib, + @Cached SetDimAttributeNode setDimNode) { + CompilerAsserts.compilationConstant(type); + return allocArray(dims, dimsDataLib, type, setDimNode); + } + + @Specialization(replaces = "allocArrayCached") + @TruffleBoundary + protected static Object allocArrayUncached(int mode, RIntVector dims, @Cached SetDimAttributeNode setDimNode) { + return allocArray(dims, VectorDataLibrary.getFactory().getUncached(), getType(mode), setDimNode); + } + + private static Object allocArray(RIntVector dims, VectorDataLibrary dimsDataLib, SEXPTYPE type, SetDimAttributeNode setDimNode) { + Object dimsData = dims.getData(); + int dimsLen = dimsDataLib.getLength(dimsData); + int[] newDims = new int[dimsLen]; + int totalLen = 1; + for (int i = 0; i < dimsLen; i++) { + int dimLen = dimsDataLib.getIntAt(dimsData, i); + newDims[i] = dimLen; + totalLen *= dimLen; + } + Object array = RDataFactory.createEmptyVectorFromSEXPType(type, totalLen); + if (!(array instanceof RAbstractContainer)) { + throw RInternalError.shouldNotReachHere("Type not implemented for Rf_allocArray"); + } else { + setDimNode.setDimensions((RAbstractContainer) array, newDims); + return array; + } + } + + protected static SEXPTYPE getType(int mode) { + return SEXPTYPE.mapInt(mode); + } +} diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfAllocVectorNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfAllocVectorNode.java index 516bb9f3c4..0913b3dc25 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfAllocVectorNode.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RfAllocVectorNode.java @@ -22,10 +22,6 @@ */ package com.oracle.truffle.r.ffi.impl.nodes; -import static com.oracle.truffle.r.ffi.impl.common.RFFIUtils.unimplemented; - -import java.util.Arrays; - import com.oracle.truffle.api.CompilerAsserts; import com.oracle.truffle.api.CompilerDirectives; import com.oracle.truffle.api.dsl.Cached; @@ -34,7 +30,6 @@ import com.oracle.truffle.r.runtime.RError; import com.oracle.truffle.r.runtime.RError.Message; import com.oracle.truffle.r.runtime.data.RDataFactory; -import com.oracle.truffle.r.runtime.data.RNull; import com.oracle.truffle.r.runtime.gnur.SEXPTYPE; @GenerateUncached @@ -69,33 +64,7 @@ protected static Object doIt(@SuppressWarnings("unused") int mode, long n, } } - private static Object allocate(@Cached(value = "getType(mode)", allowUncached = true) SEXPTYPE type, int ni) { - switch (type) { - case INTSXP: - return RDataFactory.createIntVector(new int[ni], RDataFactory.COMPLETE_VECTOR); - case REALSXP: - return RDataFactory.createDoubleVector(new double[ni], RDataFactory.COMPLETE_VECTOR); - case LGLSXP: - return RDataFactory.createLogicalVector(new byte[ni], RDataFactory.COMPLETE_VECTOR); - case STRSXP: - // fill list with empty strings - String[] data = new String[ni]; - Arrays.fill(data, ""); - return RDataFactory.createStringVector(data, RDataFactory.COMPLETE_VECTOR); - case CPLXSXP: - return RDataFactory.createComplexVector(new double[2 * ni], RDataFactory.COMPLETE_VECTOR); - case RAWSXP: - return RDataFactory.createRawVector(new byte[ni]); - case VECSXP: - return RDataFactory.createList(ni); - case LISTSXP: - case LANGSXP: - return RDataFactory.createPairList(ni, type); - case NILSXP: - return RNull.instance; - default: - CompilerDirectives.transferToInterpreter(); - throw unimplemented("unexpected SEXPTYPE " + type); - } + private static Object allocate(SEXPTYPE type, int ni) { + return RDataFactory.createEmptyVectorFromSEXPType(type, ni); } } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/SetStringEltNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/SetStringEltNode.java index 80920169b3..69416c1cbb 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/SetStringEltNode.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/SetStringEltNode.java @@ -24,7 +24,9 @@ import com.oracle.truffle.api.dsl.GenerateUncached; import com.oracle.truffle.api.dsl.Specialization; +import com.oracle.truffle.api.interop.UnsupportedMessageException; import com.oracle.truffle.api.library.CachedLibrary; +import com.oracle.truffle.r.runtime.RInternalError; import com.oracle.truffle.r.runtime.data.CharSXPWrapper; import com.oracle.truffle.r.runtime.data.RStringVector; import com.oracle.truffle.r.runtime.data.VectorDataLibrary; @@ -35,10 +37,17 @@ public static SetStringEltNode create() { return SetStringEltNodeGen.create(); } - @Specialization(limit = "getTypedVectorDataLibraryCacheSize()") + @Specialization Object doIt(RStringVector vector, long index, CharSXPWrapper element, - @CachedLibrary("vector.getData()") VectorDataLibrary dataLibrary) { - dataLibrary.setStringAt(vector.getData(), (int) index, element.getContents()); + @CachedLibrary(limit = "getTypedVectorDataLibraryCacheSize()") VectorDataLibrary dataLibrary) { + Object newCharSXPData = null; + try { + newCharSXPData = dataLibrary.materializeCharSXPStorage(vector.getData()); + } catch (UnsupportedMessageException e) { + throw RInternalError.shouldNotReachHere(e); + } + vector.setData(newCharSXPData); + dataLibrary.setCharSXPAt(vector.getData(), (int) index, element); return null; } } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/StringEltNode.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/StringEltNode.java index 207b3833a1..64c1f52cd2 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/StringEltNode.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/StringEltNode.java @@ -1,5 +1,5 @@ /* - * Copyright (c) 2020, Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2020, 2021, Oracle and/or its affiliates. All rights reserved. * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. * * This code is free software; you can redistribute it and/or modify it @@ -22,11 +22,13 @@ */ package com.oracle.truffle.r.ffi.impl.nodes; -import com.oracle.truffle.api.dsl.Cached; +import com.oracle.truffle.api.CompilerDirectives; import com.oracle.truffle.api.dsl.GenerateUncached; import com.oracle.truffle.api.dsl.Specialization; +import com.oracle.truffle.api.interop.UnsupportedMessageException; import com.oracle.truffle.api.library.CachedLibrary; -import com.oracle.truffle.api.profiles.ConditionProfile; +import com.oracle.truffle.r.runtime.RError; +import com.oracle.truffle.r.runtime.RInternalError; import com.oracle.truffle.r.runtime.data.RStringVector; import com.oracle.truffle.r.runtime.data.VectorDataLibrary; @@ -36,17 +38,21 @@ public static StringEltNode create() { return StringEltNodeGen.create(); } - // TODO: Make just one specialization that handles both altrep and non-altrep via - // VectorDataLibrary @Specialization(limit = "1") Object doStringVector(RStringVector stringVector, long index, - @CachedLibrary("stringVector.getData()") VectorDataLibrary dataLibrary, - @Cached("createBinaryProfile()") ConditionProfile isAltrepProfile) { - if (isAltrepProfile.profile(stringVector.isAltRep())) { - return dataLibrary.getStringAt(stringVector, (int) index); - } else { - stringVector.wrapStrings(); - return stringVector.getWrappedDataAt((int) index); + @CachedLibrary(limit = "getTypedVectorDataLibraryCacheSize()") VectorDataLibrary genericDataLib, + @CachedLibrary("stringVector.getData()") VectorDataLibrary stringVecDataLib) { + Object newCharSXPData = null; + try { + newCharSXPData = stringVecDataLib.materializeCharSXPStorage(stringVector.getData()); + } catch (UnsupportedMessageException e) { + throw RInternalError.shouldNotReachHere(e); } + stringVector.setData(newCharSXPData); + if (index > Integer.MAX_VALUE) { + CompilerDirectives.transferToInterpreter(); + throw RError.error(RError.NO_CALLER, RError.Message.LONG_VECTORS_NOT_SUPPORTED); + } + return genericDataLib.getCharSXPAt(stringVector.getData(), (int) index); } } diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java index 4961e4149f..d00672c0a8 100644 --- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java +++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java @@ -94,6 +94,7 @@ import com.oracle.truffle.r.ffi.impl.nodes.RandFunctionsNodes; import com.oracle.truffle.r.ffi.impl.nodes.RawGetRegionNode; import com.oracle.truffle.r.ffi.impl.nodes.RealGetRegionNode; +import com.oracle.truffle.r.ffi.impl.nodes.RfAllocArrayNode; import com.oracle.truffle.r.ffi.impl.nodes.RfAllocVectorNode; import com.oracle.truffle.r.ffi.impl.nodes.RfEvalNode; import com.oracle.truffle.r.ffi.impl.nodes.RfFindFun; @@ -283,6 +284,7 @@ public interface StdUpCallsRFFI { Object Rf_allocVector(int mode, long n); @RFFIRunGC + @RFFIUpCallNode(value = RfAllocArrayNode.class, needsCallTarget = true) Object Rf_allocArray(int mode, Object dimsObj); @RFFIRunGC diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/context/RFFIUpCallTargets.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/context/RFFIUpCallTargets.java index 8984c8cb82..e98e168ac6 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/context/RFFIUpCallTargets.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/context/RFFIUpCallTargets.java @@ -88,4 +88,6 @@ public final class RFFIUpCallTargets { public volatile RootCallTarget AsS4; public volatile RootCallTarget Match5UpCallNode; + + public volatile RootCallTarget RfAllocArrayNode; } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/NativeDataAccess.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/NativeDataAccess.java index cb25eab3d7..0f125fe501 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/NativeDataAccess.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/NativeDataAccess.java @@ -1,5 +1,5 @@ /* - * Copyright (c) 2017, 2020, Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2017, 2021, Oracle and/or its affiliates. All rights reserved. * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. * * This code is free software; you can redistribute it and/or modify it @@ -1121,34 +1121,8 @@ static int getDataLength(RStringVector vector, Object[] data) { } } - static String getData(RStringVector vector, Object data, int index) { - if (noStringNative.isValid() || data != null) { - Object localData = data; - if (localData instanceof String[]) { - return ((String[]) localData)[index]; - } - assert data instanceof CharSXPWrapper[] : localData; - assert ((CharSXPWrapper[]) localData)[index] != null; - return ((CharSXPWrapper[]) localData)[index].getContents(); - } else { - return getStringNativeMirrorData(vector.getNativeMirror(), index).getContents(); - } - } - - static void setData(RStringVector vector, Object data, int index, String value) { - assert data != null; - if (data instanceof String[]) { - assert !vector.isNativized(); - ((String[]) data)[index] = value; - } else { - assert data instanceof CharSXPWrapper[] : data; - CharSXPWrapper elem = CharSXPWrapper.create(value); - ((CharSXPWrapper[]) data)[index] = elem; - - if (!noStringNative.isValid() && vector.isNativized()) { - NativeDataAccess.setNativeMirrorStringData(vector.getNativeMirror(), index, elem); - } - } + static CharSXPWrapper getData(RStringVector vector, int index) { + return getStringNativeMirrorData(vector.getNativeMirror(), index); } static void setData(RStringVector vector, CharSXPWrapper[] data, int index, CharSXPWrapper value) { diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java index 0638b06aa8..76932accb9 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java @@ -1,5 +1,5 @@ /* - * Copyright (c) 2013, 2020, Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2013, 2021, Oracle and/or its affiliates. All rights reserved. * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. * * This code is free software; you can redistribute it and/or modify it @@ -24,6 +24,7 @@ import com.oracle.truffle.api.Assumption; import com.oracle.truffle.api.CompilerAsserts; +import com.oracle.truffle.api.CompilerDirectives; import com.oracle.truffle.api.CompilerDirectives.CompilationFinal; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.RootCallTarget; @@ -760,6 +761,36 @@ public final RRawVector createRawVectorFromScalar(byte value) { public static final boolean INCOMPLETE_VECTOR = false; public static final boolean COMPLETE_VECTOR = true; + public static Object createEmptyVectorFromSEXPType(SEXPTYPE type, int length) { + switch (type) { + case INTSXP: + return RDataFactory.createIntVector(new int[length], RDataFactory.COMPLETE_VECTOR); + case REALSXP: + return RDataFactory.createDoubleVector(new double[length], RDataFactory.COMPLETE_VECTOR); + case LGLSXP: + return RDataFactory.createLogicalVector(new byte[length], RDataFactory.COMPLETE_VECTOR); + case STRSXP: + // fill list with empty strings + String[] data = new String[length]; + Arrays.fill(data, ""); + return RDataFactory.createStringVector(data, RDataFactory.COMPLETE_VECTOR); + case CPLXSXP: + return RDataFactory.createComplexVector(new double[2 * length], RDataFactory.COMPLETE_VECTOR); + case RAWSXP: + return RDataFactory.createRawVector(new byte[length]); + case VECSXP: + return RDataFactory.createList(length); + case LISTSXP: + case LANGSXP: + return RDataFactory.createPairList(length, type); + case NILSXP: + return RNull.instance; + default: + CompilerDirectives.transferToInterpreter(); + throw RInternalError.unimplemented("unexpected SEXPTYPE " + type); + } + } + public static RIntVector createIntVectorFromNative(long address, int length) { return traceDataCreated(RIntVector.fromNative(address, length)); } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringArrayVectorData.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringArrayVectorData.java index c6e93a80e0..86e4e0e5a5 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringArrayVectorData.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringArrayVectorData.java @@ -22,10 +22,6 @@ */ package com.oracle.truffle.r.runtime.data; -import static com.oracle.truffle.r.runtime.data.model.RAbstractVector.ENABLE_COMPLETE; - -import java.util.Arrays; - import com.oracle.truffle.api.dsl.Cached; import com.oracle.truffle.api.dsl.Cached.Shared; import com.oracle.truffle.api.interop.TruffleObject; @@ -43,6 +39,10 @@ import com.oracle.truffle.r.runtime.data.VectorDataLibrary.SeqWriteIterator; import com.oracle.truffle.r.runtime.ops.na.NACheck; +import java.util.Arrays; + +import static com.oracle.truffle.r.runtime.data.model.RAbstractVector.ENABLE_COMPLETE; + @ExportLibrary(VectorDataLibrary.class) class RStringArrayVectorData implements TruffleObject, ShareableVectorData { private final String[] data; @@ -84,6 +84,11 @@ public RStringArrayVectorData materialize() { return this; } + @ExportMessage + public RStringCharSXPData materializeCharSXPStorage() { + return wrapStrings(); + } + @ExportMessage public boolean isWriteable() { return true; diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringCharSXPData.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringCharSXPData.java index 2ad6f1692f..66fca26bd0 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringCharSXPData.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringCharSXPData.java @@ -35,6 +35,8 @@ import com.oracle.truffle.r.runtime.data.VectorDataLibrary.SeqWriteIterator; import com.oracle.truffle.r.runtime.ops.na.NACheck; +import java.util.Arrays; + @ExportLibrary(VectorDataLibrary.class) public class RStringCharSXPData implements ShareableVectorData { private final CharSXPWrapper[] data; @@ -47,14 +49,6 @@ public CharSXPWrapper[] getData() { return data; } - public CharSXPWrapper getWrappedAt(int index) { - return data[index]; - } - - public void setWrappedAt(int index, CharSXPWrapper value) { - data[index] = value; - } - @ExportMessage public NACheck getNACheck() { return NACheck.getEnabled(); @@ -75,6 +69,11 @@ public RStringCharSXPData materialize() { return this; } + @ExportMessage + public RStringCharSXPData materializeCharSXPStorage() { + return this; + } + @ExportMessage public boolean isWriteable() { return true; @@ -96,6 +95,11 @@ public String[] getStringDataCopy() { return result; } + @ExportMessage + public CharSXPWrapper[] getCharSXPDataCopy() { + return Arrays.copyOf(data, data.length); + } + // Data access: @ExportMessage @@ -140,6 +144,21 @@ public String getString(@SuppressWarnings("unused") RandomAccessIterator it, int return data[index].getContents(); } + @ExportMessage + public CharSXPWrapper getCharSXPAt(int index) { + return data[index]; + } + + @ExportMessage + public CharSXPWrapper getNextCharSXP(SeqIterator it) { + return data[it.getIndex()]; + } + + @ExportMessage + public CharSXPWrapper getCharSXP(@SuppressWarnings("unused") RandomAccessIterator it, int index) { + return data[index]; + } + // Write access to the elements: @ExportMessage @@ -166,4 +185,19 @@ public void setNextString(SeqWriteIterator it, String value) { public void setString(@SuppressWarnings("unused") RandomAccessWriteIterator it, int index, String value) { data[index] = CharSXPWrapper.create(value); } + + @ExportMessage + public void setCharSXPAt(int index, CharSXPWrapper value) { + data[index] = value; + } + + @ExportMessage + public void setNextCharSXP(SeqWriteIterator it, CharSXPWrapper value) { + data[it.getIndex()] = value; + } + + @ExportMessage + public void setCharSXP(@SuppressWarnings("unused") RandomAccessWriteIterator it, int index, CharSXPWrapper value) { + data[index] = value; + } } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringSeqVectorData.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringSeqVectorData.java index 4964afe9b0..20010da367 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringSeqVectorData.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringSeqVectorData.java @@ -117,6 +117,11 @@ public RStringArrayVectorData materialize() { return new RStringArrayVectorData(getStringDataCopy(), true); } + @ExportMessage + public RStringCharSXPData materializeCharSXPStorage() { + return new RStringCharSXPData(getCharSXPDataCopy()); + } + @ExportMessage public RStringSeqVectorData copy(@SuppressWarnings("unused") boolean deep) { return new RStringSeqVectorData(prefix, suffix, start, stride, length); @@ -136,6 +141,15 @@ public String[] getStringDataCopy() { return result; } + @ExportMessage + public CharSXPWrapper[] getCharSXPDataCopy() { + CharSXPWrapper[] result = new CharSXPWrapper[length]; + for (int i = 0; i < result.length; i++) { + result[i] = getCharSXPImpl(i); + } + return result; + } + // Read access to the elements: @ExportMessage @@ -179,6 +193,21 @@ public String getString(@SuppressWarnings("unused") RandomAccessIterator it, int return getStringImpl(index); } + @ExportMessage + public CharSXPWrapper getCharSXPAt(int index) { + return getCharSXPImpl(index); + } + + @ExportMessage + public CharSXPWrapper getNextCharSXP(SeqIterator it) { + return getCharSXPImpl(it.getIndex()); + } + + @ExportMessage + public CharSXPWrapper getCharSXP(@SuppressWarnings("unused") RandomAccessIterator it, int index) { + return getCharSXPImpl(index); + } + // Utility methods: @TruffleBoundary @@ -186,4 +215,8 @@ private String getStringImpl(int index) { assert index >= 0 && index < getLength(); return prefix + (start + stride * index) + suffix; } + + private CharSXPWrapper getCharSXPImpl(int index) { + return CharSXPWrapper.create(getStringImpl(index)); + } } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVecNativeData.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVecNativeData.java index bdf1f7fecb..7789ac11d6 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVecNativeData.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVecNativeData.java @@ -46,8 +46,11 @@ public class RStringVecNativeData implements TruffleObject, ShareableVectorData /** * After nativized, the data array degenerates to a reference holder, which prevents the objects - * from being GC'ed. If the native code copies data of one string vector to another without - * using the proper API, we are doomed. + * from being GC'ed. This means that if someone changes the order of the CHARSXP elements on the + * native side, this modification is not reflected in this reference holder array. + * + * If the native code copies data of one string vector to another without using the proper API, + * we are doomed. */ private final CharSXPWrapper[] data; @@ -83,6 +86,11 @@ public RStringVecNativeData materialize() { return this; } + @ExportMessage + public RStringVecNativeData materializeCharSXPStorage() { + return this; + } + @ExportMessage public boolean isWriteable() { return true; @@ -135,17 +143,32 @@ public RandomAccessIterator randomAccessIterator() { @ExportMessage public String getStringAt(int index) { - return NativeDataAccess.getData(vec, null, index); + return NativeDataAccess.getData(vec, index).getContents(); } @ExportMessage public String getNextString(SeqIterator it) { - return NativeDataAccess.getData(vec, null, it.getIndex()); + return NativeDataAccess.getData(vec, it.getIndex()).getContents(); } @ExportMessage public String getString(@SuppressWarnings("unused") RandomAccessIterator it, int index) { - return NativeDataAccess.getData(vec, null, index); + return NativeDataAccess.getData(vec, index).getContents(); + } + + @ExportMessage + public CharSXPWrapper getCharSXPAt(int index) { + return NativeDataAccess.getData(vec, index); + } + + @ExportMessage + public CharSXPWrapper getNextCharSXP(SeqIterator it) { + return NativeDataAccess.getData(vec, it.getIndex()); + } + + @ExportMessage + public CharSXPWrapper getCharSXP(@SuppressWarnings("unused") RandomAccessIterator it, int index) { + return NativeDataAccess.getData(vec, index); } // Write access to the elements: @@ -174,4 +197,19 @@ public void setNextString(SeqWriteIterator it, String value) { public void setString(@SuppressWarnings("unused") RandomAccessWriteIterator it, int index, String value) { NativeDataAccess.setData(vec, data, index, CharSXPWrapper.create(value)); } + + @ExportMessage + public void setCharSXPAt(int index, CharSXPWrapper value) { + NativeDataAccess.setData(vec, data, index, value); + } + + @ExportMessage + public void setNextCharSXP(SeqWriteIterator it, CharSXPWrapper value) { + NativeDataAccess.setData(vec, data, it.getIndex(), value); + } + + @ExportMessage + public void setCharSXP(@SuppressWarnings("unused") RandomAccessWriteIterator it, int index, CharSXPWrapper value) { + NativeDataAccess.setData(vec, data, index, value); + } } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java index a1904e7fc1..9c1ee36f4f 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringVector.java @@ -22,8 +22,6 @@ */ package com.oracle.truffle.r.runtime.data; -import java.util.Arrays; - import com.oracle.truffle.api.dsl.Cached; import com.oracle.truffle.api.interop.InteropLibrary; import com.oracle.truffle.api.interop.TruffleObject; @@ -53,6 +51,8 @@ import com.oracle.truffle.r.runtime.data.nodes.VectorAccess; import com.oracle.truffle.r.runtime.ops.na.NACheck; +import java.util.Arrays; + @ExportLibrary(InteropLibrary.class) @ExportLibrary(AbstractContainerLibrary.class) public final class RStringVector extends RAbstractAtomicVector implements RMaterializedVector, Shareable { @@ -122,8 +122,7 @@ public static RStringVector createAltString(AltStringClassDescriptor descriptor, altStringVector.setAltRep(); altStringVector.data = altStringVecData; // This is a workaround, because we already have to invoke some altrep methods in - // getLengthMethodUncached - // and for that we need non-null owner. + // getLengthMethodUncached and for that we need non-null owner. altStringVecData.setOwner(altStringVector); int length = AltrepUtilities.getLengthUncached(altStringVector); altStringVector.setData(altStringVecData, length); @@ -390,7 +389,7 @@ public Object getDataAtAsObject(int index) { public void setElement(int i, Object value) { assert value instanceof CharSXPWrapper; wrapStrings(); - setWrappedDataAt(i, (CharSXPWrapper) value); + VectorDataLibrary.getFactory().getUncached().setCharSXPAt(data, i, (CharSXPWrapper) value); } /** @@ -424,39 +423,24 @@ public void wrapStrings() { * wrapped. */ @SuppressFBWarnings(value = "ST_WRITE_TO_STATIC_FROM_INSTANCE_METHOD", justification = "intentional") - public void wrapStrings(ConditionProfile isNativized, ConditionProfile needsWrapping) { + public void wrapStrings(ConditionProfile isNativized, ConditionProfile isWrapped) { if (isNativized.profile(!isNativized())) { - Object oldData = data; - if (needsWrapping.profile(oldData instanceof RStringCharSXPData)) { + VectorDataLibrary dataLib = getUncachedDataLib(); + Object newCharSXPData = null; + try { + newCharSXPData = dataLib.materializeCharSXPStorage(data); + } catch (UnsupportedMessageException e) { + throw RInternalError.shouldNotReachHere(e); + } + if (isWrapped.profile(newCharSXPData == data)) { return; } - oldData = getUncachedDataLib().materialize(oldData); - Object newData = ((RStringArrayVectorData) oldData).wrapStrings(); fence = 42; // make sure the array is really initialized before we set it to this.data - setData(newData, getUncachedDataLib().getLength(newData)); + setData(newCharSXPData, dataLib.getLength(newCharSXPData)); } verifyData(); } - public CharSXPWrapper getWrappedDataAt(int index) { - if (!isNativized()) { - assert data instanceof RStringCharSXPData : "wrap the string vector data with wrapStrings() before using getWrappedDataAt(int)"; - return ((RStringCharSXPData) data).getWrappedAt(index); - } else { - return NativeDataAccess.getStringNativeMirrorData(getNativeMirror(), index); - } - } - - public void setWrappedDataAt(int index, CharSXPWrapper elem) { - if (!isNativized()) { - wrapStrings(); - assert data instanceof RStringCharSXPData : "wrap the string vector data with wrapStrings() before using getWrappedDataAt(int)"; - ((RStringCharSXPData) data).setWrappedAt(index, elem); - } else { - ((RStringVecNativeData) data).setWrappedStringAt(index, elem); - } - } - protected static RStringVector createStringVector(Object[] vecData, boolean isComplete, int[] dims) { if (vecData instanceof String[]) { return RDataFactory.createStringVector((String[]) vecData, isComplete, dims); diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/VectorDataClosure.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/VectorDataClosure.java index aa62771688..8f28715d3f 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/VectorDataClosure.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/VectorDataClosure.java @@ -1,5 +1,5 @@ /* - * Copyright (c) 2020, 2020, Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2020, 2021, Oracle and/or its affiliates. All rights reserved. * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. * * This code is free software; you can redistribute it and/or modify it @@ -352,6 +352,43 @@ public String getString(RandomAccessIterator it, int index, return dataLib.getString(data, it, index); } + // CharSXP + + @ExportMessage + public CharSXPWrapper[] getCharSXPDataCopy(@CachedLibrary("this.data") VectorDataLibrary dataLib) { + assert getTargetType() == RType.Char || getTargetType() == RType.Character; + CharSXPWrapper[] result = new CharSXPWrapper[getLength(dataLib)]; + SeqIterator it = dataLib.iterator(data); + while (dataLib.next(data, it)) { + result[it.getIndex()] = dataLib.getNextCharSXP(data, it); + } + return result; + } + + @ExportMessage + public RStringCharSXPData materializeCharSXPStorage(@CachedLibrary("this.data") VectorDataLibrary dataLib) { + assert getTargetType() == RType.Char || getTargetType() == RType.Character; + return new RStringCharSXPData(getCharSXPDataCopy(dataLib)); + } + + @ExportMessage + public CharSXPWrapper getCharSXPAt(int index, + @CachedLibrary("this.data") VectorDataLibrary dataLib) { + return dataLib.getCharSXPAt(data, index); + } + + @ExportMessage + public CharSXPWrapper getNextCharSXP(SeqIterator it, + @CachedLibrary("this.data") VectorDataLibrary dataLib) { + return dataLib.getNextCharSXP(data, it); + } + + @ExportMessage + public CharSXPWrapper getCharSXP(RandomAccessIterator it, int index, + @CachedLibrary("this.data") VectorDataLibrary dataLib) { + return dataLib.getCharSXP(data, it, index); + } + // List @ExportMessage diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/VectorDataLibrary.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/VectorDataLibrary.java index c1bf6d6869..8215748552 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/VectorDataLibrary.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/VectorDataLibrary.java @@ -140,12 +140,33 @@ public boolean isWriteable(Object data) { public abstract RType getType(Object data); /** - * Returns an instance of object that implements {@link VectorDataLibrary} and it guaranteed to + * Returns an instance of object that implements {@link VectorDataLibrary} and is guaranteed to * return {@code true} from {@link #isWriteable(Object)}. The result may be the same as * {@code receiver} or a new fresh instance. */ public abstract Object materialize(Object data); + /** + * Returns vector data (an object implementing {@link VectorDataLibrary}) that implements + * CHARSXP-specific messages, like {@link #getCharSXPAt(Object, int)} or + * {@link #setCharSXPAt(Object, int, CharSXPWrapper)}. More specifically, the returned vector + * data must not throw an exception when a CHARSXP element is set on it via, e.g., + * {@link #setCharSXPAt(Object, int, CharSXPWrapper)}. + *

+ * Must be implemented when {@code getType() == Character}. + *

+ * This method is necessary when the character vector data is passed to the native side. There, + * all the elements of a character vector are treated as CHARSXP elements. + *

+ * If the result is the same as the {@code data}, it means that the receiver already has + * materialized CharSXP storage. + * + * @see #materialize(Object) + */ + public Object materializeCharSXPStorage(@SuppressWarnings("unused") Object data) throws UnsupportedMessageException { + throw UnsupportedMessageException.create(); + } + /** * Transforms the data to representation that is backed by native memory. */ @@ -872,7 +893,6 @@ public void setRaw(Object receiver, RandomAccessWriteIterator it, int index, byt // --------------------------------------------------------------------- // Methods specific to String data - // TODO: support for CharSXP public String[] getReadonlyStringData(Object receiver) { return getStringDataCopy(receiver); @@ -882,7 +902,7 @@ public String[] getStringDataCopy(Object receiver) { throw notImplemented(receiver); } - public String getStringAt(Object receiver, @SuppressWarnings("unused") int index) { + public String getStringAt(Object receiver, int index) { RType type = getType(receiver); switch (type) { case Integer: @@ -904,7 +924,7 @@ public String getStringAt(Object receiver, @SuppressWarnings("unused") int index } } - public String getNextString(Object receiver, @SuppressWarnings("unused") SeqIterator it) { + public String getNextString(Object receiver, SeqIterator it) { RType type = getType(receiver); switch (type) { case Integer: @@ -926,7 +946,7 @@ public String getNextString(Object receiver, @SuppressWarnings("unused") SeqIter } } - public String getString(Object receiver, @SuppressWarnings("unused") RandomAccessIterator it, @SuppressWarnings("unused") int index) { + public String getString(Object receiver, RandomAccessIterator it, int index) { RType type = getType(receiver); return getStringImpl(receiver, type, it, index); } @@ -952,6 +972,83 @@ public final String getStringImpl(Object receiver, RType type, RandomAccessItera } } + // --------------------------------------------------------------------- + // Methods specific to CharSXP data + + public CharSXPWrapper[] getReadonlyCharSXPData(Object receiver) { + return getCharSXPDataCopy(receiver); + } + + public CharSXPWrapper[] getCharSXPDataCopy(Object receiver) { + throw notImplemented(receiver); + } + + public CharSXPWrapper getCharSXPAt(Object receiver, int index) { + RType type = getType(receiver); + switch (type) { + case Integer: + return int2charSXP(getNACheck(receiver), getIntAt(receiver, index)); + case Double: + return double2charSXP(getNACheck(receiver), getDoubleAt(receiver, index)); + case Logical: + return logical2charSXP(getNACheck(receiver), getLogicalAt(receiver, index)); + case Raw: + return raw2charSXP(getRawAt(receiver, index)); + case Complex: + return complex2charSXP(getNACheck(receiver), getComplexAt(receiver, index)); + case Character: + CompilerDirectives.transferToInterpreter(); + throw RInternalError.shouldNotReachHere("should be exported elsewhere " + receiver); + default: + CompilerDirectives.transferToInterpreter(); + throw RInternalError.shouldNotReachHere(type.toString()); + } + } + + public CharSXPWrapper getNextCharSXP(Object receiver, SeqIterator it) { + RType type = getType(receiver); + switch (type) { + case Integer: + return int2charSXP(getNACheck(receiver), getNextInt(receiver, it)); + case Double: + return double2charSXP(getNACheck(receiver), getNextDouble(receiver, it)); + case Logical: + return logical2charSXP(getNACheck(receiver), getNextLogical(receiver, it)); + case Raw: + return raw2charSXP(getNextRaw(receiver, it)); + case Complex: + return complex2charSXP(getNACheck(receiver), getNextComplex(receiver, it)); + case Character: + CompilerDirectives.transferToInterpreter(); + throw RInternalError.shouldNotReachHere("should be exported elsewhere " + receiver); + default: + CompilerDirectives.transferToInterpreter(); + throw RInternalError.shouldNotReachHere(type.toString()); + } + } + + public CharSXPWrapper getCharSXP(Object receiver, RandomAccessIterator it, int index) { + RType type = getType(receiver); + switch (type) { + case Integer: + return int2charSXP(getNACheck(receiver), getInt(receiver, it, index)); + case Double: + return double2charSXP(getNACheck(receiver), getDouble(receiver, it, index)); + case Logical: + return logical2charSXP(getNACheck(receiver), getLogical(receiver, it, index)); + case Raw: + return raw2charSXP(getRaw(receiver, it, index)); + case Complex: + return complex2charSXP(getNACheck(receiver), getComplex(receiver, it, index)); + case Character: + CompilerDirectives.transferToInterpreter(); + throw RInternalError.shouldNotReachHere("should be exported elsewhere " + receiver); + default: + CompilerDirectives.transferToInterpreter(); + throw RInternalError.shouldNotReachHere(type.toString()); + } + } + @SuppressWarnings("unused") public void setStringAt(Object receiver, int index, String value) { throw notWriteableError(receiver, "setStringAt"); @@ -967,6 +1064,21 @@ public void setString(Object receiver, RandomAccessWriteIterator it, int index, throw notWriteableError(receiver, "setString"); } + @SuppressWarnings("unused") + public void setCharSXPAt(Object receiver, int index, CharSXPWrapper value) { + throw notWriteableError(receiver, "setCharSXPAt"); + } + + @SuppressWarnings("unused") + public void setNextCharSXP(Object receiver, SeqWriteIterator it, CharSXPWrapper value) { + throw notWriteableError(receiver, "setNextCharSXP"); + } + + @SuppressWarnings("unused") + public void setCharSXP(Object receiver, RandomAccessWriteIterator it, int index, CharSXPWrapper value) { + throw notWriteableError(receiver, "setCharSXP"); + } + private final ConditionProfile emptyStringProfile = ConditionProfile.createBinaryProfile(); // --------------------------------------------------------------------- @@ -1594,6 +1706,19 @@ public Object materialize(Object data) { return result; } + @Override + public Object materializeCharSXPStorage(Object data) { + verifyIfSlowAssertsEnabled(data); + Object result = null; + try { + result = delegate.materializeCharSXPStorage(data); + } catch (UnsupportedMessageException e) { + throw RInternalError.shouldNotReachHere(e); + } + assert result != null; + return result; + } + @Override public Object copy(Object data, boolean deep) { verifyIfSlowAssertsEnabled(data); @@ -2034,6 +2159,33 @@ public String getString(Object receiver, RandomAccessIterator it, int index) { return delegate.getString(receiver, it, index); } + @Override + public CharSXPWrapper[] getReadonlyCharSXPData(Object receiver) { + verifyIfSlowAssertsEnabled(receiver); + return delegate.getReadonlyCharSXPData(receiver); + } + + @Override + public CharSXPWrapper[] getCharSXPDataCopy(Object receiver) { + verifyIfSlowAssertsEnabled(receiver); + return delegate.getCharSXPDataCopy(receiver); + } + + @Override + public CharSXPWrapper getCharSXPAt(Object receiver, int index) { + return delegate.getCharSXPAt(receiver, index); + } + + @Override + public CharSXPWrapper getNextCharSXP(Object receiver, SeqIterator it) { + return delegate.getNextCharSXP(receiver, it); + } + + @Override + public CharSXPWrapper getCharSXP(Object receiver, RandomAccessIterator it, int index) { + return delegate.getCharSXP(receiver, it, index); + } + @Override public void setStringAt(Object receiver, int index, String value) { delegate.setStringAt(receiver, index, value); @@ -2049,6 +2201,21 @@ public void setString(Object receiver, RandomAccessWriteIterator it, int index, delegate.setString(receiver, it, index, value); } + @Override + public void setCharSXPAt(Object receiver, int index, CharSXPWrapper value) { + delegate.setCharSXPAt(receiver, index, value); + } + + @Override + public void setNextCharSXP(Object receiver, SeqWriteIterator it, CharSXPWrapper value) { + delegate.setNextCharSXP(receiver, it, value); + } + + @Override + public void setCharSXP(Object receiver, RandomAccessWriteIterator it, int index, CharSXPWrapper value) { + delegate.setCharSXP(receiver, it, index, value); + } + @Override public double[] getReadonlyComplexData(Object receiver) { verifyIfSlowAssertsEnabled(receiver); @@ -2148,6 +2315,10 @@ private static String complex2string(NACheck naCheck, RComplex value) { return naCheck.check(value) ? RRuntime.STRING_NA : RContext.getRRuntimeASTAccess().encodeComplex(value); } + private static CharSXPWrapper complex2charSXP(NACheck naCheck, RComplex value) { + return CharSXPWrapper.create(complex2string(naCheck, value)); + } + private static byte complex2raw(NACheck naCheck, RComplex value) { naCheck.check(value); double realPart = value.getRealPart(); @@ -2219,6 +2390,10 @@ private static String double2string(NACheck naCheck, double value) { return naCheck.check(value) ? RRuntime.STRING_NA : RContext.getRRuntimeASTAccess().encodeDouble(value); } + private static CharSXPWrapper double2charSXP(NACheck naCheck, double value) { + return CharSXPWrapper.create(double2string(naCheck, value)); + } + private static RComplex double2complex(NACheck naCheck, double value) { return naCheck.check(value) ? RRuntime.COMPLEX_NA : RRuntime.double2complexNoCheck(value); } @@ -2257,6 +2432,10 @@ private static String int2string(NACheck naCheck, int value) { return naCheck.check(value) ? RRuntime.STRING_NA : RRuntime.intToStringNoCheck(value); } + private static CharSXPWrapper int2charSXP(NACheck naCheck, int value) { + return CharSXPWrapper.create(int2string(naCheck, value)); + } + private static RComplex int2complex(NACheck naCheck, int value) { return naCheck.check(value) ? RRuntime.COMPLEX_NA : RRuntime.int2complexNoCheck(value); } @@ -2283,6 +2462,10 @@ private static String logical2string(NACheck naCheck, byte value) { return naCheck.check(value) ? RRuntime.STRING_NA : RRuntime.logicalToStringNoCheck(value); } + private static CharSXPWrapper logical2charSXP(NACheck naCheck, byte value) { + return CharSXPWrapper.create(logical2string(naCheck, value)); + } + private static RComplex logical2complex(NACheck naCheck, byte value) { return naCheck.check(value) ? RRuntime.COMPLEX_NA : RRuntime.logical2complexNoCheck(value); } @@ -2303,6 +2486,10 @@ private static String raw2string(byte value) { return RRuntime.rawToHexString(value); } + private static CharSXPWrapper raw2charSXP(byte value) { + return CharSXPWrapper.create(raw2string(value)); + } + private static RComplex raw2complex(byte value) { return RComplex.valueOf(value & 0xff, 0); } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFILog.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFILog.java index b8aadfcca6..ef3f2f9a27 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFILog.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RFFILog.java @@ -1,5 +1,5 @@ /* - * Copyright (c) 2018, 2019, Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2018, 2021, Oracle and/or its affiliates. All rights reserved. * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. * * This code is free software; you can redistribute it and/or modify it @@ -24,14 +24,20 @@ import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; import com.oracle.truffle.api.TruffleLogger; +import com.oracle.truffle.r.runtime.Collections; import com.oracle.truffle.r.runtime.RLogger; -import com.oracle.truffle.r.runtime.context.RContext; -import java.util.logging.Level; import com.oracle.truffle.r.runtime.Utils; +import com.oracle.truffle.r.runtime.context.RContext; import com.oracle.truffle.r.runtime.data.RBaseObject; +import com.oracle.truffle.r.runtime.data.RPairList; +import org.graalvm.collections.EconomicMap; +import org.graalvm.collections.MapCursor; + import java.util.List; +import java.util.concurrent.atomic.AtomicInteger; +import java.util.logging.Level; + import static com.oracle.truffle.r.runtime.RLogger.LOGGER_RFFI; -import com.oracle.truffle.r.runtime.data.RPairList; /** * Support for logging R FFI. @@ -72,8 +78,13 @@ private enum CallMode { @TruffleBoundary public static void logRObject(String message, Object obj) { - Object mirror = obj instanceof RBaseObject ? mirror = ((RBaseObject) obj).getNativeMirror() : null; - log(String.format("%s [%s, native mirror: %s]", message, Utils.getDebugInfo(obj), mirror)); + log(message + " " + rObjectToDebugString(obj)); + } + + @TruffleBoundary + private static String rObjectToDebugString(Object obj) { + Object mirror = obj instanceof RBaseObject ? ((RBaseObject) obj).getNativeMirror() : null; + return String.format("[%s, native mirror: %s]", Utils.getDebugInfo(obj), mirror); } public static void logUpCall(String name, List args) { @@ -100,10 +111,62 @@ public static boolean logEnabled() { return LOGGER.isLoggable(Level.FINE); } + private static boolean finerLogEnabled() { + return LOGGER.isLoggable(Level.FINER); + } + private static void logCall(CallMode mode, String name, int depthValue, Object... args) { if (logEnabled()) { log(callToString(mode, depthValue, name, args)); + if (finerLogEnabled()) { + logNativeObjects(); + } + } + } + + @TruffleBoundary + private static void logNativeObjects() { + logPreserveList(); + logProtectStack(); + } + + private static void logPreserveList() { + assert finerLogEnabled(); + StringBuilder sb = new StringBuilder(); + sb.append("preserveList = ["); + EconomicMap preserveList = getContext().rffiContextState.preserveList; + MapCursor iterator = preserveList.getEntries(); + while (iterator.advance()) { + sb.append("{"); + RBaseObject object = iterator.getKey(); + int id = iterator.getValue().get(); + sb.append(Long.toHexString(id)); + sb.append(":"); + sb.append(rObjectToDebugString(object)); + sb.append("}"); + sb.append(","); + } + if (preserveList.size() > 0) { + // Delete last comma + sb.deleteCharAt(sb.length() - 1); + } + sb.append("]"); + LOGGER.log(Level.FINER, sb.toString()); + } + + private static void logProtectStack() { + assert finerLogEnabled(); + StringBuilder sb = new StringBuilder(); + sb.append("protectStack = ["); + Collections.ArrayListObj protectStack = getContext().rffiContextState.protectStack; + for (int i = 0; i < protectStack.size(); i++) { + sb.append(rObjectToDebugString(protectStack.get(i))); + if (i < protectStack.size() - 1) { + sb.append(","); + } } + sb.append("]"); + LOGGER.log(Level.FINER, sb.toString()); } @TruffleBoundary @@ -130,7 +193,7 @@ private static void argsToString(CallMode mode, StringBuilder sb, Object[] args) } else { sb.append(", "); } - // Note: it makes sense to include native mirrors only once they have been create + // Note: it makes sense to include native mirrors only once they have been created // already String additional = ""; if (mode.logNativeMirror && arg instanceof RBaseObject) { diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R index 19f87eb7c1..f142b56978 100644 --- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R +++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R @@ -371,3 +371,7 @@ rffi.testInstallTrChar <- function(strvec, envir) { rffi.test_RfMatch <- function(x, y) { .Call("test_RfMatch", x, y) } + +rffi.test_mkCharDoesNotCollect <- function() { + .Call("test_mkCharDoesNotCollect") +} diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/charsxps.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/charsxps.c new file mode 100644 index 0000000000..fc89895c32 --- /dev/null +++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/charsxps.c @@ -0,0 +1,235 @@ +/* + * Copyright (c) 2021, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 3 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 3 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 3 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ + +#include "charsxps.h" +#include +#include + +static void assert_same_str(const char *actual, const char *expected); +static void charsxp_same_ptrs_test(); +static void reorder_via_stringelt_test(); +static void reorder_via_dataptr_test(); +static void set_via_dataptr_test(); +static void get_via_dataptr_test(); + +/** +* Replaces an n-th string in place from given character vector with `replacement`. +* Is a wrapper for SET_STRING_ELT +* @param n Index of the string to replace. +* @param replacement Replacement for the string. +* @returns New string vector with the replacement. +*/ +SEXP charsxp_replace_nth_str(SEXP str, SEXP n, SEXP replacement) { + if (TYPEOF(str) != STRSXP || LENGTH(str) == 0) { + error("`str` expected STRSXP type with length greater than zero"); + } + if (TYPEOF(n) != INTSXP || LENGTH(n) != 1) { + error("`n` expected integer of length 1"); + } + if (TYPEOF(replacement) != STRSXP || LENGTH(replacement) != 1) { + error("`replacement` expected STRSXP of length 1"); + } + const char *replacement_char = CHAR(STRING_ELT(replacement, 0)); + int idx = INTEGER_ELT(n, 0); + if (LENGTH(str) < idx) { + error("Trying to replace a string outside of bounds"); + } + for (int i = 0; i < LENGTH(str); i++) { + if (i == idx) { + SET_STRING_ELT(str, i, mkChar(replacement_char)); + } + } + return str; +} + +/** +* A wrapper for STRING_ELT. +*/ +SEXP charsxp_nth_str(SEXP str, SEXP n) { + int idx = INTEGER_ELT(n, 0); + return ScalarString(STRING_ELT(str, idx)); +} + +/** +* Creates a native empty character vector. For the purpose of demonstration that we +* can create a native character vector, and then modify it in R code. +*/ +SEXP charsxp_create_empty_str(SEXP n) { + int n_int = INTEGER_ELT(n, 0); + SEXP str = PROTECT(allocVector(STRSXP, n_int)); + for (int i = 0; i < n_int; i++) { + SET_STRING_ELT(str, i, mkChar("")); + } + UNPROTECT(1); + return str; +} + +/** + * Reverts a character vector in place via STRING_ELT API. + */ +SEXP charsxp_revert_via_elt(SEXP str) { + int len = LENGTH(str); + int half = (int) ceil(len / 2); + for (int first_idx = 0; first_idx < half; first_idx++) { + int second_idx = len - first_idx - 1; + SEXP first_elem = STRING_ELT(str, first_idx); + SET_STRING_ELT(str, first_idx, STRING_ELT(str, second_idx)); + SET_STRING_ELT(str, second_idx, first_elem); + } + return str; +} + +/** + * Reverts a character vector in place via DATAPTR. + */ +SEXP charsxp_revert_via_dataptr(SEXP str) { + int len = LENGTH(str); + int half = (int) ceil(len / 2); + SEXP *dataptr = (SEXP *) DATAPTR(str); + for (int first_idx = 0; first_idx < half; first_idx++) { + int second_idx = len - first_idx - 1; + SEXP first_elem = dataptr[first_idx]; + dataptr[first_idx] = dataptr[second_idx]; + dataptr[second_idx] = first_elem; + } + return str; +} + +/** +* Runs all other native tests +*/ +SEXP charsxp_tests() { + charsxp_same_ptrs_test(); + reorder_via_stringelt_test(); + reorder_via_dataptr_test(); + set_via_dataptr_test(); + get_via_dataptr_test(); + return R_NilValue; +} + +static void assert_same_str(const char *actual, const char *expected) { + if (strcmp(actual, expected) != 0) { + error("Strings are different: actual:'%s', expected:'%s'", actual, expected); + } +} + +/** + * CHARSXP SEXP types are compared with equality operator. + */ +static void charsxp_same_ptrs_test() { + SEXP str = PROTECT(allocVector(STRSXP, 1)); + SEXP elem = mkChar("Hello"); + SET_STRING_ELT(str, 0, elem); + SEXP elem_from_elt = STRING_ELT(str, 0); + if (elem != elem_from_elt) { + error("elem != elem_from_elt"); + } + UNPROTECT(1); +} + +/** + * Reorder the elements of the character vector via STRING_ELT API. + */ +static void reorder_via_stringelt_test() { + // Reorder the elements of the character vector via STRING_ELT API. + SEXP str = PROTECT(allocVector(STRSXP, 3)); + // We do not protect CHARSXP elements on purpose. + SEXP first_elem = mkChar("One"); + SET_STRING_ELT(str, 0, first_elem); + SEXP second_elem = mkChar("Two"); + SET_STRING_ELT(str, 1, second_elem); + SEXP third_elem = mkChar("Three"); + SET_STRING_ELT(str, 2, third_elem); + + // Check that the character vector is correctly initialized. + assert_same_str(CHAR(STRING_ELT(str, 0)), CHAR(first_elem)); + assert_same_str(CHAR(STRING_ELT(str, 1)), CHAR(second_elem)); + assert_same_str(CHAR(STRING_ELT(str, 2)), CHAR(third_elem)); + + // Reorder + SET_STRING_ELT(str, 0, third_elem); + SET_STRING_ELT(str, 2, first_elem); + + // Check that the character vector was correctly reordered. + assert_same_str(CHAR(STRING_ELT(str, 0)), CHAR(third_elem)); + assert_same_str(CHAR(STRING_ELT(str, 1)), CHAR(second_elem)); + assert_same_str(CHAR(STRING_ELT(str, 2)), CHAR(first_elem)); + + UNPROTECT(1); +} + +/** + * Reorder the elements of the character vector via DATAPTR. + * Currently, we know only data.table package that does this. + */ +static void reorder_via_dataptr_test() { + SEXP str = PROTECT(allocVector(STRSXP, 3)); + SEXP first_elem = mkChar("One"); + SET_STRING_ELT(str, 0, first_elem); + SEXP second_elem = mkChar("Two"); + SET_STRING_ELT(str, 1, second_elem); + SEXP third_elem = mkChar("Three"); + SET_STRING_ELT(str, 2, third_elem); + + // Check that the character vector is correctly initialized. + assert_same_str(CHAR(STRING_ELT(str, 0)), "One"); + assert_same_str(CHAR(STRING_ELT(str, 1)), "Two"); + assert_same_str(CHAR(STRING_ELT(str, 2)), "Three"); + + // Reorder via DATAPTR. + SEXP *dataptr = (SEXP *) DATAPTR(str); + dataptr[0] = third_elem; + dataptr[2] = first_elem; + + // Check (via STRING_ELT) that the character vector was correctly reordered. + assert_same_str(CHAR(STRING_ELT(str, 0)), "Three"); + assert_same_str(CHAR(STRING_ELT(str, 1)), "Two"); + assert_same_str(CHAR(STRING_ELT(str, 2)), "One"); + + UNPROTECT(1); +} + +/** + * Run with gctorture + */ +static void set_via_dataptr_test() { + SEXP str = PROTECT(allocVector(STRSXP, 2)); + SEXP *dataptr = (SEXP *) DATAPTR(str); + // Not protected on purpose. + dataptr[0] = mkChar("One"); + // `dataptr[0]` must not be collected here, as it is referenced by `str`. + dataptr[1] = mkChar("Two"); + assert_same_str(CHAR(STRING_ELT(str, 0)), "One"); + assert_same_str(CHAR(STRING_ELT(str, 1)), "Two"); + UNPROTECT(1); +} + +static void get_via_dataptr_test() { + SEXP str = PROTECT(allocVector(STRSXP, 1)); + // Get the dataptr before we set the values. + SEXP *dataptr = (SEXP *) DATAPTR(str); + SET_STRING_ELT(str, 0, mkChar("foo")); + assert_same_str(CHAR(dataptr[0]), "foo"); + UNPROTECT(1); +} + diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/charsxps.h b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/charsxps.h new file mode 100644 index 0000000000..f13f5b49ed --- /dev/null +++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/charsxps.h @@ -0,0 +1,30 @@ +/* + * Copyright (c) 2021, Oracle and/or its affiliates. All rights reserved. + * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. + * + * This code is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License version 3 only, as + * published by the Free Software Foundation. + * + * This code is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * version 3 for more details (a copy is included in the LICENSE file that + * accompanied this code). + * + * You should have received a copy of the GNU General Public License version + * 3 along with this work; if not, write to the Free Software Foundation, + * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. + * + * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA + * or visit www.oracle.com if you need additional information or have any + * questions. + */ +#include + +SEXP charsxp_replace_nth_str(SEXP str, SEXP n, SEXP replacement); +SEXP charsxp_nth_str(SEXP str, SEXP n); +SEXP charsxp_create_empty_str(SEXP n); +SEXP charsxp_revert_via_elt(SEXP str); +SEXP charsxp_revert_via_dataptr(SEXP str); +SEXP charsxp_tests(); diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c index 1fe51c762b..d8c4c1f825 100644 --- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c +++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c @@ -26,6 +26,7 @@ #include #include "testrffi.h" #include "serialization.h" +#include "charsxps.h" #include "rapi_helpers.h" #include "rffiwrappers.h" @@ -127,6 +128,12 @@ static const R_CallMethodDef CallEntries[] = { CALLDEF(testPRIMFUN, 2), CALLDEF(serialize, 1), CALLDEF(testInstallTrChar, 2), + CALLDEF(charsxp_replace_nth_str, 3), + CALLDEF(charsxp_nth_str, 2), + CALLDEF(charsxp_create_empty_str, 1), + CALLDEF(charsxp_revert_via_elt, 1), + CALLDEF(charsxp_revert_via_dataptr, 1), + CALLDEF(charsxp_tests, 0), #include "init_api.h" {NULL, NULL, 0} }; diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c index 48ec45ad3b..e7d6e779ea 100644 --- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c +++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c @@ -1184,3 +1184,25 @@ SEXP testInstallTrChar(SEXP strvec, SEXP env) { SEXP test_RfMatch(SEXP x, SEXP y) { return Rf_match(x, y, NA_INTEGER); } + +/** + * Values returned by Rf_mkChar must not be garbage-collected when they are referenced + * from some STRSXP vector. + * This behavior is assumed in, e.g., vctrs package version 0.3.6. + * Make sure this test runs with `gctorture()`. + */ +SEXP test_mkCharDoesNotCollect() { + SEXP string_one = PROTECT(allocVector(STRSXP, 1)); + SEXP char_sxp = mkChar("XX_YY"); + // Should be OK, char_sxp cannot be collected yet + SET_STRING_ELT(string_one, 0, char_sxp); + // char_sxp should be transitivelly referenced from GC root + + // char_sxp must not be collected here. + SEXP string_two = PROTECT(allocVector(STRSXP, 1)); + // If char_sxp is collected, the following statement throws an error. + SET_STRING_ELT(string_two, 0, char_sxp); + + UNPROTECT(2); + return list2(string_one, string_two); +} diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h index e72c49d282..23976a4a56 100644 --- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h +++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h @@ -179,4 +179,6 @@ extern SEXP testdiv(SEXP n); extern SEXP testInstallTrChar(SEXP strvec, SEXP env); -extern SEXP test_RfMatch(SEXP x, SEXP y); \ No newline at end of file +extern SEXP test_RfMatch(SEXP x, SEXP y); + +extern SEXP test_mkCharDoesNotCollect(); diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/charsxps.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/charsxps.R new file mode 100644 index 0000000000..dd7a76cb4e --- /dev/null +++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/charsxps.R @@ -0,0 +1,104 @@ +# Copyright (c) 2021, Oracle and/or its affiliates. All rights reserved. +# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +# +# This code is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License version 3 only, as +# published by the Free Software Foundation. +# +# This code is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# version 3 for more details (a copy is included in the LICENSE file that +# accompanied this code). +# +# You should have received a copy of the GNU General Public License version +# 3 along with this work; if not, write to the Free Software Foundation, +# Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. +# +# Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA +# or visit www.oracle.com if you need additional information or have any +# questions. + +library(testrffi) + +# Replace n-th string from `str` character vector with `replacement`. +# `n` is zero-based +replace_nth_str <- function(str, i, replacement) { + stopifnot(is.character(str) && length(str) > 0) + stopifnot(is.integer(i) && length(i) == 1) + stopifnot(is.character(replacement) && length(replacement) == 1) + .Call("charsxp_replace_nth_str", str, i, replacement) +} + +# Returns n-th element from `str`. +nth_str <- function(str, i) { + stopifnot(is.character(str) && length(str) > 0) + stopifnot(is.integer(i) && length(i) == 1) + .Call("charsxp_nth_str", str, i) +} + +create_empty_str <- function(i) { + stopifnot(is.integer(i) && length(i) == 1) + .Call("charsxp_create_empty_str", i) +} + +revert_via_elt <- function(str) { + stopifnot(is.character(str)) + .Call("charsxp_revert_via_elt", str) +} + +revert_via_dataptr <- function(str) { + stopifnot(is.character(str)) + .Call("charsxp_revert_via_dataptr", str) +} + +# Rest of the native tests +run_all_native_tests <- function() { + .Call("charsxp_tests") +} + +s <- c("a", "b", "c") +stopifnot(nth_str(s, 0L) == "a") +stopifnot(nth_str(s, 1L) == "b") +stopifnot(nth_str(s, 2L) == "c") + +# Replace some elements of a character vector in place with wrapper functions. +stopifnot( replace_nth_str(c("a", "b"), 0L, "foo") == c("foo", "b")) +stopifnot( replace_nth_str(c("a", "b"), 1L, "foo") == c("a", "foo")) + +s <- c("a", "b", "c") +replace_nth_str(s, 0L, "X") +stopifnot(s == c("X", "b", "c")) +replace_nth_str(s, 2L, "Y") +stopifnot(s == c("X", "b", "Y")) + +# Create a vector in native and manipulate with it in R. +s <- create_empty_str(3L) +s[1] <- "X" +stopifnot(s == c("X", "", "")) +replace_nth_str(s, 1L, "Y") +stopifnot(s == c("X", "Y", "")) +s[3] <- "Z" +stopifnot(s == c("X", "Y", "Z")) + +# Create a vector in R and revert it in native. +s <- c("a", "b", "c", "d") +revert_via_elt(s) +stopifnot(s == c("d", "c", "b", "a")) +revert_via_dataptr(s) +stopifnot(s == c("a", "b", "c", "d")) + +# Create a vector in native, modify it in R, and revert it in native. +s <- create_empty_str(3L) +s[1] <- "X" +s[2] <- "Y" +s[3] <- "Z" +stopifnot(s == c("X", "Y", "Z")) +revert_via_dataptr(s) +stopifnot(s == c("Z", "Y", "X")) +revert_via_elt(s) +stopifnot(s == c("X", "Y", "Z")) + + +# Run rest of the native tests +run_all_native_tests() \ No newline at end of file diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/rapiTests.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/rapiTests.R index 7ff5de1852..1737132002 100644 --- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/rapiTests.R +++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/rapiTests.R @@ -261,3 +261,15 @@ assertEquals(rffi.test_RfMatch(c("x", "y"), "y"), 2L) assertEquals(rffi.test_RfMatch(c("x", "y"), "foo"), NA_integer_) assertEquals(rffi.test_RfMatch(c(), "foo"), NA_integer_) assertEquals(rffi.test_RfMatch(c(), c("foo", "bar")), c(NA_integer_, NA_integer_)) + +# ---------------------------------------------------------------------------------------- +# Rf_mkChar should not be garbage collected +gctorture(on = TRUE) +assertEquals(rffi.test_mkCharDoesNotCollect(), list("XX_YY", "XX_YY")) +gctorture(on = FALSE) + +# ---------------------------------------------------------------------------------------- +# Rf_allocArray +arr <- api.Rf_allocArray(13L, c(2L, 2L)) # INTSXP +assertEquals(4, length(arr)) +assertEquals(c(2L, 2L), dim(arr)) diff --git a/documentation/dev/ffi.md b/documentation/dev/ffi.md index 5ac2315460..2cc47a6690 100644 --- a/documentation/dev/ffi.md +++ b/documentation/dev/ffi.md @@ -164,4 +164,4 @@ referencing object in GNU-R. What this approach doesn't solve is that the extens may assume that changes done in such objects (e.g., attributes pair-list) will be visible in their referencing object. At this point, we ignore this potential problem. -Additionally, in in case of a downcall, the materialized version of a `RBaseObject` has to be kept alive until the downcall returns, so that it is ensured that an eventual upcall might still get access to the original downcalls argument object. +Additionally, in case of a downcall, the materialized version of a `RBaseObject` has to be kept alive until the downcall returns, so that it is ensured that an eventual upcall might still get access to the original downcalls argument object.