Added ability to calculate maximum achievable slicing coverage

Author: LukasPietzschmann

NAMESPACE

@@ -4,5 +4,6 @@ export(close_connection)
 export(configure)
 export(file_coverage)
 export(get_option)
+export(maximum_coverage)
 export(package_coverage)
 export(with_options)

R/config.R

@@ -7,6 +7,7 @@ option_env$slicing_points <- FALSE
 option_env$log_level <- "INFO"
 option_env$unknown_locations <- FALSE
 option_env$return_srcrefs <- FALSE
+option_env$return_annotated_cov <- FALSE
 
 #' Configures various options for this package. If no value is given for any
 #' option, it's default is used.
@@ -27,6 +28,8 @@ option_env$return_srcrefs <- FALSE
 #'  know about
 #'  \item return_srcrefs Whether to return all srcrefs, the ones that were covered and the
 #'  ones that were in the slice.
+#'  \item return_annotated_cov Whether the returned object should be annotated with
+#'  slicing information.
 #' }
 #' @return A list of all options and their values before the configuration.
 #'

R/coverage.R

@@ -39,3 +39,23 @@ package_coverage <- function(path = ".") {
 
   return(give_me_covr_and_i_do_the_rest(covr_measure, sources$files, tests$files))
 }
+
+#' Calculate the maximum possible slicing coverage with the current assertions.
+#' Considering this value can indicate whether the slicing coverage score is limited by
+#' the number of assertions or the amount of covered code.
+#'
+#' @param f Function to calculate slicing coverage
+#' @param ... Arguments to pass to the function
+#'
+#' @export
+maximum_coverage <- function(f, ...) {
+  cov <- with_options(list(return_annotated_cov = TRUE), f(...))
+  max_cov <- recalculate_values(cov, new_value = function(row) {
+    if (is.null(row$in_slice) || row$in_slice) {
+      max(row$value, 1)
+    } else {
+      0
+    }
+  }) |> remove_slc_from_coverage()
+  return(max_cov)
+}

R/utils.R

@@ -88,6 +88,9 @@ build_return_value <- function(covr, covr_time,
                                slicing_coverage, slicing_points, ana_time, slicing_time, query_time,
                                unknown_locations,
                                srcrefs) {
+  if (!get_option("return_annotated_cov")) {
+    slicing_coverage <- remove_slc_from_coverage(slicing_coverage)
+  }
   if (get_option("measure_time") || get_option("return_covr_result") || get_option("slicing_points")) {
     res <- list(coverage = slicing_coverage)
     if (get_option("measure_time")) {
@@ -209,19 +212,13 @@ remove_slc_from_coverage <- function(coverage) {
   return(coverage)
 }
 
-recalculate_values <- function(coverage) {
+recalculate_values <- function(
+    coverage,
+    new_value = function(row) if (is.null(row$in_slice) || row$in_slice) row$value else 0) {
   logger::log_trace("Adjusting coverage values", namespace = "slicingCoverage")
   for (i in seq_along(coverage)) {
     elem <- coverage[[i]]
-    in_slice <- elem$in_slice
-    if (is.null(in_slice)) { # This should not happen (see add_ids_to_coverage)
-      next
-    }
-    if (in_slice) { # No need to change anything as element is in the slice
-      next
-    }
-
-    elem$value <- 0
+    elem$value <- new_value(elem)
     coverage[[i]] <- elem
   }
   return(coverage)
@@ -270,7 +267,7 @@ give_me_covr_and_i_do_the_rest <- function(covr_measure, sources, tests) { # nol
 
   srcrefs <- get_coverered_and_sliced_srcrefs(coverage_with_slc)
 
-  slicing_coverage <- recalculate_values(coverage_with_slc) |> remove_slc_from_coverage()
+  slicing_coverage <- recalculate_values(coverage_with_slc)
 
   return(build_return_value(
     covr, covr_time,