tests/testthat/test-mocked-provider-sync.R

test_that("sync_local_fred_data uses mocked provider functions", {
  local_dir <- withr::local_tempdir()

  mocked_data <- data.table::data.table(
    date = as.Date(c("2026-02-01", "2026-03-01")),
    value = c(4.2, 4.3)
  )
  mocked_utime <- as.POSIXct("2026-03-20 00:00:00", tz = "UTC")

  res <- testthat::with_mocked_bindings(
    get_source_data_fred = function(series_id, config = NULL) {
      expect_equal(series_id, "FEDFUNDS")
      mocked_data
    },
    get_source_utime_fred = function(series_id, config = NULL, from_server = FALSE, tz = "America/Chicago") {
      expect_equal(series_id, "FEDFUNDS")
      mocked_utime
    },
    investdatar::sync_local_fred_data("FEDFUNDS", local_path = local_dir),
    .package = "investdatar"
  )

  local_dt <- readRDS(file.path(local_dir, "FEDFUNDS.rds"))
  local_meta <- readRDS(file.path(local_dir, "FEDFUNDS.meta.rds"))

  expect_true(res$updated)
  expect_equal(local_dt$value, mocked_data$value)
  expect_equal(local_meta$source_updated_at, mocked_utime)
})

test_that("get_source_data_fred errors when available series returns empty observations", {
  expect_error(
    testthat::with_mocked_bindings(
      .get_api_config = function(source, config = NULL) {
        list(api_key = "key", url = "https://api.stlouisfed.org/fred/series", mode = "json")
      },
      .fetch_fred_json = function(url) {
        list(observations = data.table::data.table())
      },
      get_source_metadata_fred = function(series_id, config = NULL) {
        list(
          title = "Available test series",
          start = "1990-04-01",
          end = "2026-01-01",
          freq = "Quarterly",
          units = "Percent",
          season = "Not Seasonally Adjusted"
        )
      },
      investdatar::get_source_data_fred("SUBLPDCILTLNQ"),
      .package = "investdatar"
    ),
    "zero rows for available series"
  )
})

test_that("sync_local_okx_candle supports mocked latest and history fetches", {
  local_dir <- withr::local_tempdir()

  latest_dt <- data.table::data.table(
    source = "okx",
    symbol = "BTC-USDT-SWAP",
    interval = "4H",
    datetime = as.POSIXct(c("2026-03-26 00:00:00", "2026-03-26 04:00:00"), tz = "UTC"),
    date = as.Date(c("2026-03-26", "2026-03-26")),
    open = c(1, 2),
    high = c(2, 3),
    low = c(0.5, 1.5),
    close = c(1.5, 2.5),
    volume = c(10, 20)
  )
  hist_dt <- data.table::data.table(
    source = "okx",
    symbol = "BTC-USDT-SWAP",
    interval = "4H",
    datetime = as.POSIXct(c("2026-03-25 16:00:00", "2026-03-25 20:00:00"), tz = "UTC"),
    date = as.Date(c("2026-03-25", "2026-03-25")),
    open = c(0.8, 0.9),
    high = c(1.0, 1.1),
    low = c(0.7, 0.8),
    close = c(0.9, 1.0),
    volume = c(8, 9)
  )

  res_latest <- testthat::with_mocked_bindings(
    get_source_data_okx_candle = function(inst_id, bar, limit = 100L, config, tz = "UTC") latest_dt,
    get_source_utime_okx_candle = function(bar, tz = "UTC") as.POSIXct("2026-03-26 04:00:00", tz = "UTC"),
    investdatar::sync_local_okx_candle("BTC-USDT-SWAP", "4H", config = list(), local_path = local_dir, mode = "latest"),
    .package = "investdatar"
  )

  res_hist <- testthat::with_mocked_bindings(
    get_source_hist_data_okx_candle = function(inst_id, bar, before = NULL, limit = 100L, config, tz = "UTC") hist_dt,
    investdatar::sync_local_okx_candle("BTC-USDT-SWAP", "4H", config = list(), local_path = local_dir, mode = "history"),
    .package = "investdatar"
  )

  local_dt <- readRDS(file.path(local_dir, "BTC-USDT-SWAP_4H.rds"))

  expect_true(res_latest$updated)
  expect_true(res_hist$updated)
  expect_equal(nrow(local_dt), 4L)
  expect_equal(local_dt$datetime[[1]], as.POSIXct("2026-03-25 16:00:00", tz = "UTC"))
})

test_that("sync_local_okx_candle uses default okx config when config is omitted", {
  local_dir <- withr::local_tempdir()
  fetched_cfg <- list(api_key = "okx-key", secret_key = "okx-secret", passphrase = "okx-pass")
  mocked_dt <- data.table::data.table(
    source = "okx",
    symbol = "BTC-USDT-SWAP",
    interval = "4H",
    datetime = as.POSIXct("2026-03-26 00:00:00", tz = "UTC"),
    date = as.Date("2026-03-26"),
    open = 1,
    high = 2,
    low = 0.5,
    close = 1.5,
    volume = 10
  )

  res <- testthat::with_mocked_bindings(
    .get_api_config = function(source, config = NULL) {
      if (identical(source, "okx")) {
        fetched_cfg
      } else {
        list()
      }
    },
    get_source_data_okx_candle = function(inst_id, bar, limit = 100L, config = NULL, tz = "UTC") {
      expect_identical(config, fetched_cfg)
      mocked_dt
    },
    get_source_utime_okx_candle = function(bar, tz = "UTC") as.POSIXct("2026-03-26 04:00:00", tz = "UTC"),
    investdatar::sync_local_okx_candle("BTC-USDT-SWAP", "4H", local_path = local_dir, mode = "latest"),
    .package = "investdatar"
  )

  local_dt <- investdatar::get_local_okx_candle("BTC-USDT-SWAP", "4H", local_path = local_dir)
  expect_true(res$updated)
  expect_equal(nrow(local_dt), 1L)
})

test_that("repair_local_okx_candle_gaps fetches multiple pages and writes once", {
  local_dir <- withr::local_tempdir()
  calls <- new.env(parent = emptyenv())
  calls$before <- character()

  res <- testthat::with_mocked_bindings(
    get_source_hist_data_okx_candle = function(inst_id, bar, before = NULL, limit = 100L, config, tz = "UTC") {
      calls$before <- c(calls$before, before)
      data.table::data.table(
        source = "okx",
        symbol = inst_id,
        interval = bar,
        datetime = as.POSIXct(as.numeric(before), origin = "1970-01-01", tz = "UTC"),
        date = as.Date(as.POSIXct(as.numeric(before), origin = "1970-01-01", tz = "UTC")),
        open = 1,
        high = 2,
        low = 0.5,
        close = 1.5,
        volume = 10
      )
    },
    investdatar::repair_local_okx_candle_gaps(
      "BTC-USDT-SWAP",
      "4H",
      before = c("1770000000", "1770014400"),
      config = list(),
      local_path = local_dir
    ),
    .package = "investdatar"
  )

  local_dt <- investdatar::get_local_okx_candle("BTC-USDT-SWAP", "4H", local_path = local_dir)
  expect_true(res$updated)
  expect_equal(calls$before, c("1770000000", "1770014400"))
  expect_equal(nrow(local_dt), 2L)
})

test_that("sync_local_binance_klines writes data under the binance local layout", {
  local_dir <- withr::local_tempdir()

  mocked_dt <- data.table::data.table(
    source = "binance",
    symbol = "ETHUSDT",
    interval = "1m",
    datetime = as.POSIXct(c("2026-03-26 00:00:00", "2026-03-26 00:01:00"), tz = "UTC"),
    date = as.Date(c("2026-03-26", "2026-03-26")),
    open = c(1, 2),
    high = c(2, 3),
    low = c(0.5, 1.5),
    close = c(1.5, 2.5),
    volume = c(10, 20)
  )

  res <- testthat::with_mocked_bindings(
    get_source_data_binance_klines = function(symbol = "ETHUSDT", interval = "1m", start_time = NULL, end_time = NULL, limit = 1500L, tz = "UTC", paginate = TRUE) mocked_dt,
    investdatar::sync_local_binance_klines("ETHUSDT", "1m", local_path = local_dir),
    .package = "investdatar"
  )

  local_dt <- investdatar::get_local_binance_klines("ETHUSDT", "1m", local_path = local_dir)

  expect_true(res$updated)
  expect_equal(nrow(local_dt), 2L)
  expect_equal(local_dt$close, c(1.5, 2.5))
})

test_that("repair_local_binance_klines_gaps fetches multiple windows and writes once", {
  local_dir <- withr::local_tempdir()
  calls <- new.env(parent = emptyenv())
  calls$start_time <- character()

  windows <- data.table::data.table(
    start_time = as.POSIXct(c("2026-03-26 00:00:00", "2026-03-26 00:02:00"), tz = "UTC"),
    end_time = as.POSIXct(c("2026-03-26 00:01:00", "2026-03-26 00:03:00"), tz = "UTC")
  )

  res <- testthat::with_mocked_bindings(
    get_source_data_binance_klines = function(symbol = "ETHUSDT", interval = "1m", start_time = NULL, end_time = NULL, limit = 1500L, tz = "UTC", paginate = TRUE) {
      calls$start_time <- c(calls$start_time, format(as.POSIXct(start_time, tz = "UTC"), "%Y-%m-%d %H:%M:%S"))
      data.table::data.table(
        source = "binance",
        symbol = symbol,
        interval = interval,
        datetime = as.POSIXct(start_time, tz = "UTC"),
        date = as.Date(as.POSIXct(start_time, tz = "UTC")),
        open = 1,
        high = 2,
        low = 0.5,
        close = 1.5,
        volume = 10
      )
    },
    investdatar::repair_local_binance_klines_gaps(
      "ETHUSDT",
      "1m",
      windows = windows,
      local_path = local_dir
    ),
    .package = "investdatar"
  )

  local_dt <- investdatar::get_local_binance_klines("ETHUSDT", "1m", local_path = local_dir)
  expect_true(res$updated)
  expect_equal(calls$start_time, format(windows$start_time, "%Y-%m-%d %H:%M:%S"))
  expect_equal(nrow(local_dt), 2L)
})

test_that("sync_local_ishare_holdings writes holdings snapshots under the ishare local layout", {
  local_dir <- withr::local_tempdir()

  mocked_dt <- data.table::data.table(
    ticker = c("IVV", "IVV"),
    updated_date = as.Date(c("2026-03-26", "2026-03-26")),
    holding_ticker = c("AAPL", "MSFT"),
    holding_name = c("Apple Inc.", "Microsoft Corp."),
    sector = c("Information Technology", "Information Technology"),
    asset_class = c("Equity", "Equity"),
    weight_pct = c(7.1, 6.2),
    location = c("United States", "United States"),
    exchange = c("NASDAQ", "NASDAQ")
  )

  res <- testthat::with_mocked_bindings(
    get_source_data_ishare_holdings = function(ticker, ishare_mega_data = NULL, cache_dir = NULL, local_path = NULL) mocked_dt,
    get_source_utime_ishare = function(tz = "America/New_York", check_online = TRUE) as.POSIXct("2026-03-26 00:00:00", tz = "UTC"),
    investdatar::sync_local_ishare_holdings("IVV", local_path = local_dir),
    .package = "investdatar"
  )

  local_dt <- investdatar::get_local_ishare_holdings("IVV", local_path = local_dir)

  expect_true(res$updated)
  expect_equal(nrow(local_dt), 2L)
  expect_equal(local_dt$holding_ticker, c("AAPL", "MSFT"))
  expect_equal(local_dt$ticker, c("IVV", "IVV"))
})

test_that("sync_local_ishare_holdings migrates legacy snapshot lists into long format", {
  local_dir <- withr::local_tempdir()
  legacy_path <- file.path(local_dir, "DYNF_holdings.rds")

  saveRDS(
    list(
      `2026-03-25` = data.table::data.table(
        Ticker = "AAPL",
        Name = "Apple Inc.",
        Sector = "Information Technology",
        `Asset Class` = "Equity",
        `Weight (%)` = "7.10",
        Location = "United States",
        Exchange = "NASDAQ"
      )
    ),
    legacy_path
  )

  mocked_dt <- data.table::data.table(
    ticker = "DYNF",
    updated_date = as.Date("2026-03-26"),
    holding_ticker = "MSFT",
    holding_name = "Microsoft Corp.",
    sector = "Information Technology",
    asset_class = "Equity",
    weight_pct = 6.2,
    location = "United States",
    exchange = "NASDAQ"
  )

  res <- testthat::with_mocked_bindings(
    get_source_data_ishare_holdings = function(ticker, ishare_mega_data = NULL, cache_dir = NULL, local_path = NULL) mocked_dt,
    get_source_utime_ishare = function(tz = "America/New_York", check_online = TRUE) as.POSIXct("2026-03-26 00:00:00", tz = "UTC"),
    investdatar::sync_local_ishare_holdings("DYNF", local_path = local_dir),
    .package = "investdatar"
  )

  local_dt <- readRDS(legacy_path)

  expect_true(res$updated)
  expect_s3_class(local_dt, "data.table")
  expect_equal(names(local_dt), c("ticker", "updated_date", "holding_ticker", "holding_name", "sector", "asset_class", "weight_pct", "location", "exchange"))
  expect_equal(local_dt$holding_ticker, c("AAPL", "MSFT"))
})

test_that("sync_local_quantmod_OHLC uses the yahoo local layout", {
  local_dir <- withr::local_tempdir()

  mocked_dt <- data.table::data.table(
    source = "quantmod_yahoo",
    symbol = "SPY",
    interval = "1d",
    datetime = as.POSIXct(c("2026-03-25 00:00:00", "2026-03-26 00:00:00"), tz = "UTC"),
    date = as.Date(c("2026-03-25", "2026-03-26")),
    open = c(1, 2),
    high = c(2, 3),
    low = c(0.5, 1.5),
    close = c(1.5, 2.5),
    volume = c(10, 20)
  )

  res <- testthat::with_mocked_bindings(
    fetch_quantmod_OHLC = function(ticker, label = ticker, from, to, src = "yahoo", raw_data = FALSE, ...) mocked_dt,
    investdatar::sync_local_quantmod_OHLC("SPY", from = "2026-03-25", to = "2026-03-26", local_path = local_dir),
    .package = "investdatar"
  )

  local_dt <- investdatar::get_local_quantmod_OHLC("SPY", local_path = local_dir)

  expect_true(res$updated)
  expect_equal(nrow(local_dt), 2L)
  expect_equal(local_dt$close, c(1.5, 2.5))
})

test_that("sync_local_quantmod_OHLC refreshes existing daily rows with revised values", {
  local_dir <- withr::local_tempdir()

  stale_dt <- data.table::data.table(
    source = "quantmod_yahoo",
    symbol = "HSI",
    interval = "1d",
    datetime = as.POSIXct(c("2026-03-30 00:00:00", "2026-03-31 00:00:00"), tz = "UTC"),
    date = as.Date(c("2026-03-30", "2026-03-31")),
    open = c(1, 2),
    high = c(2, 3),
    low = c(0.5, 1.5),
    close = c(NA_real_, 2.5),
    volume = c(10, 20)
  )
  saveRDS(stale_dt, file.path(local_dir, "HSI__yahoo__1d.rds"))

  refreshed_dt <- data.table::data.table(
    source = "quantmod_yahoo",
    symbol = "HSI",
    interval = "1d",
    datetime = as.POSIXct(c("2026-03-30 00:00:00", "2026-03-31 00:00:00", "2026-04-01 00:00:00"), tz = "UTC"),
    date = as.Date(c("2026-03-30", "2026-03-31", "2026-04-01")),
    open = c(1, 2, 3),
    high = c(2, 3, 4),
    low = c(0.5, 1.5, 2.5),
    close = c(2.1, 2.5, 3.5),
    volume = c(10, 20, 30)
  )

  res <- testthat::with_mocked_bindings(
    fetch_quantmod_OHLC = function(ticker, label = ticker, from, to, src = "yahoo", raw_data = FALSE, ...) refreshed_dt,
    investdatar::sync_local_quantmod_OHLC("HSI", from = "2026-03-30", to = "2026-04-01", local_path = local_dir),
    .package = "investdatar"
  )

  local_dt <- investdatar::get_local_quantmod_OHLC("HSI", local_path = local_dir)

  expect_true(res$updated)
  expect_equal(res$n_new_rows, 1L)
  expect_equal(local_dt[date == as.Date("2026-03-30"), close][[1]], 2.1)
  expect_equal(max(local_dt$date), as.Date("2026-04-01"))
  expect_equal(nrow(local_dt), 3L)
})

test_that("completed Yahoo daily OHLC excludes finite current-UTC futures and crypto bars", {
  local_dir <- withr::local_tempdir()
  as_of <- as.POSIXct("2026-08-10 12:00:00", tz = "UTC")
  for (ticker in c("ZT=F", "BTC-USD")) {
    dt <- data.table::data.table(
      source = "quantmod_yahoo", symbol = ticker, interval = "1d",
      datetime = as.POSIXct(c("2026-08-09", "2026-08-10"), tz = "UTC"),
      date = as.Date(c("2026-08-09", "2026-08-10")),
      open = c(1, 2), high = c(2, 3), low = c(0.5, 1.5), close = c(1.5, 2.5), volume = c(10, 20)
    )
    filename <- getFromNamespace(".quantmod_local_filename", "investdatar")(ticker, src = "yahoo", interval = "1d")
    saveRDS(dt, file.path(local_dir, filename))
    completed <- investdatar::get_completed_local_quantmod_OHLC(ticker, local_path = local_dir, as_of = as_of)
    raw <- investdatar::get_local_quantmod_OHLC(ticker, local_path = local_dir)
    expect_equal(nrow(raw), 2L)
    expect_equal(completed$date, as.Date("2026-08-09"))
  }
})

test_that("next overlap sync replaces a provisional daily Yahoo bar once completed", {
  local_dir <- withr::local_tempdir()
  provisional <- data.table::data.table(
    source = "quantmod_yahoo", symbol = "ZT=F", interval = "1d",
    datetime = as.POSIXct("2026-08-10", tz = "UTC"), date = as.Date("2026-08-10"),
    open = 110, high = 111, low = 109, close = 110.5, volume = 100
  )
  final <- data.table::copy(provisional)
  final[, `:=`(high = 112, close = 111.75, volume = 250)]
  first <- testthat::with_mocked_bindings(
    fetch_quantmod_OHLC = function(...) provisional,
    investdatar::sync_local_quantmod_OHLC("ZT=F", from = "2026-08-10", to = "2026-08-10", local_path = local_dir),
    .package = "investdatar"
  )
  second <- testthat::with_mocked_bindings(
    fetch_quantmod_OHLC = function(...) final,
    investdatar::sync_local_quantmod_OHLC("ZT=F", from = "2026-08-10", to = "2026-08-11", local_path = local_dir),
    .package = "investdatar"
  )
  raw <- investdatar::get_local_quantmod_OHLC("ZT=F", local_path = local_dir)
  completed <- investdatar::get_completed_local_quantmod_OHLC(
    "ZT=F", local_path = local_dir, as_of = as.POSIXct("2026-08-11 00:00:01", tz = "UTC")
  )

  expect_true(first$updated)
  expect_true(second$updated)
  expect_equal(raw$close, 111.75)
  expect_equal(completed$close, 111.75)
})

test_that("sync_local_quantmod_OHLC surfaces upstream quantmod errors", {
  local_dir <- withr::local_tempdir()

  testthat::with_mocked_bindings(
    fetch_quantmod_OHLC = function(ticker, label = ticker, from, to, src = "yahoo", raw_data = FALSE, ...) {
      stop("quantmod failed to fetch 'DX-Y.NYB' from source 'yahoo': no data for symbol", call. = FALSE)
    },
    expect_error(
      investdatar::sync_local_quantmod_OHLC("DX-Y.NYB", from = "2026-03-01", to = "2026-03-31", local_path = local_dir),
      "quantmod failed to fetch 'DX-Y.NYB' from source 'yahoo': no data for symbol"
    ),
    .package = "investdatar"
  )
})

test_that("fetch_quantmod_OHLC retries transient symbol failures with bounded backoff", {
  attempts <- 0L
  x <- xts::xts(
    cbind(Open = c(1, 2), High = c(2, 3), Low = c(0.5, 1.5), Close = c(1.5, 2.5), Volume = c(10, 20), Adjusted = c(1.5, 2.5)),
    order.by = as.Date(c("2026-03-25", "2026-03-26"))
  )
  colnames(x) <- paste0("SPY.", colnames(x))

  dt <- testthat::with_mocked_bindings(
    .quantmod_get_symbols = function(...) {
      attempts <<- attempts + 1L
      if (attempts < 3L) stop("temporary Yahoo response failure")
      x
    },
    investdatar::fetch_quantmod_OHLC(
      "SPY", from = "2026-03-25", to = "2026-03-26",
      max_attempts = 3L, retry_delay_seconds = 0
    ),
    .package = "investdatar"
  )

  expect_equal(attempts, 3L)
  expect_equal(attr(dt, "investdatar_fetch_method"), "quantmod")
  expect_equal(attr(dt, "investdatar_fetch_attempts"), 3L)
})

test_that("fetch_quantmod_OHLC rejects malformed HTTP-200-style null OHLC payloads", {
  x <- xts::xts(
    cbind(Open = 1, High = 2, Low = 0.5, Close = NA_real_, Volume = 10, Adjusted = NA_real_),
    order.by = as.Date("2026-08-10")
  )
  colnames(x) <- paste0("000300.SS.", colnames(x))

  testthat::with_mocked_bindings(
    .quantmod_get_symbols = function(...) x,
    .fetch_yahoo_chart_range_ohlc = function(...) {
      investdatar:::.quantmod_xts_to_ohlc(x, "000300.SS", "yahoo")
    },
    expect_error(
      investdatar::fetch_quantmod_OHLC(
        "000300.SS", from = "2026-07-24", to = "2026-08-10",
        max_attempts = 2L, retry_delay_seconds = 0, fallback_source = NULL
      ),
      class = "investdatar_quantmod_error"
    ),
    .package = "investdatar"
  )
})

test_that("fetch_quantmod_OHLC reports retry exhaustion", {
  attempts <- 0L
  testthat::with_mocked_bindings(
    .quantmod_get_symbols = function(...) {
      attempts <<- attempts + 1L
      stop("temporary transport failure")
    },
    .fetch_yahoo_chart_range_ohlc = function(...) stop("Yahoo chart endpoint unavailable"),
    expect_error(
      investdatar::fetch_quantmod_OHLC(
        "SPY", from = "2026-08-03", to = "2026-08-04",
        max_attempts = 2L, retry_delay_seconds = 0, fallback_source = NULL
      ),
      class = "investdatar_quantmod_error"
    ),
    .package = "investdatar"
  )
  expect_equal(attempts, 2L)
})

test_that("new listings skip start-coverage checks while established series do not", {
  dt <- data.table::data.table(
    source = "quantmod_yahoo", symbol = "NEW", interval = "1d",
    datetime = as.POSIXct("2026-08-10", tz = "UTC"), date = as.Date("2026-08-10"),
    open = 1, high = 2, low = 0.5, close = 1.5, volume = 10
  )
  expect_silent(investdatar:::.validate_quantmod_ohlc_window(
    dt, ticker = "NEW", src = "yahoo", from = "2026-07-24", to = "2026-08-10",
    require_start_coverage = FALSE
  ))
  expect_error(
    investdatar:::.validate_quantmod_ohlc_window(
      dt, ticker = "NEW", src = "yahoo", from = "2026-07-24", to = "2026-08-10",
      require_start_coverage = TRUE
    ),
    class = "investdatar_incomplete_window_error"
  )
})

test_that("Eastmoney fallback is explicit and returns standardized CSI 300 bars", {
  payload <- list(data = list(klines = c(
    "2026-07-24,4685.41,4649.19,4704.08,4642.94,221261212",
    "2026-07-27,4656.03,4702.43,4702.52,4615.53,204786941"
  )))
  dt <- testthat::with_mocked_bindings(
    .http_get_json = function(...) payload,
    investdatar:::.fetch_eastmoney_ohlc("1.000300", "000300.SS", "2026-07-24", "2026-07-27"),
    .package = "investdatar"
  )

  expect_equal(dt$source, c("eastmoney", "eastmoney"))
  expect_equal(dt$date, as.Date(c("2026-07-24", "2026-07-27")))
  expect_equal(dt$close, c(4649.19, 4702.43))
})

test_that("fetch_quantmod_OHLC reports when an explicit fallback was used", {
  fallback_dt <- data.table::data.table(
    source = c("eastmoney", "eastmoney"), symbol = "000300.SS", interval = "1d",
    datetime = as.POSIXct(c("2026-07-24", "2026-07-27"), tz = "UTC"),
    date = as.Date(c("2026-07-24", "2026-07-27")),
    open = c(1, 2), high = c(2, 3), low = c(0.5, 1.5), close = c(1.5, 2.5), volume = c(10, 20)
  )
  dt <- testthat::with_mocked_bindings(
    .quantmod_get_symbols = function(...) stop("attempt to set an attribute on NULL"),
    .fetch_yahoo_chart_range_ohlc = function(...) stop("Yahoo chart endpoint returned incomplete rows"),
    .fetch_eastmoney_ohlc = function(...) fallback_dt,
    investdatar::fetch_quantmod_OHLC(
      "000300.SS", from = "2026-07-24", to = "2026-07-27", max_attempts = 2L,
      retry_delay_seconds = 0, fallback_source = "eastmoney", fallback_ticker = "1.000300"
    ),
    .package = "investdatar"
  )

  expect_equal(attr(dt, "investdatar_fetch_method"), "eastmoney_fallback")
  expect_equal(attr(dt, "investdatar_fetch_attempts"), 2L)
  expect_match(attr(dt, "investdatar_primary_error"), "attempt to set an attribute on NULL")
  expect_equal(attr(dt, "investdatar_primary_error_class"), "simpleError")
  expect_equal(unique(dt$source), "eastmoney")
})

test_that("fetch_quantmod_OHLC uses Yahoo chart-range recovery before external fallback", {
  recovered_dt <- data.table::data.table(
    source = "quantmod_yahoo", symbol = "CNH=X", interval = "1d",
    datetime = as.POSIXct(c("2026-07-24", "2026-07-27"), tz = "UTC"),
    date = as.Date(c("2026-07-24", "2026-07-27")),
    open = c(1, 2), high = c(2, 3), low = c(0.5, 1.5), close = c(1.5, 2.5), volume = c(10, 20)
  )
  dt <- testthat::with_mocked_bindings(
    .quantmod_get_symbols = function(...) stop("dated Yahoo request failed"),
    .fetch_yahoo_chart_range_ohlc = function(...) recovered_dt,
    investdatar::fetch_quantmod_OHLC(
      "CNH=X", from = "2026-07-24", to = "2026-07-27", max_attempts = 2L, retry_delay_seconds = 0
    ),
    .package = "investdatar"
  )

  expect_equal(attr(dt, "investdatar_fetch_method"), "yahoo_chart_range_fallback")
  expect_equal(attr(dt, "investdatar_fetch_attempts"), 2L)
  expect_match(attr(dt, "investdatar_primary_error"), "dated Yahoo request failed")
  expect_equal(unique(dt$source), "quantmod_yahoo")
})

test_that("validation drops isolated invalid OHLC rows without rejecting complete coverage", {
  dt <- data.table::data.table(
    source = "quantmod_yahoo", symbol = "DX-Y.NYB", interval = "1d",
    datetime = as.POSIXct(c("2026-08-03", "2026-08-04", "2026-08-05"), tz = "UTC"),
    date = as.Date(c("2026-08-03", "2026-08-04", "2026-08-05")),
    open = c(1, NA_real_, 3), high = c(2, NA_real_, 4), low = c(0.5, NA_real_, 2.5),
    close = c(1.5, NA_real_, 3.5), volume = c(10, NA_real_, 30)
  )
  validated <- investdatar:::.validate_quantmod_ohlc_window(
    dt, ticker = "DX-Y.NYB", src = "yahoo", from = "2026-08-03", to = "2026-08-05",
    require_start_coverage = TRUE
  )

  expect_equal(nrow(validated), 2L)
  expect_equal(attr(validated, "investdatar_invalid_ohlc_rows"), 1L)
})

test_that("sync_local_quantmod_OHLC rejects incomplete bars without replacing valid cache rows", {
  local_dir <- withr::local_tempdir()
  local_file <- file.path(local_dir, "000300.SS__yahoo__1d.rds")
  old_dt <- data.table::data.table(
    source = "quantmod_yahoo", symbol = "000300.SS", interval = "1d",
    datetime = as.POSIXct("2026-08-03", tz = "UTC"), date = as.Date("2026-08-03"),
    open = 1, high = 2, low = 0.5, close = 1.5, volume = 10, adj_close = 1.5
  )
  saveRDS(old_dt, local_file)
  incomplete_dt <- data.table::copy(old_dt)
  incomplete_dt[, `:=`(datetime = as.POSIXct("2026-08-10", tz = "UTC"), date = as.Date("2026-08-10"), close = NA_real_)]

  testthat::with_mocked_bindings(
    fetch_quantmod_OHLC = function(...) incomplete_dt,
    expect_error(
      investdatar::sync_local_quantmod_OHLC(
        "000300.SS", from = "2026-08-01", to = "2026-08-10", local_path = local_dir
      ),
      class = "investdatar_incomplete_window_error"
    ),
    .package = "investdatar"
  )

  expect_equal(readRDS(local_file), old_dt)
})

test_that("fallback sync fills invalid rows but preserves valid primary-source rows", {
  local_dir <- withr::local_tempdir()
  local_file <- file.path(local_dir, "000300.SS__yahoo__1d.rds")
  old_dt <- data.table::data.table(
    source = "quantmod_yahoo", symbol = "000300.SS", interval = "1d",
    datetime = as.POSIXct(c("2026-08-03", "2026-08-04"), tz = "UTC"),
    date = as.Date(c("2026-08-03", "2026-08-04")),
    open = c(1, NA_real_), high = c(2, NA_real_), low = c(0.5, NA_real_),
    close = c(1.5, NA_real_), volume = c(10, NA_real_), adj_close = c(1.5, NA_real_)
  )
  saveRDS(old_dt, local_file)
  fallback_dt <- data.table::copy(old_dt)
  fallback_dt[, `:=`(
    source = "eastmoney", open = c(10, 20), high = c(11, 21), low = c(9, 19),
    close = c(10.5, 20.5), volume = c(100, 200), adj_close = NA_real_
  )]
  attr(fallback_dt, "investdatar_fetch_method") <- "eastmoney_fallback"
  attr(fallback_dt, "investdatar_fetch_attempts") <- 3L

  testthat::with_mocked_bindings(
    fetch_quantmod_OHLC = function(...) fallback_dt,
    investdatar::sync_local_quantmod_OHLC(
      "000300.SS", from = "2026-08-03", to = "2026-08-04", local_path = local_dir
    ),
    .package = "investdatar"
  )

  repaired <- readRDS(local_file)
  expect_equal(repaired[date == as.Date("2026-08-03"), close][[1]], 1.5)
  expect_equal(repaired[date == as.Date("2026-08-03"), source][[1]], "quantmod_yahoo")
  expect_equal(repaired[date == as.Date("2026-08-04"), close][[1]], 20.5)
  expect_equal(repaired[date == as.Date("2026-08-04"), source][[1]], "eastmoney")
})

test_that("describe_quantmod_data defaults to local date coverage when from and to are omitted", {
  local_dt <- data.table::data.table(
    source = "quantmod_yahoo",
    symbol = "DX-Y.NYB",
    interval = "1d",
    datetime = as.POSIXct(c("2026-03-01 00:00:00", "2026-03-03 00:00:00"), tz = "UTC"),
    date = as.Date(c("2026-03-01", "2026-03-03")),
    open = c(1, 2),
    high = c(2, 3),
    low = c(0.5, 1.5),
    close = c(1.5, 2.5),
    volume = c(10, 20)
  )

  out <- testthat::with_mocked_bindings(
    get_local_quantmod_OHLC = function(label, src = "yahoo", interval = "1d", local_path = NULL) {
      expect_equal(label, "DX-Y.NYB")
      local_dt
    },
    fetch_quantmod_OHLC = function(ticker, label = ticker, from, to, src = "yahoo", raw_data = FALSE, ...) {
      expect_equal(from, as.Date("2026-03-01"))
      expect_equal(to, as.Date("2026-03-03"))
      local_dt
    },
    investdatar::describe_quantmod_data("DX-Y.NYB"),
    .package = "investdatar"
  )

  expect_match(out, "quantmod_yahoo")
})

Try the investdatar package in your browser

Any scripts or data that you put into this service are public.

investdatar documentation built on Aug. 21, 2026, 5:17 p.m.