test: merged and refactored orphaned test files

R/par.R

@@ -77,19 +77,19 @@ igraph.pars.set.verbose <- function(verbose) {
     .Call(R_igraph_set_verbose, verbose)
   } else if (is.character(verbose)) {
     if (!verbose %in% c("tk", "tkconsole")) {
-      stop("Unknown 'verbose' value")
+      cli::cli_abort("Unknown {.arg verbose} value.")
     }
     if (verbose %in% c("tk", "tkconsole")) {
       if (!capabilities()[["X11"]]) {
-        stop("X11 not available")
+        cli::cli_abort("X11 not available.")
       }
       if (!requireNamespace("tcltk", quietly = TRUE)) {
-        stop("tcltk package not available")
+        cli::cli_abort("tcltk package not available.")
       }
     }
     .Call(R_igraph_set_verbose, TRUE)
   } else {
-    stop("'verbose' should be a logical or character scalar")
+    cli::cli_abort("{.arg verbose} should be a logical or character scalar.")
   }
   verbose
 }
@@ -209,7 +209,7 @@ igraph_i_options <- function(..., .in = parent.frame()) {
     switch(mode(arg),
       list = temp <- arg,
       character = return(.igraph.pars[arg]),
-      stop("invalid argument: ", sQuote(arg))
+      cli::cli_abort("invalid argument: {arg}.")
     )
   }
   if (length(temp) == 0) {
@@ -218,7 +218,7 @@ igraph_i_options <- function(..., .in = parent.frame()) {
 
   ## Callbacks
   n <- names(temp)
-  if (is.null(n)) stop("options must be given by name")
+  if (is.null(n)) cli::cli_abort("options must be given by name.")
   cb <- intersect(names(igraph.pars.callbacks), n)
   for (cn in cb) {
     temp[[cn]] <- igraph.pars.callbacks[[cn]](temp[[cn]])

R/sparsedf.R

@@ -28,24 +28,24 @@ sdf <- function(..., row.names = NULL, NROW = NULL) {
 
   if (is.null(names(cols)) || any(names(cols) == "") ||
     any(duplicated(names(cols)))) {
-    stop("Columns must be have (unique) names")
+    cli::cli_abort("Columns must be have (unique) names.")
   }
 
   lens <- sapply(cols, length)
   n1lens <- lens[lens != 1]
 
   if (length(unique(n1lens)) > 1) {
-    stop("Columns must be constants or have the same length")
+    cli::cli_abort("Columns must be constants or have the same length.")
   }
 
   if (length(n1lens) == 0) {
     if (is.null(NROW)) {
-      stop("Cannot determine number of rows")
+      cli::cli_abort("Cannot determine number of rows.")
     }
     attr(cols, "NROW") <- NROW
   } else {
     if (!is.null(NROW) && n1lens[1] != NROW) {
-      stop("NROW does not match column lengths")
+      cli::cli_abort("{.arg NROW} does not match column lengths.")
     }
     attr(cols, "NROW") <- unname(n1lens[1])
   }
@@ -64,10 +64,10 @@ as.data.frame.igraphSDF <- function(x, row.names, optional, ...) {
 #' @method "[" igraphSDF
 `[.igraphSDF` <- function(x, i, j, ..., drop = TRUE) {
   if (!is.character(j)) {
-    stop("The column index must be character")
+    cli::cli_abort("The column index must be character.")
   }
   if (!missing(i) && !is.numeric(i)) {
-    stop("The row index must be numeric")
+    cli::cli_abort("The row index must be numeric.")
   }
   if (missing(i)) {
     rep(x[[j]], length.out = attr(x, "NROW"))
@@ -83,19 +83,19 @@ as.data.frame.igraphSDF <- function(x, row.names, optional, ...) {
 #' @method "[<-" igraphSDF
 `[<-.igraphSDF` <- function(x, i, j, value) {
   if (!is.character(j)) {
-    stop("The column index must be character")
+    cli::cli_abort("The column index must be character.")
   }
   if (!missing(i) && !is.numeric(i)) {
-    stop("Row index must be numeric, if given")
+    cli::cli_abort("Row index must be numeric, if given.")
   }
   if (missing(i)) {
     if (length(value) != attr(x, "NROW") && length(value) != 1) {
-      stop("Replacement value has the wrong length")
+      cli::cli_abort("Replacement value has the wrong length.")
     }
     x[[j]] <- value
   } else {
     if (length(value) != length(i) && length(value) != 1) {
-      stop("Replacement value has the wrong length")
+      cli::cli_abort("Replacement value has the wrong length.")
     }
     tmp <- rep(x[[j]], length.out = attr(x, "NROW"))
     tmp[i] <- value

tests/testthat/_snaps/print.md

@@ -6,3 +6,122 @@
       + 1/1 edge (vertex names):
       [1] A->B
 
+# vs printing
+
+    Code
+      V(g)[[1]]
+    Output
+      + 1/3 vertex, named:
+        name color weight
+      1    A   red     10
+    Code
+      V(g)[[2]]
+    Output
+      + 1/3 vertex, named:
+        name color weight
+      2    B   red      9
+    Code
+      V(g)[1:2]
+    Output
+      + 2/3 vertices, named:
+      [1] A B
+    Code
+      V(g)[2:3]
+    Output
+      + 2/3 vertices, named:
+      [1] B C
+
+# vs printing, complex attributes
+
+    Code
+      V(g)[[1]]
+    Output
+      + 1/3 vertex, named:
+      $name
+      [1] "A"
+
+      $color
+      [1] "red"
+
+      $weight
+      [1] 10
+
+      $cplx
+      $cplx[[1]]
+      [1] 1 2 3 4
+
+
+    Code
+      V(g)[[2:3]]
+    Output
+      + 2/3 vertices, named:
+      $name
+      [1] "B" "C"
+
+      $color
+      [1] "red" "red"
+
+      $weight
+      [1] 9 3
+
+      $cplx
+      $cplx[[1]]
+      [1] 1 2 3 4
+
+      $cplx[[2]]
+      [1] 1 2 3 4
+
+
+
+# es printing
+
+    Code
+      E(g)[[1]]
+    Output
+      + 1/3 edge (vertex names):
+        tail head tid hid color weight
+      1    A    B   1   2   red     10
+    Code
+      E(g)[[2:3]]
+    Output
+      + 2/3 edges (vertex names):
+        tail head tid hid color weight
+      2    A    C   1   3   red      9
+      3    B    C   2   3   red      3
+
+# es printing, complex attributes
+
+    Code
+      E(g)[[1]]
+    Output
+      + 1/3 edge (vertex names):
+      $color
+      [1] "red"
+
+      $weight
+      [1] 10
+
+      $cmpx
+      $cmpx[[1]]
+      [1] 1 2 3 4
+
+
+    Code
+      E(g)[[2:3]]
+    Output
+      + 2/3 edges (vertex names):
+      $color
+      [1] "red" "red"
+
+      $weight
+      [1] 9 3
+
+      $cmpx
+      $cmpx[[1]]
+      [1] 1 2 3 4
+
+      $cmpx[[2]]
+      [1] 1 2 3 4
+
+
+