diff --git a/R/treediff.R b/R/treediff.R
index 7970bc105bc1086d8e4d97fc8a50906c996113d0..66daad9d0391c530fdd97325d1650efddae762a0 100644
--- a/R/treediff.R
+++ b/R/treediff.R
@@ -128,6 +128,10 @@ treediff <- function(trees1, trees2, replicates, scale = FALSE,
     stop("the number of leaves in one or more clusters is different between ",
     "the two sets of trees.")
   }
+  
+  # Check if 'scale' and 'order_labels' are logical
+  if (!is.logical(scale)) stop("'scale' must be logical")
+  if (!is.logical(order_labels)) stop("'order_labels' must be logical")
 
   # Merge trees from both conditions
   trees <- c(trees1, trees2)
@@ -142,7 +146,7 @@ treediff <- function(trees1, trees2, replicates, scale = FALSE,
   coph_dist <- sapply(trees, cophenetic, simplify = FALSE)
 
   # Normalize
-  if (scale == TRUE) {
+  if (scale) {
     coph_dist <- normalize_trees(coph_dist)
   }
 
@@ -155,8 +159,8 @@ treediff <- function(trees1, trees2, replicates, scale = FALSE,
     }, coph_dist, labels_perm)
 
     # Convert the result to a list of vectors
-    coph_vect <- lapply(1:ncol(coph_vect), function(col) {
-      return(as.vector(coph_vect[,col]))
+    coph_vect <- lapply(1:ncol(coph_vect), function(acol) {
+      return(as.vector(coph_vect[, acol]))
     })
   } else {
     coph_vect <- lapply(coph_dist, function(adist) {
diff --git a/tests/testthat/test-treediff.R b/tests/testthat/test-treediff.R
index c7c1061cad284af92fd6bba08f4e14331636a71a..5eca9ac75688634fdd3c23fe28fbef69015915b4 100644
--- a/tests/testthat/test-treediff.R
+++ b/tests/testthat/test-treediff.R
@@ -137,16 +137,17 @@ test_that("Test for the scale argument", {
   res <- treediff(trees1, trees2, replicates, scale = TRUE)
 
   # Check the output object has the expected names
-  expect_named(res, c("method", "data.name", "p.value",
-                      "statistic", "p.value.indiv"))
+  expect_named(res, c("method", "data.name", "p.value", "statistic", 
+                      "p.value.indiv"))
 
   # Perform the treediff test without scaling
   result1 <- treediff(trees1, trees2, replicates)
   result2 <- treediff(trees1, trees2, replicates, scale = FALSE)
-  result3 <- treediff(trees1, trees2, replicates, scale = 5)
+  expect_error({
+    result3 <- treediff(trees1, trees2, replicates, scale = 5)
+  }, "'scale' must be logical")
 
   expect_equal(result1, result2)
-  expect_equal(result1, result3)
 })
 
 # Test for the order_labels argument
@@ -162,8 +163,11 @@ test_that("Test for the order_labels argument", {
                  hclust(dist(mtcars[, 7:8]), method = "ward.D2"))
 
   # Perform the treediff test with and without ordering the labels
-  res1 <- treediff(trees1, trees2, c(2,2), order_labels = TRUE)
-  res2 <- treediff(trees1, trees2, c(2,2), order_labels = FALSE)
+  res1 <- treediff(trees1, trees2, c(2, 2), order_labels = TRUE)
+  res2 <- treediff(trees1, trees2, c(2, 2), order_labels = FALSE)
+  expect_error({
+    res3 <- treediff(trees1, trees2, c(2, 2), order_labels = 5)
+  }, "'order_labels' must be logical")
 
   # Test that the p-values are the same for both tests
   expect_equal(res1, res2)