Trim long comments to avoid an error

Fixes #55

NEWS.md

@@ -1,5 +1,9 @@
 # lintr 0.3.0.9000 #
 
+* Now trims long comments (#55, reported by @paulstaab)
+* Automatic commenting of Github commits and pull requests when linting on Travis-CI
+* expect_lint_free expectation can be added to testthat unit tests.
+* Robust configuration system and exclusion logic
 * Emacs and Sublime Text 3 plugins now available from their respective package repositories.
 * add `names.lints`, `split.lints` (#49, @ttriche)
 * Fixed bug that caused vim syntatic plugin not to work properly in windows (#46, @abossenbroek)

R/methods.R

@@ -61,10 +61,12 @@ print.lints <- function(x, ...) {
 
         info <- travis_build_info()
 
-        lint_output <- paste0(collapse = "\n",
-                              capture.output(
-                                invisible(lapply(x, markdown, info, ...)))
-        )
+        lint_output <-
+          trim_output(paste0(collapse = "\n",
+                             capture.output(invisible(lapply(x, markdown, info, ...)))
+                            )
+                     )
+
         github_comment(lint_output, info, ...)
       }
     }
@@ -73,6 +75,35 @@ print.lints <- function(x, ...) {
   invisible(x)
 }
 
+trim_output <- function(x, max = 65535) {
+
+  # if x is less than the max, just return it
+  if (length(x) <= 0 || nchar(x) <= max) {
+    return(x)
+  }
+
+  # otherwise trim x to the max, then search for the lint starts
+  x <- substr(x, 1, max)
+
+  re <- rex::rex("[", except_some_of(":"), ":", numbers, ":", numbers, ":", "]",
+                 "(", except_some_of(")"), ")",
+                 space,
+                 "*", or("style", "warning", "error"), ":", "*",
+                 except_some_of(newline), newline, except_some_of(newline),
+                 newline, except_some_of(newline), newline)
+
+  lint_starts <- rex::re_matches(x, re, global = TRUE, locations = TRUE)[[1]]
+
+  # if at least one lint ends before the cutoff, cutoff there, else just use
+  # the cutoff
+  last_end <- lint_starts[NROW(lint_starts), "end"]
+  if (!is.na(last_end)) {
+    substr(x, 1, last_end)
+  } else {
+    x
+  }
+}
+
 #' @export
 names.lints <- function(x, ...) {
   vapply(x, `[[`, character(1), "filename")