1# Licensed to the Apache Software Foundation (ASF) under one
2# or more contributor license agreements.  See the NOTICE file
3# distributed with this work for additional information
4# regarding copyright ownership.  The ASF licenses this file
5# to you under the Apache License, Version 2.0 (the
6# "License"); you may not use this file except in compliance
7# with the License.  You may obtain a copy of the License at
8#
9#   http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing,
12# software distributed under the License is distributed on an
13# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
14# KIND, either express or implied.  See the License for the
15# specific language governing permissions and limitations
16# under the License.
17
18
19expect_scalar_roundtrip <- function(x, type) {
20  s <- Scalar$create(x)
21  expect_r6_class(s, "Scalar")
22  expect_equal(s$type, type)
23  expect_identical(length(s), 1L)
24  if (inherits(type, "NestedType")) {
25    # Should this be? Missing if all elements are missing?
26    # expect_identical(is.na(s), all(is.na(x))) # nolint
27  } else {
28    expect_identical(as.vector(is.na(s)), is.na(x))
29    # MakeArrayFromScalar not implemented for list types
30    expect_as_vector(s, x)
31  }
32}
33
34test_that("Scalar object roundtrip", {
35  expect_scalar_roundtrip(2, float64())
36  expect_scalar_roundtrip(2L, int32())
37  expect_scalar_roundtrip(c(2, 4), list_of(float64()))
38  expect_scalar_roundtrip(c(NA, NA), list_of(bool()))
39  expect_scalar_roundtrip(data.frame(a = 2, b = 4L), struct(a = double(), b = int32()))
40})
41
42test_that("Scalar print", {
43  expect_output(print(Scalar$create(4)), "Scalar\n4")
44})
45
46test_that("Creating Scalars of a different type and casting them", {
47  expect_equal(Scalar$create(4L, int8())$type, int8())
48  expect_equal(Scalar$create(4L)$cast(float32())$type, float32())
49})
50
51test_that("Scalar to Array", {
52  a <- Scalar$create(42)
53  expect_equal(a$as_array(), Array$create(42))
54  expect_equal(Array$create(a), Array$create(42))
55})
56
57test_that("Scalar$Equals", {
58  a <- Scalar$create(42)
59  aa <- Array$create(42)
60  b <- Scalar$create(42)
61  d <- Scalar$create(43)
62  expect_equal(a, b)
63  expect_true(a$Equals(b))
64  expect_false(a$Equals(d))
65  expect_false(a$Equals(aa))
66})
67
68test_that("Scalar$ApproxEquals", {
69  a <- Scalar$create(1.0000000000001)
70  aa <- Array$create(1.0000000000001)
71  b <- Scalar$create(1.0)
72  d <- 2.400000000000001
73  expect_false(a$Equals(b))
74  expect_true(a$ApproxEquals(b))
75  expect_false(a$ApproxEquals(d))
76  expect_false(a$ApproxEquals(aa))
77})
78
79test_that("Handling string data with embedded nuls", {
80  raws <- as.raw(c(0x6d, 0x61, 0x00, 0x6e))
81  expect_error(
82    rawToChar(raws),
83    "embedded nul in string: 'ma\\0n'", # See?
84    fixed = TRUE
85  )
86  scalar_with_nul <- Scalar$create(raws, binary())$cast(utf8())
87
88  # The behavior of the warnings/errors is slightly different with and without
89  # altrep. Without it (i.e. 3.5.0 and below, the error would trigger immediately
90  # on `as.vector()` where as with it, the error only happens on materialization)
91  skip_if_r_version("3.5.0")
92  v <- expect_error(as.vector(scalar_with_nul), NA)
93  expect_error(
94    v[1],
95    paste0(
96      "embedded nul in string: 'ma\\0n'; to strip nuls when converting from Arrow to R, ",
97      "set options(arrow.skip_nul = TRUE)"
98    ),
99    fixed = TRUE
100  )
101
102  withr::with_options(list(arrow.skip_nul = TRUE), {
103    expect_warning(
104      expect_identical(
105        as.vector(scalar_with_nul)[],
106        "man"
107      ),
108      "Stripping '\\0' (nul) from character vector",
109      fixed = TRUE
110    )
111  })
112})
113