We can (and do) now create mutations for expression lists

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)))
     },

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)

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)))
+      })))
+    }
   }
 )
 

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

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),

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"
 )