diff --git a/R/apply_mutations.R b/R/apply_mutations.R index 8f2bbe9..06d9fca 100644 --- a/R/apply_mutations.R +++ b/R/apply_mutations.R @@ -22,6 +22,9 @@ apply_mutation <- function(ast, mutation) { cat("Applying", mutation$cat, "at position", srcref, "with node id", mutation$node_id, "\n") visitor <- list( exprlist = function(es, v, ...) { + if (compare_identifier(es, mutation)) { + return(list(finished = TRUE, ast = mutation$fun())) + } new_list <- apply_on_list(es, v) return(list(finished = new_list$finished, ast = as.expression(new_list$ast))) }, diff --git a/R/find_mutations.R b/R/find_mutations.R index aa98637..f01e6ec 100644 --- a/R/find_mutations.R +++ b/R/find_mutations.R @@ -1,7 +1,12 @@ find_applicable_mutations <- function(ast) { muts <- list() visitor <- list( - exprlist = function(es, v, r, p) lapply(es, function(e) visit(e, v, roles$ExprList, get_srcref(e, p))), + exprlist = function(es, v, r, p) { + for (m in all_applicable(es, r)) { + muts <<- append(muts, list(m |> append(list(srcref = srcref, node_id = get_id(es))))) + } + lapply(es, function(e) visit(e, v, roles$ExprListElem, get_srcref(e, p))) + }, pairlist = function(ls, v, r, p) NULL, atomic = function(a, v, r, p) { for (m in all_applicable(a, r)) { @@ -37,10 +42,10 @@ find_applicable_mutations <- function(ast) { lapply(seq_along(as), function(i) { a <- as[[i]] role <- switch(fn, - "while" = if (i == 1) roles$Cond else roles$ExprList, - "if" = if (i == 1) roles$Cond else roles$ExprList, + "while" = if (i == 1) roles$Cond else roles$ExprListElem, + "if" = if (i == 1) roles$Cond else roles$ExprListElem, "return" = roles$Ret, - "{" = roles$ExprList, + "{" = roles$ExprListElem, default_role ) visit(a, v, role, srcref) diff --git a/R/mutations.R b/R/mutations.R index de7fcdc..49075d0 100644 --- a/R/mutations.R +++ b/R/mutations.R @@ -246,7 +246,7 @@ function_replacement <- list( } name <- name_as_string(ast[[1]]) - remove_void_call <- role == roles$ExprList && !is_assignment(name) + remove_void_call <- role == roles$ExprListElem && !is_assignment(name) is_length <- name == "length" is_check <- is_check(name) return(remove_void_call || is_length || is_check) @@ -346,16 +346,28 @@ mutate_identical <- list( create_call <- list( is_applicable = function(ast, role) { - return(is.call(ast) && ast[[1]] == "{") + return(is.expression(ast) || is.call(ast) && ast[[1]] == "{") }, get_mutations = function(ast) { - return(list(list(mut_id = "add warning", fun = function() { - as <- c(as.list(ast[-1]), quote(warning("warning created by mutatr"))) - return(as.call(c(ast[[1]], as))) - }), list(mut_id = "add error", fun = function() { - as <- c(as.list(ast[-1]), quote(stop("error created by mutatr"))) - return(as.call(c(ast[[1]], as))) - }))) + if (is.expression(ast)) { + as <- as.list(ast) + return(list(list(mut_id = "add warning", fun = function() { + as <- c(as, quote(warning("warning created by mutatr"))) + return(as.expression(as)) + }), list(mut_id = "add error", fun = function() { + as <- c(as, quote(stop("error created by mutatr"))) + return(as.expression(as)) + }))) + } else if (is.call(ast)) { + as <- as.list(ast[-1]) + return(list(list(mut_id = "add warning", fun = function() { + as <- c(as, quote(warning("warning created by mutatr"))) + return(as.call(c(ast[[1]], as))) + }), list(mut_id = "add error", fun = function() { + as <- c(as, quote(stop("error created by mutatr"))) + return(as.call(c(ast[[1]], as))) + }))) + } } ) diff --git a/R/mutatr.R b/R/mutatr.R index 55f704d..f888312 100644 --- a/R/mutatr.R +++ b/R/mutatr.R @@ -65,7 +65,8 @@ generate_mutants <- function( can_apply <- TRUE tryCatch(mutant <- apply_mutation(asts[[file]], mutation), error = function(e) { - print("Could not apply") + cat("Could not apply\n") + print(e) can_apply <<- FALSE }) if (!can_apply) next diff --git a/R/set_ids.R b/R/set_ids.R index 0e020b4..0ad74ae 100644 --- a/R/set_ids.R +++ b/R/set_ids.R @@ -28,8 +28,7 @@ get_id <- function(elem) { set_ids <- function(ast) { visitor <- list( exprlist = function(es, v) { - es <- set_id(es) - return(lapply(es, visit, v) |> as.expression() |> copy_attribs(es)) + return(lapply(es, visit, v) |> as.expression() |> copy_attribs(es) |> set_id()) }, pairlist = function(l, v) set_id(l), atomic = function(a, v) set_id(a), diff --git a/R/visitor.R b/R/visitor.R index cf0071f..77618e6 100644 --- a/R/visitor.R +++ b/R/visitor.R @@ -3,8 +3,7 @@ roles <- list( FunName = "Function Name", Cond = "Condition", Ret = "Return", - ExprList = "Expression List Element", - PairList = "Pair List Element", + ExprListElem = "Expression List Element", Root = "Root" )