diff --git a/.github/workflows/ci-cd.yml b/.github/workflows/ci-cd.yml new file mode 100644 index 000000000..af9245e53 --- /dev/null +++ b/.github/workflows/ci-cd.yml @@ -0,0 +1,32 @@ +name: R Project CI/CD + +on: + push: + branches: + - main + - setup-github-actions + pull_request: + branches: + - main + +jobs: + build: + runs-on: ubuntu-latest + + steps: + - name: Checkout code + uses: actions/checkout@v3 + + - name: Set up R + uses: r-lib/actions/setup-r@v2 + with: + r-version: devel + + - name: Install dependencies + run: | + install.packages("devtools") + devtools::install_deps(dependencies = TRUE) + + - name: Run tests + run: | + R CMD check --as-cran diff --git a/.github/workflows/performance-tests.yml b/.github/workflows/performance-tests.yml index 10c6f2e3a..69f190fb8 100644 --- a/.github/workflows/performance-tests.yml +++ b/.github/workflows/performance-tests.yml @@ -20,4 +20,13 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} repo_token: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: Anirban166/Autocomment-atime-results@v1.4.1 + - name: Checkout code + uses: actions/checkout@v4 + with: + ref: refactor-helper-function-issue-6702 + - run: | + echo "Current branch:" + git branch + echo "Listing all branches:" + git branch -a + - uses: Anirban166/Autocomment-atime-results@v1.4.1 \ No newline at end of file diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index c46e655a5..89614b61a 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -4,6 +4,9 @@ on: push: branches: [master] pull_request: + branches: + - master + - refactor-helper-function-issue-6702 # Ensure this branch exists name: test-coverage.yaml @@ -21,7 +24,7 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - r-version: '4.3' # TODO(r-lib/covr#567): Go back to using r-devel + r-version: '4.3' # TODO: Go back to using r-devel - uses: r-lib/actions/setup-r-dependencies@v2 with: @@ -51,4 +54,4 @@ jobs: uses: actions/upload-artifact@v4 with: name: coverage-test-failures - path: ${{ runner.temp }}/package + path: ${{ runner.temp }}/package \ No newline at end of file diff --git a/R/data.table.R b/R/data.table.R index 8ef2924fe..0922c9d92 100644 --- a/R/data.table.R +++ b/R/data.table.R @@ -22,6 +22,26 @@ methods::setPackageName("data.table",.global) is.data.table = function(x) inherits(x, "data.table") is.ff = function(x) inherits(x, "ff") # define this in data.table so that we don't have to require(ff), but if user is using ff we'd like it to work +# Helper function to process assignment operations in lists or environments. +# Used internally for efficient recursive assignments in data.table. + +process_assignment <- function(name, x, parent_env) { + k = eval(name[[2L]], parent_env, parent_env) + if (is.list(k)) { + origj = j = if (name[[1L]] == "$") as.character(name[[3L]]) else eval(name[[3L]], parent_env, parent_env) + if (is.character(j)) { + if (length(j) != 1L) + stopf("Cannot assign to an under-allocated recursively indexed list -- L[[i]][,:=] syntax is only valid when i is length 1, but its length is %d", length(j)) + j = match(j, names(k)) + if (is.na(j)) + stopf("Item '%s' not found in names of input list", origj) + } + .Call(Csetlistelt, k, as.integer(j), x) + } else if (is.environment(k) && exists(as.character(name[[3L]]), k)) { + assign(as.character(name[[3L]]), x, k, inherits = FALSE) + } +} + #NCOL = function(x) { # # copied from base, but additionally covers data.table via is.list() # # because NCOL in base explicitly tests using is.data.frame() @@ -1214,22 +1234,9 @@ replace_dot_alias = function(e) { setalloccol(x, n, verbose=verbose) # always assigns to calling scope; i.e. this scope if (is.name(name)) { assign(as.character(name),x,parent.frame(),inherits=TRUE) - } else if (.is_simple_extraction(name)) { # TODO(#6702): use a helper here as the code is very similar to setDT(). - k = eval(name[[2L]], parent.frame(), parent.frame()) - if (is.list(k)) { - origj = j = if (name[[1L]] == "$") as.character(name[[3L]]) else eval(name[[3L]], parent.frame(), parent.frame()) - if (is.character(j)) { - if (length(j)!=1L) stopf("Cannot assign to an under-allocated recursively indexed list -- L[[i]][,:=] syntax is only valid when i is length 1, but its length is %d", length(j)) - j = match(j, names(k)) - if (is.na(j)) internal_error("item '%s' not found in names of list", origj) # nocov - } - .Call(Csetlistelt,k,as.integer(j), x) - } else if (is.environment(k) && exists(as.character(name[[3L]]), k)) { - assign(as.character(name[[3L]]), x, k, inherits=FALSE) - } else if (isS4(k)) { - .Call(CsetS4elt, k, as.character(name[[3L]]), x) - } - } # TO DO: else if env$<- or list$<- + } else if (name %iscall% c('$', '[[') && is.name(name[[2L]])) { + process_assignment(name, x, parent.frame()) + } } } } @@ -2962,25 +2969,13 @@ setDT = function(x, keep.rownames=FALSE, key=NULL, check.names=FALSE) { if (is.name(name)) { name = as.character(name) assign(name, x, parent.frame(), inherits=TRUE) - } else if (.is_simple_extraction(name)) { - # common case is call from 'lapply()' - k = eval(name[[2L]], parent.frame(), parent.frame()) - if (is.list(k)) { - origj = j = if (name[[1L]] == "$") as.character(name[[3L]]) else eval(name[[3L]], parent.frame(), parent.frame()) - if (length(j) == 1L) { - if (is.character(j)) { - j = match(j, names(k)) - if (is.na(j)) - stopf("Item '%s' not found in names of input list", origj) - } - } - .Call(Csetlistelt, k, as.integer(j), x) - } else if (is.environment(k) && exists(as.character(name[[3L]]), k)) { - assign(as.character(name[[3L]]), x, k, inherits=FALSE) - } else if (isS4(k)) { + } else if (name %iscall% c('$', '[[') && is.name(name[[2L]])) { + process_assignment(name, x, parent.frame()) + } + else if (isS4(k)) { .Call(CsetS4elt, k, as.character(name[[3L]]), x) } - } else if (name %iscall% "get") { # #6725 + else if (name %iscall% "get") { # #6725 # edit 'get(nm, env)' call to be 'assign(nm, x, envir=env)' name = match.call(get, name) name[[1L]] = quote(assign) diff --git a/R/fmelt.R b/R/fmelt.R index 38ef06435..9d9c733d3 100644 --- a/R/fmelt.R +++ b/R/fmelt.R @@ -182,6 +182,12 @@ melt.data.table = function(data, id.vars, measure.vars, variable.name = "variabl value.name = "value", ..., na.rm = FALSE, variable.factor = TRUE, value.factor = FALSE, verbose = getOption("datatable.verbose")) { if (!is.data.table(data)) stopf("'data' must be a data.table") + + # Validate id.vars + if (any(is.na(id.vars) | !nzchar(id.vars))) { + stopf("One or more values in 'id.vars' is invalid.") + } + if (missing(id.vars)) id.vars=NULL if (missing(measure.vars)) measure.vars = NULL measure.sub = substitute(measure.vars) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 1d31d232c..64ffdb035 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -3295,7 +3295,7 @@ test(1034, as.data.table(x<-as.character(sample(letters, 5))), data.table(V1=x)) test(1035.291, melt(dt, measure.vars=NA_integer_, id.vars=NULL), error="One or more values in 'measure.vars'") test(1035.30, melt(dt, id.vars=NA_integer_), error="One or more values in 'id.vars'") test(1035.31, melt(dt, measure.vars=NA_character_), error="One or more values in 'measure.vars'") - test(1035.32, melt(dt, id.vars=NA_character_), error="One or more values in 'id.vars'") + test(1035.32, melt(dt, id.vars=NA_character_), error="One or more values in 'id.vars' is invalid.") if (test_R.utils) { # dup names in variable used to generate malformed factor error and/or segfault, #1754; was test 1570