From 4e77ba848b8d9916e175df11086f660bcefe7508 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 14:40:56 +0200 Subject: [PATCH 01/10] also add braces to multi-function declaration if missing for strict = TRUE --- R/rules-other.R | 7 +- R/style-guides.R | 4 +- ...else_while_for_fun_multi_line_in_curly.Rd} | 6 +- .../function-multiline-no-braces-in.R | 26 +++++ .../function-multiline-no-braces-in_tree | 102 ++++++++++++++++++ .../function-multiline-no-braces-out.R | 38 +++++++ tests/testthat/test-indention_operators.R | 6 ++ 7 files changed, 181 insertions(+), 8 deletions(-) rename man/{wrap_if_else_while_for_multi_line_in_curly.Rd => wrap_if_else_while_for_fun_multi_line_in_curly.Rd} (70%) create mode 100644 tests/testthat/indention_operators/function-multiline-no-braces-in.R create mode 100644 tests/testthat/indention_operators/function-multiline-no-braces-in_tree create mode 100644 tests/testthat/indention_operators/function-multiline-no-braces-out.R diff --git a/R/rules-other.R b/R/rules-other.R index cab70c484..d9d259414 100644 --- a/R/rules-other.R +++ b/R/rules-other.R @@ -33,12 +33,13 @@ add_brackets_in_pipe_one <- function(pd, pos) { #' braces. Used for unindention. #' @keywords internal #' @importFrom purrr when -wrap_if_else_while_for_multi_line_in_curly <- function(pd, indent_by = 2) { +wrap_if_else_while_for_fun_multi_line_in_curly <- function(pd, indent_by = 2) { key_token <- when( pd, is_cond_expr(.) ~ "')'", is_while_expr(.) ~ "')'", - is_for_expr(.) ~ "forcond" + is_for_expr(.) ~ "forcond", + is_function_dec(.) ~ "')'" ) if (length(key_token) > 0) { pd <- pd %>% @@ -56,7 +57,7 @@ wrap_if_else_while_for_multi_line_in_curly <- function(pd, indent_by = 2) { #' Wrap a multi-line statement in curly braces #' -#' @inheritParams wrap_if_else_while_for_multi_line_in_curly +#' @inheritParams wrap_if_else_while_for_fun_multi_line_in_curly #' @inheritParams wrap_subexpr_in_curly #' @param key_token The token that comes right before the token that contains #' the expression to be wrapped (ignoring comments). For if and while loops, diff --git a/R/style-guides.R b/R/style-guides.R index 55eade05c..1a4e829b2 100644 --- a/R/style-guides.R +++ b/R/style-guides.R @@ -155,8 +155,8 @@ tidyverse_style <- function(scope = "tokens", resolve_semicolon, add_brackets_in_pipe, remove_terminal_token_before_and_after, - wrap_if_else_while_for_multi_line_in_curly = - if (strict) wrap_if_else_while_for_multi_line_in_curly + wrap_if_else_while_for_fun_multi_line_in_curly = + if (strict) wrap_if_else_while_for_fun_multi_line_in_curly ) } diff --git a/man/wrap_if_else_while_for_multi_line_in_curly.Rd b/man/wrap_if_else_while_for_fun_multi_line_in_curly.Rd similarity index 70% rename from man/wrap_if_else_while_for_multi_line_in_curly.Rd rename to man/wrap_if_else_while_for_fun_multi_line_in_curly.Rd index 8a584a699..3ecc78e93 100644 --- a/man/wrap_if_else_while_for_multi_line_in_curly.Rd +++ b/man/wrap_if_else_while_for_fun_multi_line_in_curly.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/rules-other.R -\name{wrap_if_else_while_for_multi_line_in_curly} -\alias{wrap_if_else_while_for_multi_line_in_curly} +\name{wrap_if_else_while_for_fun_multi_line_in_curly} +\alias{wrap_if_else_while_for_fun_multi_line_in_curly} \title{Wrap if-else, while and for statements in curly braces} \usage{ -wrap_if_else_while_for_multi_line_in_curly(pd, indent_by = 2) +wrap_if_else_while_for_fun_multi_line_in_curly(pd, indent_by = 2) } \arguments{ \item{pd}{A parse table.} diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-in.R b/tests/testthat/indention_operators/function-multiline-no-braces-in.R new file mode 100644 index 000000000..79d9acb95 --- /dev/null +++ b/tests/testthat/indention_operators/function-multiline-no-braces-in.R @@ -0,0 +1,26 @@ +g <- function(k) + NULL + + +g <- function(k) h( + NULL +) + + +g <- function(k) h( # y + NULL # x +) + +g <- function(k) h( # y + NULL +) + + +g <- function(k) h( + NULL # 3jkö +) + +g <- function(k) h( + if (TRUE) + x +) diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-in_tree b/tests/testthat/indention_operators/function-multiline-no-braces-in_tree new file mode 100644 index 000000000..767984697 --- /dev/null +++ b/tests/testthat/indention_operators/function-multiline-no-braces-in_tree @@ -0,0 +1,102 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--expr: [0/0] {1} + ¦ ¦--expr: [0/1] {3} + ¦ ¦ °--SYMBOL: g [0/0] {2} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {4} + ¦ °--expr: [0/0] {5} + ¦ ¦--FUNCTION: funct [0/0] {6} + ¦ ¦--'(': ( [0/0] {7} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {8} + ¦ ¦--')': ) [0/2] {9} + ¦ °--expr: [1/0] {11} + ¦ °--NULL_CONST: NULL [0/0] {10} + ¦--expr: [3/0] {12} + ¦ ¦--expr: [0/1] {14} + ¦ ¦ °--SYMBOL: g [0/0] {13} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {15} + ¦ °--expr: [0/0] {16} + ¦ ¦--FUNCTION: funct [0/0] {17} + ¦ ¦--'(': ( [0/0] {18} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {19} + ¦ ¦--')': ) [0/1] {20} + ¦ °--expr: [0/0] {21} + ¦ ¦--expr: [0/0] {23} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {22} + ¦ ¦--'(': ( [0/2] {24} + ¦ ¦--expr: [1/0] {26} + ¦ ¦ °--NULL_CONST: NULL [0/0] {25} + ¦ °--')': ) [1/0] {27} + ¦--expr: [3/0] {28} + ¦ ¦--expr: [0/1] {30} + ¦ ¦ °--SYMBOL: g [0/0] {29} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {31} + ¦ °--expr: [0/0] {32} + ¦ ¦--FUNCTION: funct [0/0] {33} + ¦ ¦--'(': ( [0/0] {34} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {35} + ¦ ¦--')': ) [0/1] {36} + ¦ °--expr: [0/0] {37} + ¦ ¦--expr: [0/0] {39} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {38} + ¦ ¦--'(': ( [0/1] {40} + ¦ ¦--COMMENT: # y [0/2] {41} + ¦ ¦--expr: [1/1] {43} + ¦ ¦ °--NULL_CONST: NULL [0/0] {42} + ¦ ¦--COMMENT: # x [0/0] {44} + ¦ °--')': ) [1/0] {45} + ¦--expr: [2/0] {46} + ¦ ¦--expr: [0/1] {48} + ¦ ¦ °--SYMBOL: g [0/0] {47} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {49} + ¦ °--expr: [0/0] {50} + ¦ ¦--FUNCTION: funct [0/0] {51} + ¦ ¦--'(': ( [0/0] {52} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {53} + ¦ ¦--')': ) [0/1] {54} + ¦ °--expr: [0/0] {55} + ¦ ¦--expr: [0/0] {57} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {56} + ¦ ¦--'(': ( [0/1] {58} + ¦ ¦--COMMENT: # y [0/2] {59} + ¦ ¦--expr: [1/0] {61} + ¦ ¦ °--NULL_CONST: NULL [0/0] {60} + ¦ °--')': ) [1/0] {62} + ¦--expr: [3/0] {63} + ¦ ¦--expr: [0/1] {65} + ¦ ¦ °--SYMBOL: g [0/0] {64} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {66} + ¦ °--expr: [0/0] {67} + ¦ ¦--FUNCTION: funct [0/0] {68} + ¦ ¦--'(': ( [0/0] {69} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {70} + ¦ ¦--')': ) [0/1] {71} + ¦ °--expr: [0/0] {72} + ¦ ¦--expr: [0/0] {74} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {73} + ¦ ¦--'(': ( [0/2] {75} + ¦ ¦--expr: [1/1] {77} + ¦ ¦ °--NULL_CONST: NULL [0/0] {76} + ¦ ¦--COMMENT: # 3jk [0/0] {78} + ¦ °--')': ) [1/0] {79} + °--expr: [2/0] {80} + ¦--expr: [0/1] {82} + ¦ °--SYMBOL: g [0/0] {81} + ¦--LEFT_ASSIGN: <- [0/1] {83} + °--expr: [0/0] {84} + ¦--FUNCTION: funct [0/0] {85} + ¦--'(': ( [0/0] {86} + ¦--SYMBOL_FORMALS: k [0/0] {87} + ¦--')': ) [0/1] {88} + °--expr: [0/0] {89} + ¦--expr: [0/0] {91} + ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {90} + ¦--'(': ( [0/2] {92} + ¦--expr: [1/0] {93} + ¦ ¦--IF: if [0/1] {94} + ¦ ¦--'(': ( [0/0] {95} + ¦ ¦--expr: [0/0] {97} + ¦ ¦ °--NUM_CONST: TRUE [0/0] {96} + ¦ ¦--')': ) [0/4] {98} + ¦ °--expr: [1/0] {100} + ¦ °--SYMBOL: x [0/0] {99} + °--')': ) [1/0] {101} diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-out.R b/tests/testthat/indention_operators/function-multiline-no-braces-out.R new file mode 100644 index 000000000..d4ed77f59 --- /dev/null +++ b/tests/testthat/indention_operators/function-multiline-no-braces-out.R @@ -0,0 +1,38 @@ +g <- function(k) { + NULL +} + + +g <- function(k) { + h( + NULL + ) +} + + +g <- function(k) { + h( # y + NULL # x + ) +} + +g <- function(k) { + h( # y + NULL + ) +} + + +g <- function(k) { + h( + NULL # 3jkö + ) +} + +g <- function(k) { + h( + if (TRUE) { + x + } + ) +} diff --git a/tests/testthat/test-indention_operators.R b/tests/testthat/test-indention_operators.R index f245eeed2..95a9af93d 100644 --- a/tests/testthat/test-indention_operators.R +++ b/tests/testthat/test-indention_operators.R @@ -24,6 +24,12 @@ test_that("while / for / if without curly brackets", { transformer = style_text, strict = FALSE), NA) }) +test_that("function multiline without curly brackets", { + expect_warning(test_collection("indention_operators", + "function-multiline-no-braces", + transformer = style_text, strict = FALSE), NA) +}) + test_that("while / for / if without curly brackets", { expect_warning(test_collection("indention_operators", "while_for_if_without_curly_strict", From 1de9b6a7b3f7d8dbc1c64814ad6eefd997067348 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 14:45:56 +0200 Subject: [PATCH 02/10] test strict. --- tests/testthat/test-indention_operators.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-indention_operators.R b/tests/testthat/test-indention_operators.R index 95a9af93d..40dbe02fb 100644 --- a/tests/testthat/test-indention_operators.R +++ b/tests/testthat/test-indention_operators.R @@ -27,7 +27,7 @@ test_that("while / for / if without curly brackets", { test_that("function multiline without curly brackets", { expect_warning(test_collection("indention_operators", "function-multiline-no-braces", - transformer = style_text, strict = FALSE), NA) + transformer = style_text, strict = TRUE), NA) }) test_that("while / for / if without curly brackets", { From 85c814a9b674bbf3924c85c27d064b8dab814375 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 14:47:11 +0200 Subject: [PATCH 03/10] rename for strict. --- .../indention_multiple/fun_for_new_line-out.R | 3 +- ... function-multiline-no-braces-strict-in.R} | 0 ...unction-multiline-no-braces-strict-in_tree | 102 ++++++++++++++++++ ...function-multiline-no-braces-strict-out.R} | 0 tests/testthat/test-indention_operators.R | 2 +- 5 files changed, 105 insertions(+), 2 deletions(-) rename tests/testthat/indention_operators/{function-multiline-no-braces-in.R => function-multiline-no-braces-strict-in.R} (100%) create mode 100644 tests/testthat/indention_operators/function-multiline-no-braces-strict-in_tree rename tests/testthat/indention_operators/{function-multiline-no-braces-out.R => function-multiline-no-braces-strict-out.R} (100%) diff --git a/tests/testthat/indention_multiple/fun_for_new_line-out.R b/tests/testthat/indention_multiple/fun_for_new_line-out.R index 43a7c5834..f9c4e703e 100644 --- a/tests/testthat/indention_multiple/fun_for_new_line-out.R +++ b/tests/testthat/indention_multiple/fun_for_new_line-out.R @@ -1,5 +1,6 @@ -function() +function() { NULL +} for (i in 1:3) { diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-in.R b/tests/testthat/indention_operators/function-multiline-no-braces-strict-in.R similarity index 100% rename from tests/testthat/indention_operators/function-multiline-no-braces-in.R rename to tests/testthat/indention_operators/function-multiline-no-braces-strict-in.R diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-strict-in_tree b/tests/testthat/indention_operators/function-multiline-no-braces-strict-in_tree new file mode 100644 index 000000000..767984697 --- /dev/null +++ b/tests/testthat/indention_operators/function-multiline-no-braces-strict-in_tree @@ -0,0 +1,102 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--expr: [0/0] {1} + ¦ ¦--expr: [0/1] {3} + ¦ ¦ °--SYMBOL: g [0/0] {2} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {4} + ¦ °--expr: [0/0] {5} + ¦ ¦--FUNCTION: funct [0/0] {6} + ¦ ¦--'(': ( [0/0] {7} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {8} + ¦ ¦--')': ) [0/2] {9} + ¦ °--expr: [1/0] {11} + ¦ °--NULL_CONST: NULL [0/0] {10} + ¦--expr: [3/0] {12} + ¦ ¦--expr: [0/1] {14} + ¦ ¦ °--SYMBOL: g [0/0] {13} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {15} + ¦ °--expr: [0/0] {16} + ¦ ¦--FUNCTION: funct [0/0] {17} + ¦ ¦--'(': ( [0/0] {18} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {19} + ¦ ¦--')': ) [0/1] {20} + ¦ °--expr: [0/0] {21} + ¦ ¦--expr: [0/0] {23} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {22} + ¦ ¦--'(': ( [0/2] {24} + ¦ ¦--expr: [1/0] {26} + ¦ ¦ °--NULL_CONST: NULL [0/0] {25} + ¦ °--')': ) [1/0] {27} + ¦--expr: [3/0] {28} + ¦ ¦--expr: [0/1] {30} + ¦ ¦ °--SYMBOL: g [0/0] {29} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {31} + ¦ °--expr: [0/0] {32} + ¦ ¦--FUNCTION: funct [0/0] {33} + ¦ ¦--'(': ( [0/0] {34} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {35} + ¦ ¦--')': ) [0/1] {36} + ¦ °--expr: [0/0] {37} + ¦ ¦--expr: [0/0] {39} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {38} + ¦ ¦--'(': ( [0/1] {40} + ¦ ¦--COMMENT: # y [0/2] {41} + ¦ ¦--expr: [1/1] {43} + ¦ ¦ °--NULL_CONST: NULL [0/0] {42} + ¦ ¦--COMMENT: # x [0/0] {44} + ¦ °--')': ) [1/0] {45} + ¦--expr: [2/0] {46} + ¦ ¦--expr: [0/1] {48} + ¦ ¦ °--SYMBOL: g [0/0] {47} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {49} + ¦ °--expr: [0/0] {50} + ¦ ¦--FUNCTION: funct [0/0] {51} + ¦ ¦--'(': ( [0/0] {52} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {53} + ¦ ¦--')': ) [0/1] {54} + ¦ °--expr: [0/0] {55} + ¦ ¦--expr: [0/0] {57} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {56} + ¦ ¦--'(': ( [0/1] {58} + ¦ ¦--COMMENT: # y [0/2] {59} + ¦ ¦--expr: [1/0] {61} + ¦ ¦ °--NULL_CONST: NULL [0/0] {60} + ¦ °--')': ) [1/0] {62} + ¦--expr: [3/0] {63} + ¦ ¦--expr: [0/1] {65} + ¦ ¦ °--SYMBOL: g [0/0] {64} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {66} + ¦ °--expr: [0/0] {67} + ¦ ¦--FUNCTION: funct [0/0] {68} + ¦ ¦--'(': ( [0/0] {69} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {70} + ¦ ¦--')': ) [0/1] {71} + ¦ °--expr: [0/0] {72} + ¦ ¦--expr: [0/0] {74} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {73} + ¦ ¦--'(': ( [0/2] {75} + ¦ ¦--expr: [1/1] {77} + ¦ ¦ °--NULL_CONST: NULL [0/0] {76} + ¦ ¦--COMMENT: # 3jk [0/0] {78} + ¦ °--')': ) [1/0] {79} + °--expr: [2/0] {80} + ¦--expr: [0/1] {82} + ¦ °--SYMBOL: g [0/0] {81} + ¦--LEFT_ASSIGN: <- [0/1] {83} + °--expr: [0/0] {84} + ¦--FUNCTION: funct [0/0] {85} + ¦--'(': ( [0/0] {86} + ¦--SYMBOL_FORMALS: k [0/0] {87} + ¦--')': ) [0/1] {88} + °--expr: [0/0] {89} + ¦--expr: [0/0] {91} + ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {90} + ¦--'(': ( [0/2] {92} + ¦--expr: [1/0] {93} + ¦ ¦--IF: if [0/1] {94} + ¦ ¦--'(': ( [0/0] {95} + ¦ ¦--expr: [0/0] {97} + ¦ ¦ °--NUM_CONST: TRUE [0/0] {96} + ¦ ¦--')': ) [0/4] {98} + ¦ °--expr: [1/0] {100} + ¦ °--SYMBOL: x [0/0] {99} + °--')': ) [1/0] {101} diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-out.R b/tests/testthat/indention_operators/function-multiline-no-braces-strict-out.R similarity index 100% rename from tests/testthat/indention_operators/function-multiline-no-braces-out.R rename to tests/testthat/indention_operators/function-multiline-no-braces-strict-out.R diff --git a/tests/testthat/test-indention_operators.R b/tests/testthat/test-indention_operators.R index 40dbe02fb..30ed78e4c 100644 --- a/tests/testthat/test-indention_operators.R +++ b/tests/testthat/test-indention_operators.R @@ -26,7 +26,7 @@ test_that("while / for / if without curly brackets", { test_that("function multiline without curly brackets", { expect_warning(test_collection("indention_operators", - "function-multiline-no-braces", + "function-multiline-no-braces-strict", transformer = style_text, strict = TRUE), NA) }) From d718c49e2d0a597ce86eac344cd0182cd56eb8ef Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 17:08:27 +0200 Subject: [PATCH 04/10] also resolve case for strict = FALSE MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Performance of any function() {} not affected. Because indent_without_paren_for_while_fun does not know if strict = TRUE, a problem is created for function declarations where the body is not wrapped in {}: (1) indent_without_paren_for_while_fun() does not indent on FUNCTION because { follows. (2) wrap_subexpr_in_curly() creates a curly expression from the body and wants to unindent the body, which was not indented. This creates negative indention. (3) serialization fails due to negative indention. This is avoided by lower-bounding the indention adjustment in wrap_subexpr_in_curly to 0. It seemed more robust than trying to establish at runtime in indent_without_paren_for_while_fun if wrap_subexpr_in_curly() will be called later. --- R/indent.R | 55 +++++++++- R/rules-other.R | 2 +- man/needs_indention_one.Rd | 5 +- ...nction-multiline-no-braces-non-strict-in.R | 26 +++++ ...ion-multiline-no-braces-non-strict-in_tree | 102 ++++++++++++++++++ ...ction-multiline-no-braces-non-strict-out.R | 26 +++++ tests/testthat/test-indention_operators.R | 3 + 7 files changed, 214 insertions(+), 5 deletions(-) create mode 100644 tests/testthat/indention_operators/function-multiline-no-braces-non-strict-in.R create mode 100644 tests/testthat/indention_operators/function-multiline-no-braces-non-strict-in_tree create mode 100644 tests/testthat/indention_operators/function-multiline-no-braces-non-strict-out.R diff --git a/R/indent.R b/R/indent.R index 2f4afbe19..78a27c566 100644 --- a/R/indent.R +++ b/R/indent.R @@ -87,13 +87,42 @@ indent_without_paren <- function(pd, indent_by = 2) { #' definitions without parenthesis. #' @keywords internal indent_without_paren_for_while_fun <- function(pd, indent_by) { + tokens <- c("FOR", "WHILE", "FUNCTION") nrow <- nrow(pd) - if (!(pd$token[1] %in% c("FOR", "WHILE", "FUNCTION"))) { + if (!(pd$token[1] %in% tokens)) { return(pd) } if (is_curly_expr(pd$child[[nrow]])) { return(pd) } + if (pd$token[1] == "FOR") { + is_multi_line <- pd_is_multi_line( + pd$child[[which(pd$token == "forcond")]] + ) + } else if (pd$token[1] %in% c("WHILE", "FUNCTION")) { + start <- which(pd$token == "'('") + end <- which(pd$token == "')'") + is_multi_line <- any(pd[seq2(start, end),]$multi_line) + } + if (pd$token[1] %in% tokens && !is_multi_line) { + other_trigger_tokens <- c( + math_token, + logical_token, + special_token, + "LEFT_ASSIGN", + "EQ_ASSIGN", + "'$'", + "'('", "'['", "'{'" + ) + needs_indention_now <- needs_indention_one(pd, + potential_trigger_pos = 1, + other_trigger_tokens = other_trigger_tokens + ) + + if (!needs_indention_now) { + return(pd) + } + } pd$indent[nrow] <- indent_by pd } @@ -105,7 +134,23 @@ indent_without_paren_if_else <- function(pd, indent_by) { expr_after_if <- next_non_comment(pd, which(pd$token == "')'")[1]) has_if_without_curly <- pd$token[1] %in% "IF" && pd$child[[expr_after_if]]$token[1] != "'{'" - if (has_if_without_curly) { + + other_trigger_tokens <- c( + math_token, + logical_token, + special_token, + "LEFT_ASSIGN", + "EQ_ASSIGN", + "'$'", + "'('", "'['", "'{'" + ) + needs_indention_now <- needs_indention_one(pd, + potential_trigger_pos = 1, + other_trigger_tokens = other_trigger_tokens + ) + + if (has_if_without_curly && needs_indention_now) { + pd$indent[expr_after_if] <- indent_by } @@ -115,6 +160,7 @@ indent_without_paren_if_else <- function(pd, indent_by) { any(pd$token == "ELSE") && pd$child[[expr_after_else_idx]]$token[1] != "'{'" && pd$child[[expr_after_else_idx]]$token[1] != "IF" + if (has_else_without_curly_or_else_chid) { pd$indent[seq(else_idx + 1, nrow(pd))] <- indent_by } @@ -212,7 +258,10 @@ needs_indention <- function(pd, #' @importFrom rlang seq2 #' @keywords internal #' @examples -#' style_text("call(named = c, \nnamed = b)", strict = FALSE) +#' style_text(c( +#' "call(named = c", +#' "named = b)" +#' ), strict = FALSE) needs_indention_one <- function(pd, potential_trigger_pos, other_trigger_tokens) { diff --git a/R/rules-other.R b/R/rules-other.R index d9d259414..642572e01 100644 --- a/R/rules-other.R +++ b/R/rules-other.R @@ -126,7 +126,7 @@ wrap_subexpr_in_curly <- function(pd, stretch_out = c(!to_be_wrapped_starts_with_comment, TRUE), space_after = space_after ) - new_expr$indent <- pd$indent[last(ind_to_be_wrapped)] - indent_by + new_expr$indent <- max(pd$indent[last(ind_to_be_wrapped)] - indent_by, 0) new_expr_in_expr <- new_expr %>% wrap_expr_in_expr() %>% remove_attributes(c("token_before", "token_after")) diff --git a/man/needs_indention_one.Rd b/man/needs_indention_one.Rd index ee6218f94..476c065bd 100644 --- a/man/needs_indention_one.Rd +++ b/man/needs_indention_one.Rd @@ -41,6 +41,9 @@ the trigger is passive. } } \examples{ -style_text("call(named = c, \\nnamed = b)", strict = FALSE) +style_text(c( + "call(named = c", + "named = b)" +), strict = FALSE) } \keyword{internal} diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-in.R b/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-in.R new file mode 100644 index 000000000..79d9acb95 --- /dev/null +++ b/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-in.R @@ -0,0 +1,26 @@ +g <- function(k) + NULL + + +g <- function(k) h( + NULL +) + + +g <- function(k) h( # y + NULL # x +) + +g <- function(k) h( # y + NULL +) + + +g <- function(k) h( + NULL # 3jkö +) + +g <- function(k) h( + if (TRUE) + x +) diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-in_tree b/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-in_tree new file mode 100644 index 000000000..767984697 --- /dev/null +++ b/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-in_tree @@ -0,0 +1,102 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--expr: [0/0] {1} + ¦ ¦--expr: [0/1] {3} + ¦ ¦ °--SYMBOL: g [0/0] {2} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {4} + ¦ °--expr: [0/0] {5} + ¦ ¦--FUNCTION: funct [0/0] {6} + ¦ ¦--'(': ( [0/0] {7} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {8} + ¦ ¦--')': ) [0/2] {9} + ¦ °--expr: [1/0] {11} + ¦ °--NULL_CONST: NULL [0/0] {10} + ¦--expr: [3/0] {12} + ¦ ¦--expr: [0/1] {14} + ¦ ¦ °--SYMBOL: g [0/0] {13} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {15} + ¦ °--expr: [0/0] {16} + ¦ ¦--FUNCTION: funct [0/0] {17} + ¦ ¦--'(': ( [0/0] {18} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {19} + ¦ ¦--')': ) [0/1] {20} + ¦ °--expr: [0/0] {21} + ¦ ¦--expr: [0/0] {23} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {22} + ¦ ¦--'(': ( [0/2] {24} + ¦ ¦--expr: [1/0] {26} + ¦ ¦ °--NULL_CONST: NULL [0/0] {25} + ¦ °--')': ) [1/0] {27} + ¦--expr: [3/0] {28} + ¦ ¦--expr: [0/1] {30} + ¦ ¦ °--SYMBOL: g [0/0] {29} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {31} + ¦ °--expr: [0/0] {32} + ¦ ¦--FUNCTION: funct [0/0] {33} + ¦ ¦--'(': ( [0/0] {34} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {35} + ¦ ¦--')': ) [0/1] {36} + ¦ °--expr: [0/0] {37} + ¦ ¦--expr: [0/0] {39} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {38} + ¦ ¦--'(': ( [0/1] {40} + ¦ ¦--COMMENT: # y [0/2] {41} + ¦ ¦--expr: [1/1] {43} + ¦ ¦ °--NULL_CONST: NULL [0/0] {42} + ¦ ¦--COMMENT: # x [0/0] {44} + ¦ °--')': ) [1/0] {45} + ¦--expr: [2/0] {46} + ¦ ¦--expr: [0/1] {48} + ¦ ¦ °--SYMBOL: g [0/0] {47} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {49} + ¦ °--expr: [0/0] {50} + ¦ ¦--FUNCTION: funct [0/0] {51} + ¦ ¦--'(': ( [0/0] {52} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {53} + ¦ ¦--')': ) [0/1] {54} + ¦ °--expr: [0/0] {55} + ¦ ¦--expr: [0/0] {57} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {56} + ¦ ¦--'(': ( [0/1] {58} + ¦ ¦--COMMENT: # y [0/2] {59} + ¦ ¦--expr: [1/0] {61} + ¦ ¦ °--NULL_CONST: NULL [0/0] {60} + ¦ °--')': ) [1/0] {62} + ¦--expr: [3/0] {63} + ¦ ¦--expr: [0/1] {65} + ¦ ¦ °--SYMBOL: g [0/0] {64} + ¦ ¦--LEFT_ASSIGN: <- [0/1] {66} + ¦ °--expr: [0/0] {67} + ¦ ¦--FUNCTION: funct [0/0] {68} + ¦ ¦--'(': ( [0/0] {69} + ¦ ¦--SYMBOL_FORMALS: k [0/0] {70} + ¦ ¦--')': ) [0/1] {71} + ¦ °--expr: [0/0] {72} + ¦ ¦--expr: [0/0] {74} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {73} + ¦ ¦--'(': ( [0/2] {75} + ¦ ¦--expr: [1/1] {77} + ¦ ¦ °--NULL_CONST: NULL [0/0] {76} + ¦ ¦--COMMENT: # 3jk [0/0] {78} + ¦ °--')': ) [1/0] {79} + °--expr: [2/0] {80} + ¦--expr: [0/1] {82} + ¦ °--SYMBOL: g [0/0] {81} + ¦--LEFT_ASSIGN: <- [0/1] {83} + °--expr: [0/0] {84} + ¦--FUNCTION: funct [0/0] {85} + ¦--'(': ( [0/0] {86} + ¦--SYMBOL_FORMALS: k [0/0] {87} + ¦--')': ) [0/1] {88} + °--expr: [0/0] {89} + ¦--expr: [0/0] {91} + ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {90} + ¦--'(': ( [0/2] {92} + ¦--expr: [1/0] {93} + ¦ ¦--IF: if [0/1] {94} + ¦ ¦--'(': ( [0/0] {95} + ¦ ¦--expr: [0/0] {97} + ¦ ¦ °--NUM_CONST: TRUE [0/0] {96} + ¦ ¦--')': ) [0/4] {98} + ¦ °--expr: [1/0] {100} + ¦ °--SYMBOL: x [0/0] {99} + °--')': ) [1/0] {101} diff --git a/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-out.R b/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-out.R new file mode 100644 index 000000000..79d9acb95 --- /dev/null +++ b/tests/testthat/indention_operators/function-multiline-no-braces-non-strict-out.R @@ -0,0 +1,26 @@ +g <- function(k) + NULL + + +g <- function(k) h( + NULL +) + + +g <- function(k) h( # y + NULL # x +) + +g <- function(k) h( # y + NULL +) + + +g <- function(k) h( + NULL # 3jkö +) + +g <- function(k) h( + if (TRUE) + x +) diff --git a/tests/testthat/test-indention_operators.R b/tests/testthat/test-indention_operators.R index 30ed78e4c..ad9da04af 100644 --- a/tests/testthat/test-indention_operators.R +++ b/tests/testthat/test-indention_operators.R @@ -28,6 +28,9 @@ test_that("function multiline without curly brackets", { expect_warning(test_collection("indention_operators", "function-multiline-no-braces-strict", transformer = style_text, strict = TRUE), NA) + expect_warning(test_collection("indention_operators", + "function-multiline-no-braces-non-strict", + transformer = style_text, strict = FALSE), NA) }) test_that("while / for / if without curly brackets", { From 910772b85f249a09dc509067b49d76b7883b17f7 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 19:23:51 +0200 Subject: [PATCH 05/10] ignore mulit-line for / while condition without braces for strict = FALSE --- R/indent.R | 12 +- ...while_for_if_without_curly_non_strict-in.R | 6 + ...le_for_if_without_curly_non_strict-in_tree | 354 +++++++++--------- ...hile_for_if_without_curly_non_strict-out.R | 18 +- ...or_without_curly_same_line_non_strict-in.R | 31 ++ ...without_curly_same_line_non_strict-in_tree | 157 ++++++++ ...r_without_curly_same_line_non_strict-out.R | 31 ++ tests/testthat/test-indention_operators.R | 3 + 8 files changed, 422 insertions(+), 190 deletions(-) create mode 100644 tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-in.R create mode 100644 tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-in_tree create mode 100644 tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-out.R diff --git a/R/indent.R b/R/indent.R index 78a27c566..727a03422 100644 --- a/R/indent.R +++ b/R/indent.R @@ -95,16 +95,8 @@ indent_without_paren_for_while_fun <- function(pd, indent_by) { if (is_curly_expr(pd$child[[nrow]])) { return(pd) } - if (pd$token[1] == "FOR") { - is_multi_line <- pd_is_multi_line( - pd$child[[which(pd$token == "forcond")]] - ) - } else if (pd$token[1] %in% c("WHILE", "FUNCTION")) { - start <- which(pd$token == "'('") - end <- which(pd$token == "')'") - is_multi_line <- any(pd[seq2(start, end),]$multi_line) - } - if (pd$token[1] %in% tokens && !is_multi_line) { + + if (pd$token[1] %in% tokens) { other_trigger_tokens <- c( math_token, logical_token, diff --git a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in.R b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in.R index 43f1cd48e..4e09c68a9 100644 --- a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in.R +++ b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in.R @@ -10,14 +10,17 @@ if (x) for (i in 1:3) # print(i) +# FIXME for (i in 1:3) # print(i) +# FIXME for (i in # 1:3) # print(i) +# FIXME for (# i in # 1:3# @@ -36,18 +39,21 @@ while ( # test x > 3) # another return(FALSE) +# FIXME while ( 2 > #here 3 # ) # FALSE +# FIXME while ( 2 > #here 3 # ) FALSE +# FIXME while ( 2 > #here 3 diff --git a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in_tree b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in_tree index 3f691a08e..e4b472b78 100644 --- a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in_tree +++ b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in_tree @@ -70,182 +70,188 @@ ROOT (token: short_text [lag_newlines/spaces] {pos_id}) ¦ ¦--expr: [0/0] {70} ¦ ¦ °--SYMBOL: i [0/0] {69} ¦ °--')': ) [0/0] {71} - ¦--expr: [2/0] {72} - ¦ ¦--FOR: for [0/1] {73} - ¦ ¦--forcond: [0/1] {74} - ¦ ¦ ¦--'(': ( [0/0] {75} - ¦ ¦ ¦--SYMBOL: i [0/1] {76} - ¦ ¦ ¦--IN: in [0/5] {77} - ¦ ¦ ¦--expr: [1/0] {78} - ¦ ¦ ¦ ¦--expr: [0/0] {80} - ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {79} - ¦ ¦ ¦ ¦--':': : [0/0] {81} - ¦ ¦ ¦ °--expr: [0/0] {83} - ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {82} - ¦ ¦ °--')': ) [0/0] {84} - ¦ ¦--COMMENT: # [0/2] {85} - ¦ °--expr: [1/0] {86} - ¦ ¦--expr: [0/0] {88} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {87} - ¦ ¦--'(': ( [0/0] {89} - ¦ ¦--expr: [0/0] {91} - ¦ ¦ °--SYMBOL: i [0/0] {90} - ¦ °--')': ) [0/0] {92} - ¦--expr: [2/0] {93} - ¦ ¦--FOR: for [0/1] {94} - ¦ ¦--forcond: [0/1] {95} - ¦ ¦ ¦--'(': ( [0/0] {96} - ¦ ¦ ¦--SYMBOL: i [0/1] {97} - ¦ ¦ ¦--IN: in [0/1] {98} - ¦ ¦ ¦--COMMENT: # [0/5] {99} - ¦ ¦ ¦--expr: [1/0] {100} - ¦ ¦ ¦ ¦--expr: [0/0] {102} - ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {101} - ¦ ¦ ¦ ¦--':': : [0/0] {103} - ¦ ¦ ¦ °--expr: [0/0] {105} - ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {104} - ¦ ¦ °--')': ) [0/0] {106} - ¦ ¦--COMMENT: # [0/2] {107} - ¦ °--expr: [1/0] {108} - ¦ ¦--expr: [0/0] {110} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {109} - ¦ ¦--'(': ( [0/0] {111} - ¦ ¦--expr: [0/0] {113} - ¦ ¦ °--SYMBOL: i [0/0] {112} - ¦ °--')': ) [0/0] {114} - ¦--expr: [2/0] {115} - ¦ ¦--FOR: for [0/1] {116} - ¦ ¦--forcond: [0/1] {117} - ¦ ¦ ¦--'(': ( [0/0] {118} - ¦ ¦ ¦--COMMENT: # [0/2] {119} - ¦ ¦ ¦--SYMBOL: i [1/1] {120} - ¦ ¦ ¦--IN: in [0/1] {121} + ¦--COMMENT: # FIX [2/0] {72} + ¦--expr: [1/0] {73} + ¦ ¦--FOR: for [0/1] {74} + ¦ ¦--forcond: [0/1] {75} + ¦ ¦ ¦--'(': ( [0/0] {76} + ¦ ¦ ¦--SYMBOL: i [0/1] {77} + ¦ ¦ ¦--IN: in [0/5] {78} + ¦ ¦ ¦--expr: [1/0] {79} + ¦ ¦ ¦ ¦--expr: [0/0] {81} + ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {80} + ¦ ¦ ¦ ¦--':': : [0/0] {82} + ¦ ¦ ¦ °--expr: [0/0] {84} + ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {83} + ¦ ¦ °--')': ) [0/0] {85} + ¦ ¦--COMMENT: # [0/2] {86} + ¦ °--expr: [1/0] {87} + ¦ ¦--expr: [0/0] {89} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {88} + ¦ ¦--'(': ( [0/0] {90} + ¦ ¦--expr: [0/0] {92} + ¦ ¦ °--SYMBOL: i [0/0] {91} + ¦ °--')': ) [0/0] {93} + ¦--COMMENT: # FIX [2/0] {94} + ¦--expr: [1/0] {95} + ¦ ¦--FOR: for [0/1] {96} + ¦ ¦--forcond: [0/1] {97} + ¦ ¦ ¦--'(': ( [0/0] {98} + ¦ ¦ ¦--SYMBOL: i [0/1] {99} + ¦ ¦ ¦--IN: in [0/1] {100} + ¦ ¦ ¦--COMMENT: # [0/5] {101} + ¦ ¦ ¦--expr: [1/0] {102} + ¦ ¦ ¦ ¦--expr: [0/0] {104} + ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {103} + ¦ ¦ ¦ ¦--':': : [0/0] {105} + ¦ ¦ ¦ °--expr: [0/0] {107} + ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {106} + ¦ ¦ °--')': ) [0/0] {108} + ¦ ¦--COMMENT: # [0/2] {109} + ¦ °--expr: [1/0] {110} + ¦ ¦--expr: [0/0] {112} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {111} + ¦ ¦--'(': ( [0/0] {113} + ¦ ¦--expr: [0/0] {115} + ¦ ¦ °--SYMBOL: i [0/0] {114} + ¦ °--')': ) [0/0] {116} + ¦--COMMENT: # FIX [2/0] {117} + ¦--expr: [1/0] {118} + ¦ ¦--FOR: for [0/1] {119} + ¦ ¦--forcond: [0/1] {120} + ¦ ¦ ¦--'(': ( [0/0] {121} ¦ ¦ ¦--COMMENT: # [0/2] {122} - ¦ ¦ ¦--expr: [1/0] {123} - ¦ ¦ ¦ ¦--expr: [0/0] {125} - ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {124} - ¦ ¦ ¦ ¦--':': : [0/0] {126} - ¦ ¦ ¦ °--expr: [0/0] {128} - ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {127} - ¦ ¦ ¦--COMMENT: # [0/0] {129} - ¦ ¦ °--')': ) [1/0] {130} - ¦ ¦--COMMENT: # [0/2] {131} - ¦ °--expr: [1/0] {132} - ¦ ¦--expr: [0/0] {134} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {133} - ¦ ¦--'(': ( [0/0] {135} + ¦ ¦ ¦--SYMBOL: i [1/1] {123} + ¦ ¦ ¦--IN: in [0/1] {124} + ¦ ¦ ¦--COMMENT: # [0/2] {125} + ¦ ¦ ¦--expr: [1/0] {126} + ¦ ¦ ¦ ¦--expr: [0/0] {128} + ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {127} + ¦ ¦ ¦ ¦--':': : [0/0] {129} + ¦ ¦ ¦ °--expr: [0/0] {131} + ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {130} + ¦ ¦ ¦--COMMENT: # [0/0] {132} + ¦ ¦ °--')': ) [1/0] {133} + ¦ ¦--COMMENT: # [0/2] {134} + ¦ °--expr: [1/0] {135} ¦ ¦--expr: [0/0] {137} - ¦ ¦ °--SYMBOL: i [0/0] {136} - ¦ °--')': ) [0/0] {138} - ¦--expr: [3/0] {139} - ¦ ¦--WHILE: while [0/1] {140} - ¦ ¦--'(': ( [0/0] {141} - ¦ ¦--expr: [0/0] {142} - ¦ ¦ ¦--expr: [0/1] {144} - ¦ ¦ ¦ °--SYMBOL: x [0/0] {143} - ¦ ¦ ¦--GT: > [0/1] {145} - ¦ ¦ °--expr: [0/0] {147} - ¦ ¦ °--NUM_CONST: 3 [0/0] {146} - ¦ ¦--')': ) [0/1] {148} - ¦ ¦--COMMENT: # [0/2] {149} - ¦ °--expr: [1/0] {150} - ¦ ¦--expr: [0/0] {152} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {151} - ¦ ¦--'(': ( [0/0] {153} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {136} + ¦ ¦--'(': ( [0/0] {138} + ¦ ¦--expr: [0/0] {140} + ¦ ¦ °--SYMBOL: i [0/0] {139} + ¦ °--')': ) [0/0] {141} + ¦--expr: [3/0] {142} + ¦ ¦--WHILE: while [0/1] {143} + ¦ ¦--'(': ( [0/0] {144} + ¦ ¦--expr: [0/0] {145} + ¦ ¦ ¦--expr: [0/1] {147} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {146} + ¦ ¦ ¦--GT: > [0/1] {148} + ¦ ¦ °--expr: [0/0] {150} + ¦ ¦ °--NUM_CONST: 3 [0/0] {149} + ¦ ¦--')': ) [0/1] {151} + ¦ ¦--COMMENT: # [0/2] {152} + ¦ °--expr: [1/0] {153} ¦ ¦--expr: [0/0] {155} - ¦ ¦ °--NUM_CONST: FALSE [0/0] {154} - ¦ °--')': ) [0/0] {156} - ¦--expr: [2/0] {157} - ¦ ¦--WHILE: while [0/1] {158} - ¦ ¦--'(': ( [0/0] {159} - ¦ ¦--expr: [0/1] {160} - ¦ ¦ ¦--expr: [0/1] {162} - ¦ ¦ ¦ °--SYMBOL: x [0/0] {161} - ¦ ¦ ¦--GT: > [0/1] {163} - ¦ ¦ °--expr: [0/0] {165} - ¦ ¦ °--NUM_CONST: 3 [0/0] {164} - ¦ ¦--COMMENT: # [0/0] {166} - ¦ ¦--')': ) [1/2] {167} - ¦ °--expr: [1/0] {168} - ¦ ¦--expr: [0/0] {170} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {169} - ¦ ¦--'(': ( [0/0] {171} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {154} + ¦ ¦--'(': ( [0/0] {156} + ¦ ¦--expr: [0/0] {158} + ¦ ¦ °--NUM_CONST: FALSE [0/0] {157} + ¦ °--')': ) [0/0] {159} + ¦--expr: [2/0] {160} + ¦ ¦--WHILE: while [0/1] {161} + ¦ ¦--'(': ( [0/0] {162} + ¦ ¦--expr: [0/1] {163} + ¦ ¦ ¦--expr: [0/1] {165} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {164} + ¦ ¦ ¦--GT: > [0/1] {166} + ¦ ¦ °--expr: [0/0] {168} + ¦ ¦ °--NUM_CONST: 3 [0/0] {167} + ¦ ¦--COMMENT: # [0/0] {169} + ¦ ¦--')': ) [1/2] {170} + ¦ °--expr: [1/0] {171} ¦ ¦--expr: [0/0] {173} - ¦ ¦ °--NUM_CONST: FALSE [0/0] {172} - ¦ °--')': ) [0/0] {174} - ¦--expr: [2/0] {175} - ¦ ¦--WHILE: while [0/1] {176} - ¦ ¦--'(': ( [0/1] {177} - ¦ ¦--COMMENT: # tes [0/2] {178} - ¦ ¦--expr: [1/0] {179} - ¦ ¦ ¦--expr: [0/1] {181} - ¦ ¦ ¦ °--SYMBOL: x [0/0] {180} - ¦ ¦ ¦--GT: > [0/1] {182} - ¦ ¦ °--expr: [0/0] {184} - ¦ ¦ °--NUM_CONST: 3 [0/0] {183} - ¦ ¦--')': ) [0/1] {185} - ¦ ¦--COMMENT: # ano [0/2] {186} - ¦ °--expr: [1/0] {187} - ¦ ¦--expr: [0/0] {189} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {188} - ¦ ¦--'(': ( [0/0] {190} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {172} + ¦ ¦--'(': ( [0/0] {174} + ¦ ¦--expr: [0/0] {176} + ¦ ¦ °--NUM_CONST: FALSE [0/0] {175} + ¦ °--')': ) [0/0] {177} + ¦--expr: [2/0] {178} + ¦ ¦--WHILE: while [0/1] {179} + ¦ ¦--'(': ( [0/1] {180} + ¦ ¦--COMMENT: # tes [0/2] {181} + ¦ ¦--expr: [1/0] {182} + ¦ ¦ ¦--expr: [0/1] {184} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {183} + ¦ ¦ ¦--GT: > [0/1] {185} + ¦ ¦ °--expr: [0/0] {187} + ¦ ¦ °--NUM_CONST: 3 [0/0] {186} + ¦ ¦--')': ) [0/1] {188} + ¦ ¦--COMMENT: # ano [0/2] {189} + ¦ °--expr: [1/0] {190} ¦ ¦--expr: [0/0] {192} - ¦ ¦ °--NUM_CONST: FALSE [0/0] {191} - ¦ °--')': ) [0/0] {193} - ¦--expr: [2/0] {194} - ¦ ¦--WHILE: while [0/1] {195} - ¦ ¦--'(': ( [0/2] {196} - ¦ ¦--expr: [1/1] {197} - ¦ ¦ ¦--expr: [0/1] {199} - ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {198} - ¦ ¦ ¦--GT: > [0/1] {200} - ¦ ¦ ¦--COMMENT: #here [0/2] {201} - ¦ ¦ °--expr: [1/0] {203} - ¦ ¦ °--NUM_CONST: 3 [0/0] {202} - ¦ ¦--COMMENT: # [0/0] {204} - ¦ ¦--')': ) [1/1] {205} - ¦ ¦--COMMENT: # [0/2] {206} - ¦ °--expr: [1/0] {208} - ¦ °--NUM_CONST: FALSE [0/0] {207} - ¦--expr: [2/0] {209} - ¦ ¦--WHILE: while [0/1] {210} - ¦ ¦--'(': ( [0/2] {211} - ¦ ¦--expr: [1/1] {212} - ¦ ¦ ¦--expr: [0/1] {214} - ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {213} - ¦ ¦ ¦--GT: > [0/1] {215} - ¦ ¦ ¦--COMMENT: #here [0/2] {216} - ¦ ¦ °--expr: [1/0] {218} - ¦ ¦ °--NUM_CONST: 3 [0/0] {217} - ¦ ¦--COMMENT: # [0/0] {219} - ¦ ¦--')': ) [1/2] {220} - ¦ °--expr: [1/0] {222} - ¦ °--NUM_CONST: FALSE [0/0] {221} - ¦--expr: [2/0] {223} - ¦ ¦--WHILE: while [0/1] {224} - ¦ ¦--'(': ( [0/2] {225} - ¦ ¦--expr: [1/0] {226} - ¦ ¦ ¦--expr: [0/1] {228} - ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {227} - ¦ ¦ ¦--GT: > [0/1] {229} - ¦ ¦ ¦--COMMENT: #here [0/2] {230} - ¦ ¦ °--expr: [1/0] {232} - ¦ ¦ °--NUM_CONST: 3 [0/0] {231} - ¦ ¦--')': ) [1/1] {233} - ¦ ¦--COMMENT: # [0/2] {234} - ¦ °--expr: [1/0] {236} - ¦ °--NUM_CONST: FALSE [0/0] {235} - °--expr: [2/0] {237} - ¦--WHILE: while [0/1] {238} - ¦--'(': ( [0/0] {239} - ¦--COMMENT: # [0/2] {240} - ¦--expr: [1/0] {241} - ¦ ¦--expr: [0/1] {243} - ¦ ¦ °--NUM_CONST: 2 [0/0] {242} - ¦ ¦--GT: > [0/2] {244} - ¦ °--expr: [1/0] {246} - ¦ °--NUM_CONST: 3 [0/0] {245} - ¦--')': ) [1/1] {247} - ¦--COMMENT: # [0/2] {248} - °--expr: [1/0] {250} - °--NUM_CONST: FALSE [0/0] {249} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {191} + ¦ ¦--'(': ( [0/0] {193} + ¦ ¦--expr: [0/0] {195} + ¦ ¦ °--NUM_CONST: FALSE [0/0] {194} + ¦ °--')': ) [0/0] {196} + ¦--COMMENT: # FIX [2/0] {197} + ¦--expr: [1/0] {198} + ¦ ¦--WHILE: while [0/1] {199} + ¦ ¦--'(': ( [0/2] {200} + ¦ ¦--expr: [1/1] {201} + ¦ ¦ ¦--expr: [0/1] {203} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {202} + ¦ ¦ ¦--GT: > [0/1] {204} + ¦ ¦ ¦--COMMENT: #here [0/2] {205} + ¦ ¦ °--expr: [1/0] {207} + ¦ ¦ °--NUM_CONST: 3 [0/0] {206} + ¦ ¦--COMMENT: # [0/0] {208} + ¦ ¦--')': ) [1/1] {209} + ¦ ¦--COMMENT: # [0/2] {210} + ¦ °--expr: [1/0] {212} + ¦ °--NUM_CONST: FALSE [0/0] {211} + ¦--COMMENT: # FIX [2/0] {213} + ¦--expr: [1/0] {214} + ¦ ¦--WHILE: while [0/1] {215} + ¦ ¦--'(': ( [0/2] {216} + ¦ ¦--expr: [1/1] {217} + ¦ ¦ ¦--expr: [0/1] {219} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {218} + ¦ ¦ ¦--GT: > [0/1] {220} + ¦ ¦ ¦--COMMENT: #here [0/2] {221} + ¦ ¦ °--expr: [1/0] {223} + ¦ ¦ °--NUM_CONST: 3 [0/0] {222} + ¦ ¦--COMMENT: # [0/0] {224} + ¦ ¦--')': ) [1/2] {225} + ¦ °--expr: [1/0] {227} + ¦ °--NUM_CONST: FALSE [0/0] {226} + ¦--COMMENT: # FIX [2/0] {228} + ¦--expr: [1/0] {229} + ¦ ¦--WHILE: while [0/1] {230} + ¦ ¦--'(': ( [0/2] {231} + ¦ ¦--expr: [1/0] {232} + ¦ ¦ ¦--expr: [0/1] {234} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {233} + ¦ ¦ ¦--GT: > [0/1] {235} + ¦ ¦ ¦--COMMENT: #here [0/2] {236} + ¦ ¦ °--expr: [1/0] {238} + ¦ ¦ °--NUM_CONST: 3 [0/0] {237} + ¦ ¦--')': ) [1/1] {239} + ¦ ¦--COMMENT: # [0/2] {240} + ¦ °--expr: [1/0] {242} + ¦ °--NUM_CONST: FALSE [0/0] {241} + °--expr: [2/0] {243} + ¦--WHILE: while [0/1] {244} + ¦--'(': ( [0/0] {245} + ¦--COMMENT: # [0/2] {246} + ¦--expr: [1/0] {247} + ¦ ¦--expr: [0/1] {249} + ¦ ¦ °--NUM_CONST: 2 [0/0] {248} + ¦ ¦--GT: > [0/2] {250} + ¦ °--expr: [1/0] {252} + ¦ °--NUM_CONST: 3 [0/0] {251} + ¦--')': ) [1/1] {253} + ¦--COMMENT: # [0/2] {254} + °--expr: [1/0] {256} + °--NUM_CONST: FALSE [0/0] {255} diff --git a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-out.R b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-out.R index 00490d0db..d2ef5be83 100644 --- a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-out.R +++ b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-out.R @@ -10,19 +10,22 @@ if (x) for (i in 1:3) # print(i) +# FIXME for (i in 1:3) # - print(i) +print(i) +# FIXME for (i in # 1:3) # - print(i) +print(i) +# FIXME for ( # i in # 1:3 # ) # - print(i) +print(i) while (x > 3) # @@ -36,23 +39,26 @@ while ( # test x > 3) # another return(FALSE) +# FIXME while ( 2 > # here 3 # ) # - FALSE +FALSE +# FIXME while ( 2 > # here 3 # ) - FALSE +FALSE +# FIXME while ( 2 > # here 3 ) # - FALSE +FALSE while ( # 2 > diff --git a/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-in.R b/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-in.R new file mode 100644 index 000000000..b26d46bc8 --- /dev/null +++ b/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-in.R @@ -0,0 +1,31 @@ +while(x == 2) h( + 2 +) + +while(x == 2) h( # comment + 2 +) + +while(x == 2 && + 2 + 2 == 2) h( + 2 +) + + +for(x in 1:22) h( + 2 +) + +for(x in 1:22) h( # comment + 2 +) + +for(k in f( + 2:22 +)) h( + 2 + ) + +for(k in f( + 2:22 # comment +)) h(2) diff --git a/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-in_tree b/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-in_tree new file mode 100644 index 000000000..6311c2398 --- /dev/null +++ b/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-in_tree @@ -0,0 +1,157 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--expr: [0/0] {1} + ¦ ¦--WHILE: while [0/0] {2} + ¦ ¦--'(': ( [0/0] {3} + ¦ ¦--expr: [0/0] {4} + ¦ ¦ ¦--expr: [0/1] {6} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {5} + ¦ ¦ ¦--EQ: == [0/1] {7} + ¦ ¦ °--expr: [0/0] {9} + ¦ ¦ °--NUM_CONST: 2 [0/0] {8} + ¦ ¦--')': ) [0/1] {10} + ¦ °--expr: [0/0] {11} + ¦ ¦--expr: [0/0] {13} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {12} + ¦ ¦--'(': ( [0/2] {14} + ¦ ¦--expr: [1/0] {16} + ¦ ¦ °--NUM_CONST: 2 [0/0] {15} + ¦ °--')': ) [1/0] {17} + ¦--expr: [2/0] {18} + ¦ ¦--WHILE: while [0/0] {19} + ¦ ¦--'(': ( [0/0] {20} + ¦ ¦--expr: [0/0] {21} + ¦ ¦ ¦--expr: [0/1] {23} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {22} + ¦ ¦ ¦--EQ: == [0/1] {24} + ¦ ¦ °--expr: [0/0] {26} + ¦ ¦ °--NUM_CONST: 2 [0/0] {25} + ¦ ¦--')': ) [0/1] {27} + ¦ °--expr: [0/0] {28} + ¦ ¦--expr: [0/0] {30} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {29} + ¦ ¦--'(': ( [0/1] {31} + ¦ ¦--COMMENT: # com [0/2] {32} + ¦ ¦--expr: [1/0] {34} + ¦ ¦ °--NUM_CONST: 2 [0/0] {33} + ¦ °--')': ) [1/0] {35} + ¦--expr: [2/0] {36} + ¦ ¦--WHILE: while [0/0] {37} + ¦ ¦--'(': ( [0/0] {38} + ¦ ¦--expr: [0/0] {39} + ¦ ¦ ¦--expr: [0/1] {40} + ¦ ¦ ¦ ¦--expr: [0/1] {42} + ¦ ¦ ¦ ¦ °--SYMBOL: x [0/0] {41} + ¦ ¦ ¦ ¦--EQ: == [0/1] {43} + ¦ ¦ ¦ °--expr: [0/0] {45} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {44} + ¦ ¦ ¦--AND2: && [0/6] {46} + ¦ ¦ °--expr: [1/0] {47} + ¦ ¦ ¦--expr: [0/1] {48} + ¦ ¦ ¦ ¦--expr: [0/1] {50} + ¦ ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {49} + ¦ ¦ ¦ ¦--'+': + [0/1] {51} + ¦ ¦ ¦ °--expr: [0/0] {53} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {52} + ¦ ¦ ¦--EQ: == [0/1] {54} + ¦ ¦ °--expr: [0/0] {56} + ¦ ¦ °--NUM_CONST: 2 [0/0] {55} + ¦ ¦--')': ) [0/1] {57} + ¦ °--expr: [0/0] {58} + ¦ ¦--expr: [0/0] {60} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {59} + ¦ ¦--'(': ( [0/2] {61} + ¦ ¦--expr: [1/0] {63} + ¦ ¦ °--NUM_CONST: 2 [0/0] {62} + ¦ °--')': ) [1/0] {64} + ¦--expr: [3/0] {65} + ¦ ¦--FOR: for [0/0] {66} + ¦ ¦--forcond: [0/1] {67} + ¦ ¦ ¦--'(': ( [0/0] {68} + ¦ ¦ ¦--SYMBOL: x [0/1] {69} + ¦ ¦ ¦--IN: in [0/1] {70} + ¦ ¦ ¦--expr: [0/0] {71} + ¦ ¦ ¦ ¦--expr: [0/0] {73} + ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {72} + ¦ ¦ ¦ ¦--':': : [0/0] {74} + ¦ ¦ ¦ °--expr: [0/0] {76} + ¦ ¦ ¦ °--NUM_CONST: 22 [0/0] {75} + ¦ ¦ °--')': ) [0/0] {77} + ¦ °--expr: [0/0] {78} + ¦ ¦--expr: [0/0] {80} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {79} + ¦ ¦--'(': ( [0/2] {81} + ¦ ¦--expr: [1/0] {83} + ¦ ¦ °--NUM_CONST: 2 [0/0] {82} + ¦ °--')': ) [1/0] {84} + ¦--expr: [2/0] {85} + ¦ ¦--FOR: for [0/0] {86} + ¦ ¦--forcond: [0/1] {87} + ¦ ¦ ¦--'(': ( [0/0] {88} + ¦ ¦ ¦--SYMBOL: x [0/1] {89} + ¦ ¦ ¦--IN: in [0/1] {90} + ¦ ¦ ¦--expr: [0/0] {91} + ¦ ¦ ¦ ¦--expr: [0/0] {93} + ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {92} + ¦ ¦ ¦ ¦--':': : [0/0] {94} + ¦ ¦ ¦ °--expr: [0/0] {96} + ¦ ¦ ¦ °--NUM_CONST: 22 [0/0] {95} + ¦ ¦ °--')': ) [0/0] {97} + ¦ °--expr: [0/0] {98} + ¦ ¦--expr: [0/0] {100} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {99} + ¦ ¦--'(': ( [0/1] {101} + ¦ ¦--COMMENT: # com [0/2] {102} + ¦ ¦--expr: [1/0] {104} + ¦ ¦ °--NUM_CONST: 2 [0/0] {103} + ¦ °--')': ) [1/0] {105} + ¦--expr: [2/0] {106} + ¦ ¦--FOR: for [0/0] {107} + ¦ ¦--forcond: [0/1] {108} + ¦ ¦ ¦--'(': ( [0/0] {109} + ¦ ¦ ¦--SYMBOL: k [0/1] {110} + ¦ ¦ ¦--IN: in [0/1] {111} + ¦ ¦ ¦--expr: [0/0] {112} + ¦ ¦ ¦ ¦--expr: [0/0] {114} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: f [0/0] {113} + ¦ ¦ ¦ ¦--'(': ( [0/2] {115} + ¦ ¦ ¦ ¦--expr: [1/0] {116} + ¦ ¦ ¦ ¦ ¦--expr: [0/0] {118} + ¦ ¦ ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {117} + ¦ ¦ ¦ ¦ ¦--':': : [0/0] {119} + ¦ ¦ ¦ ¦ °--expr: [0/0] {121} + ¦ ¦ ¦ ¦ °--NUM_CONST: 22 [0/0] {120} + ¦ ¦ ¦ °--')': ) [1/0] {122} + ¦ ¦ °--')': ) [0/0] {123} + ¦ °--expr: [0/0] {124} + ¦ ¦--expr: [0/0] {126} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {125} + ¦ ¦--'(': ( [0/8] {127} + ¦ ¦--expr: [1/6] {129} + ¦ ¦ °--NUM_CONST: 2 [0/0] {128} + ¦ °--')': ) [1/0] {130} + °--expr: [2/0] {131} + ¦--FOR: for [0/0] {132} + ¦--forcond: [0/1] {133} + ¦ ¦--'(': ( [0/0] {134} + ¦ ¦--SYMBOL: k [0/1] {135} + ¦ ¦--IN: in [0/1] {136} + ¦ ¦--expr: [0/0] {137} + ¦ ¦ ¦--expr: [0/0] {139} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: f [0/0] {138} + ¦ ¦ ¦--'(': ( [0/2] {140} + ¦ ¦ ¦--expr: [1/1] {141} + ¦ ¦ ¦ ¦--expr: [0/0] {143} + ¦ ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {142} + ¦ ¦ ¦ ¦--':': : [0/0] {144} + ¦ ¦ ¦ °--expr: [0/0] {146} + ¦ ¦ ¦ °--NUM_CONST: 22 [0/0] {145} + ¦ ¦ ¦--COMMENT: # com [0/0] {147} + ¦ ¦ °--')': ) [1/0] {148} + ¦ °--')': ) [0/0] {149} + °--expr: [0/0] {150} + ¦--expr: [0/0] {152} + ¦ °--SYMBOL_FUNCTION_CALL: h [0/0] {151} + ¦--'(': ( [0/0] {153} + ¦--expr: [0/0] {155} + ¦ °--NUM_CONST: 2 [0/0] {154} + °--')': ) [0/0] {156} diff --git a/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-out.R b/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-out.R new file mode 100644 index 000000000..7342282c8 --- /dev/null +++ b/tests/testthat/indention_operators/while_for_without_curly_same_line_non_strict-out.R @@ -0,0 +1,31 @@ +while (x == 2) h( + 2 +) + +while (x == 2) h( # comment + 2 +) + +while (x == 2 && + 2 + 2 == 2) h( + 2 +) + + +for (x in 1:22) h( + 2 +) + +for (x in 1:22) h( # comment + 2 +) + +for (k in f( + 2:22 +)) h( + 2 +) + +for (k in f( + 2:22 # comment +)) h(2) diff --git a/tests/testthat/test-indention_operators.R b/tests/testthat/test-indention_operators.R index ad9da04af..b3013a87e 100644 --- a/tests/testthat/test-indention_operators.R +++ b/tests/testthat/test-indention_operators.R @@ -22,6 +22,9 @@ test_that("while / for / if without curly brackets", { expect_warning(test_collection("indention_operators", "while_for_if_without_curly_non_strict", transformer = style_text, strict = FALSE), NA) + expect_warning(test_collection("indention_operators", + "while_for_without_curly_same_line_non_strict", + transformer = style_text, strict = FALSE), NA) }) test_that("function multiline without curly brackets", { From 0d735664e84841862d14bc0059eb53e68bc1067e Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 20:01:49 +0200 Subject: [PATCH 06/10] fix example --- R/indent.R | 2 +- man/needs_indention_one.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/indent.R b/R/indent.R index 727a03422..fe764f033 100644 --- a/R/indent.R +++ b/R/indent.R @@ -251,7 +251,7 @@ needs_indention <- function(pd, #' @keywords internal #' @examples #' style_text(c( -#' "call(named = c", +#' "call(named = c,", #' "named = b)" #' ), strict = FALSE) needs_indention_one <- function(pd, diff --git a/man/needs_indention_one.Rd b/man/needs_indention_one.Rd index 476c065bd..813e5d6f6 100644 --- a/man/needs_indention_one.Rd +++ b/man/needs_indention_one.Rd @@ -42,7 +42,7 @@ the trigger is passive. } \examples{ style_text(c( - "call(named = c", + "call(named = c,", "named = b)" ), strict = FALSE) } From f51859886e2a9d01b8bad08f5f857b468b432f30 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 20:33:55 +0200 Subject: [PATCH 07/10] also fix else case --- R/indent.R | 10 ++- .../if-else-no-braces-not-strict-in.R | 17 +++++ .../if-else-no-braces-not-strict-in_tree | 66 +++++++++++++++++++ .../if-else-no-braces-not-strict-out.R | 17 +++++ tests/testthat/test-indention_operators.R | 5 ++ 5 files changed, 113 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/indention_operators/if-else-no-braces-not-strict-in.R create mode 100644 tests/testthat/indention_operators/if-else-no-braces-not-strict-in_tree create mode 100644 tests/testthat/indention_operators/if-else-no-braces-not-strict-out.R diff --git a/R/indent.R b/R/indent.R index fe764f033..9d8f0b13b 100644 --- a/R/indent.R +++ b/R/indent.R @@ -147,13 +147,19 @@ indent_without_paren_if_else <- function(pd, indent_by) { } else_idx <- which(pd$token == "ELSE") + if (length(else_idx) == 0) { + return(pd) + } expr_after_else_idx <- next_non_comment(pd, else_idx) has_else_without_curly_or_else_chid <- any(pd$token == "ELSE") && pd$child[[expr_after_else_idx]]$token[1] != "'{'" && pd$child[[expr_after_else_idx]]$token[1] != "IF" - - if (has_else_without_curly_or_else_chid) { + needs_indention_now <- needs_indention_one(pd, + potential_trigger_pos = else_idx, + other_trigger_tokens = other_trigger_tokens + ) + if (has_else_without_curly_or_else_chid && needs_indention_now) { pd$indent[seq(else_idx + 1, nrow(pd))] <- indent_by } pd diff --git a/tests/testthat/indention_operators/if-else-no-braces-not-strict-in.R b/tests/testthat/indention_operators/if-else-no-braces-not-strict-in.R new file mode 100644 index 000000000..acddf4348 --- /dev/null +++ b/tests/testthat/indention_operators/if-else-no-braces-not-strict-in.R @@ -0,0 +1,17 @@ +if (TRUE) c( + 2 +) else c( + 1 +) + +if (TRUE) c( + 2 +) else c( # nothing + 1 +) + +if (TRUE) c( + 2 # also nothing +) else c( + 1 +) diff --git a/tests/testthat/indention_operators/if-else-no-braces-not-strict-in_tree b/tests/testthat/indention_operators/if-else-no-braces-not-strict-in_tree new file mode 100644 index 000000000..150fe53a5 --- /dev/null +++ b/tests/testthat/indention_operators/if-else-no-braces-not-strict-in_tree @@ -0,0 +1,66 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--expr: [0/0] {1} + ¦ ¦--IF: if [0/1] {2} + ¦ ¦--'(': ( [0/0] {3} + ¦ ¦--expr: [0/0] {5} + ¦ ¦ °--NUM_CONST: TRUE [0/0] {4} + ¦ ¦--')': ) [0/1] {6} + ¦ ¦--expr: [0/1] {7} + ¦ ¦ ¦--expr: [0/0] {9} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: c [0/0] {8} + ¦ ¦ ¦--'(': ( [0/2] {10} + ¦ ¦ ¦--expr: [1/0] {12} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {11} + ¦ ¦ °--')': ) [1/0] {13} + ¦ ¦--ELSE: else [0/1] {14} + ¦ °--expr: [0/0] {15} + ¦ ¦--expr: [0/0] {17} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: c [0/0] {16} + ¦ ¦--'(': ( [0/2] {18} + ¦ ¦--expr: [1/0] {20} + ¦ ¦ °--NUM_CONST: 1 [0/0] {19} + ¦ °--')': ) [1/0] {21} + ¦--expr: [2/0] {22} + ¦ ¦--IF: if [0/1] {23} + ¦ ¦--'(': ( [0/0] {24} + ¦ ¦--expr: [0/0] {26} + ¦ ¦ °--NUM_CONST: TRUE [0/0] {25} + ¦ ¦--')': ) [0/1] {27} + ¦ ¦--expr: [0/1] {28} + ¦ ¦ ¦--expr: [0/0] {30} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: c [0/0] {29} + ¦ ¦ ¦--'(': ( [0/2] {31} + ¦ ¦ ¦--expr: [1/0] {33} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {32} + ¦ ¦ °--')': ) [1/0] {34} + ¦ ¦--ELSE: else [0/1] {35} + ¦ °--expr: [0/0] {36} + ¦ ¦--expr: [0/0] {38} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: c [0/0] {37} + ¦ ¦--'(': ( [0/1] {39} + ¦ ¦--COMMENT: # not [0/2] {40} + ¦ ¦--expr: [1/0] {42} + ¦ ¦ °--NUM_CONST: 1 [0/0] {41} + ¦ °--')': ) [1/0] {43} + °--expr: [2/0] {44} + ¦--IF: if [0/1] {45} + ¦--'(': ( [0/0] {46} + ¦--expr: [0/0] {48} + ¦ °--NUM_CONST: TRUE [0/0] {47} + ¦--')': ) [0/1] {49} + ¦--expr: [0/1] {50} + ¦ ¦--expr: [0/0] {52} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: c [0/0] {51} + ¦ ¦--'(': ( [0/2] {53} + ¦ ¦--expr: [1/1] {55} + ¦ ¦ °--NUM_CONST: 2 [0/0] {54} + ¦ ¦--COMMENT: # als [0/0] {56} + ¦ °--')': ) [1/0] {57} + ¦--ELSE: else [0/1] {58} + °--expr: [0/0] {59} + ¦--expr: [0/0] {61} + ¦ °--SYMBOL_FUNCTION_CALL: c [0/0] {60} + ¦--'(': ( [0/2] {62} + ¦--expr: [1/0] {64} + ¦ °--NUM_CONST: 1 [0/0] {63} + °--')': ) [1/0] {65} diff --git a/tests/testthat/indention_operators/if-else-no-braces-not-strict-out.R b/tests/testthat/indention_operators/if-else-no-braces-not-strict-out.R new file mode 100644 index 000000000..acddf4348 --- /dev/null +++ b/tests/testthat/indention_operators/if-else-no-braces-not-strict-out.R @@ -0,0 +1,17 @@ +if (TRUE) c( + 2 +) else c( + 1 +) + +if (TRUE) c( + 2 +) else c( # nothing + 1 +) + +if (TRUE) c( + 2 # also nothing +) else c( + 1 +) diff --git a/tests/testthat/test-indention_operators.R b/tests/testthat/test-indention_operators.R index b3013a87e..d684b615c 100644 --- a/tests/testthat/test-indention_operators.R +++ b/tests/testthat/test-indention_operators.R @@ -25,6 +25,11 @@ test_that("while / for / if without curly brackets", { expect_warning(test_collection("indention_operators", "while_for_without_curly_same_line_non_strict", transformer = style_text, strict = FALSE), NA) + + expect_warning(test_collection("indention_operators", + "if-else-no-braces-not-strict", + transformer = style_text, strict = FALSE), NA) + }) test_that("function multiline without curly brackets", { From 51d0da29538808a3f10340550f533f0f0bb112f6 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 20:46:28 +0200 Subject: [PATCH 08/10] better early termination for ifelse --- R/indent.R | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/R/indent.R b/R/indent.R index 9d8f0b13b..c34c11fa5 100644 --- a/R/indent.R +++ b/R/indent.R @@ -124,9 +124,12 @@ indent_without_paren_for_while_fun <- function(pd, indent_by) { #' @keywords internal indent_without_paren_if_else <- function(pd, indent_by) { expr_after_if <- next_non_comment(pd, which(pd$token == "')'")[1]) + is_if <- pd$token[1] %in% "IF" has_if_without_curly <- - pd$token[1] %in% "IF" && pd$child[[expr_after_if]]$token[1] != "'{'" - + is_if && pd$child[[expr_after_if]]$token[1] != "'{'" + if (!is_if) { + return(pd) + } other_trigger_tokens <- c( math_token, logical_token, @@ -137,15 +140,16 @@ indent_without_paren_if_else <- function(pd, indent_by) { "'('", "'['", "'{'" ) needs_indention_now <- needs_indention_one(pd, - potential_trigger_pos = 1, - other_trigger_tokens = other_trigger_tokens + potential_trigger_pos = 1, + other_trigger_tokens = other_trigger_tokens ) - if (has_if_without_curly && needs_indention_now) { - + if (needs_indention_now) { pd$indent[expr_after_if] <- indent_by } + + else_idx <- which(pd$token == "ELSE") if (length(else_idx) == 0) { return(pd) From 7c26637116763978ec71a08f632bd734c7ab0591 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 22:23:00 +0200 Subject: [PATCH 09/10] simplify and solve edgecages. Two birds with one stone :-) --- R/indent.R | 42 +-- ...while_for_if_without_curly_non_strict-in.R | 6 - ...le_for_if_without_curly_non_strict-in_tree | 354 +++++++++--------- ...hile_for_if_without_curly_non_strict-out.R | 18 +- 4 files changed, 187 insertions(+), 233 deletions(-) diff --git a/R/indent.R b/R/indent.R index c34c11fa5..bf4556b37 100644 --- a/R/indent.R +++ b/R/indent.R @@ -87,6 +87,7 @@ indent_without_paren <- function(pd, indent_by = 2) { #' definitions without parenthesis. #' @keywords internal indent_without_paren_for_while_fun <- function(pd, indent_by) { + tokens <- c("FOR", "WHILE", "FUNCTION") nrow <- nrow(pd) if (!(pd$token[1] %in% tokens)) { @@ -96,24 +97,8 @@ indent_without_paren_for_while_fun <- function(pd, indent_by) { return(pd) } - if (pd$token[1] %in% tokens) { - other_trigger_tokens <- c( - math_token, - logical_token, - special_token, - "LEFT_ASSIGN", - "EQ_ASSIGN", - "'$'", - "'('", "'['", "'{'" - ) - needs_indention_now <- needs_indention_one(pd, - potential_trigger_pos = 1, - other_trigger_tokens = other_trigger_tokens - ) - - if (!needs_indention_now) { - return(pd) - } + if (pd$newlines[length(pd$newlines) - 1] == 0 ) { + return(pd) } pd$indent[nrow] <- indent_by pd @@ -130,19 +115,7 @@ indent_without_paren_if_else <- function(pd, indent_by) { if (!is_if) { return(pd) } - other_trigger_tokens <- c( - math_token, - logical_token, - special_token, - "LEFT_ASSIGN", - "EQ_ASSIGN", - "'$'", - "'('", "'['", "'{'" - ) - needs_indention_now <- needs_indention_one(pd, - potential_trigger_pos = 1, - other_trigger_tokens = other_trigger_tokens - ) + needs_indention_now <- pd$lag_newlines[next_non_comment(pd, which(pd$token == "')'"))] > 0 if (needs_indention_now) { pd$indent[expr_after_if] <- indent_by @@ -159,10 +132,9 @@ indent_without_paren_if_else <- function(pd, indent_by) { any(pd$token == "ELSE") && pd$child[[expr_after_else_idx]]$token[1] != "'{'" && pd$child[[expr_after_else_idx]]$token[1] != "IF" - needs_indention_now <- needs_indention_one(pd, - potential_trigger_pos = else_idx, - other_trigger_tokens = other_trigger_tokens - ) + + needs_indention_now <- pd$lag_newlines[next_non_comment(pd, which(pd$token == "ELSE"))] > 0 + if (has_else_without_curly_or_else_chid && needs_indention_now) { pd$indent[seq(else_idx + 1, nrow(pd))] <- indent_by } diff --git a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in.R b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in.R index 4e09c68a9..43f1cd48e 100644 --- a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in.R +++ b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in.R @@ -10,17 +10,14 @@ if (x) for (i in 1:3) # print(i) -# FIXME for (i in 1:3) # print(i) -# FIXME for (i in # 1:3) # print(i) -# FIXME for (# i in # 1:3# @@ -39,21 +36,18 @@ while ( # test x > 3) # another return(FALSE) -# FIXME while ( 2 > #here 3 # ) # FALSE -# FIXME while ( 2 > #here 3 # ) FALSE -# FIXME while ( 2 > #here 3 diff --git a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in_tree b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in_tree index e4b472b78..3f691a08e 100644 --- a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in_tree +++ b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-in_tree @@ -70,188 +70,182 @@ ROOT (token: short_text [lag_newlines/spaces] {pos_id}) ¦ ¦--expr: [0/0] {70} ¦ ¦ °--SYMBOL: i [0/0] {69} ¦ °--')': ) [0/0] {71} - ¦--COMMENT: # FIX [2/0] {72} - ¦--expr: [1/0] {73} - ¦ ¦--FOR: for [0/1] {74} - ¦ ¦--forcond: [0/1] {75} - ¦ ¦ ¦--'(': ( [0/0] {76} - ¦ ¦ ¦--SYMBOL: i [0/1] {77} - ¦ ¦ ¦--IN: in [0/5] {78} - ¦ ¦ ¦--expr: [1/0] {79} - ¦ ¦ ¦ ¦--expr: [0/0] {81} - ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {80} - ¦ ¦ ¦ ¦--':': : [0/0] {82} - ¦ ¦ ¦ °--expr: [0/0] {84} - ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {83} - ¦ ¦ °--')': ) [0/0] {85} - ¦ ¦--COMMENT: # [0/2] {86} - ¦ °--expr: [1/0] {87} - ¦ ¦--expr: [0/0] {89} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {88} - ¦ ¦--'(': ( [0/0] {90} - ¦ ¦--expr: [0/0] {92} - ¦ ¦ °--SYMBOL: i [0/0] {91} - ¦ °--')': ) [0/0] {93} - ¦--COMMENT: # FIX [2/0] {94} - ¦--expr: [1/0] {95} - ¦ ¦--FOR: for [0/1] {96} - ¦ ¦--forcond: [0/1] {97} - ¦ ¦ ¦--'(': ( [0/0] {98} - ¦ ¦ ¦--SYMBOL: i [0/1] {99} - ¦ ¦ ¦--IN: in [0/1] {100} - ¦ ¦ ¦--COMMENT: # [0/5] {101} - ¦ ¦ ¦--expr: [1/0] {102} - ¦ ¦ ¦ ¦--expr: [0/0] {104} - ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {103} - ¦ ¦ ¦ ¦--':': : [0/0] {105} - ¦ ¦ ¦ °--expr: [0/0] {107} - ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {106} - ¦ ¦ °--')': ) [0/0] {108} - ¦ ¦--COMMENT: # [0/2] {109} - ¦ °--expr: [1/0] {110} - ¦ ¦--expr: [0/0] {112} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {111} - ¦ ¦--'(': ( [0/0] {113} - ¦ ¦--expr: [0/0] {115} - ¦ ¦ °--SYMBOL: i [0/0] {114} - ¦ °--')': ) [0/0] {116} - ¦--COMMENT: # FIX [2/0] {117} - ¦--expr: [1/0] {118} - ¦ ¦--FOR: for [0/1] {119} - ¦ ¦--forcond: [0/1] {120} - ¦ ¦ ¦--'(': ( [0/0] {121} + ¦--expr: [2/0] {72} + ¦ ¦--FOR: for [0/1] {73} + ¦ ¦--forcond: [0/1] {74} + ¦ ¦ ¦--'(': ( [0/0] {75} + ¦ ¦ ¦--SYMBOL: i [0/1] {76} + ¦ ¦ ¦--IN: in [0/5] {77} + ¦ ¦ ¦--expr: [1/0] {78} + ¦ ¦ ¦ ¦--expr: [0/0] {80} + ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {79} + ¦ ¦ ¦ ¦--':': : [0/0] {81} + ¦ ¦ ¦ °--expr: [0/0] {83} + ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {82} + ¦ ¦ °--')': ) [0/0] {84} + ¦ ¦--COMMENT: # [0/2] {85} + ¦ °--expr: [1/0] {86} + ¦ ¦--expr: [0/0] {88} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {87} + ¦ ¦--'(': ( [0/0] {89} + ¦ ¦--expr: [0/0] {91} + ¦ ¦ °--SYMBOL: i [0/0] {90} + ¦ °--')': ) [0/0] {92} + ¦--expr: [2/0] {93} + ¦ ¦--FOR: for [0/1] {94} + ¦ ¦--forcond: [0/1] {95} + ¦ ¦ ¦--'(': ( [0/0] {96} + ¦ ¦ ¦--SYMBOL: i [0/1] {97} + ¦ ¦ ¦--IN: in [0/1] {98} + ¦ ¦ ¦--COMMENT: # [0/5] {99} + ¦ ¦ ¦--expr: [1/0] {100} + ¦ ¦ ¦ ¦--expr: [0/0] {102} + ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {101} + ¦ ¦ ¦ ¦--':': : [0/0] {103} + ¦ ¦ ¦ °--expr: [0/0] {105} + ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {104} + ¦ ¦ °--')': ) [0/0] {106} + ¦ ¦--COMMENT: # [0/2] {107} + ¦ °--expr: [1/0] {108} + ¦ ¦--expr: [0/0] {110} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {109} + ¦ ¦--'(': ( [0/0] {111} + ¦ ¦--expr: [0/0] {113} + ¦ ¦ °--SYMBOL: i [0/0] {112} + ¦ °--')': ) [0/0] {114} + ¦--expr: [2/0] {115} + ¦ ¦--FOR: for [0/1] {116} + ¦ ¦--forcond: [0/1] {117} + ¦ ¦ ¦--'(': ( [0/0] {118} + ¦ ¦ ¦--COMMENT: # [0/2] {119} + ¦ ¦ ¦--SYMBOL: i [1/1] {120} + ¦ ¦ ¦--IN: in [0/1] {121} ¦ ¦ ¦--COMMENT: # [0/2] {122} - ¦ ¦ ¦--SYMBOL: i [1/1] {123} - ¦ ¦ ¦--IN: in [0/1] {124} - ¦ ¦ ¦--COMMENT: # [0/2] {125} - ¦ ¦ ¦--expr: [1/0] {126} - ¦ ¦ ¦ ¦--expr: [0/0] {128} - ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {127} - ¦ ¦ ¦ ¦--':': : [0/0] {129} - ¦ ¦ ¦ °--expr: [0/0] {131} - ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {130} - ¦ ¦ ¦--COMMENT: # [0/0] {132} - ¦ ¦ °--')': ) [1/0] {133} - ¦ ¦--COMMENT: # [0/2] {134} - ¦ °--expr: [1/0] {135} + ¦ ¦ ¦--expr: [1/0] {123} + ¦ ¦ ¦ ¦--expr: [0/0] {125} + ¦ ¦ ¦ ¦ °--NUM_CONST: 1 [0/0] {124} + ¦ ¦ ¦ ¦--':': : [0/0] {126} + ¦ ¦ ¦ °--expr: [0/0] {128} + ¦ ¦ ¦ °--NUM_CONST: 3 [0/0] {127} + ¦ ¦ ¦--COMMENT: # [0/0] {129} + ¦ ¦ °--')': ) [1/0] {130} + ¦ ¦--COMMENT: # [0/2] {131} + ¦ °--expr: [1/0] {132} + ¦ ¦--expr: [0/0] {134} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {133} + ¦ ¦--'(': ( [0/0] {135} ¦ ¦--expr: [0/0] {137} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: print [0/0] {136} - ¦ ¦--'(': ( [0/0] {138} - ¦ ¦--expr: [0/0] {140} - ¦ ¦ °--SYMBOL: i [0/0] {139} - ¦ °--')': ) [0/0] {141} - ¦--expr: [3/0] {142} - ¦ ¦--WHILE: while [0/1] {143} - ¦ ¦--'(': ( [0/0] {144} - ¦ ¦--expr: [0/0] {145} - ¦ ¦ ¦--expr: [0/1] {147} - ¦ ¦ ¦ °--SYMBOL: x [0/0] {146} - ¦ ¦ ¦--GT: > [0/1] {148} - ¦ ¦ °--expr: [0/0] {150} - ¦ ¦ °--NUM_CONST: 3 [0/0] {149} - ¦ ¦--')': ) [0/1] {151} - ¦ ¦--COMMENT: # [0/2] {152} - ¦ °--expr: [1/0] {153} + ¦ ¦ °--SYMBOL: i [0/0] {136} + ¦ °--')': ) [0/0] {138} + ¦--expr: [3/0] {139} + ¦ ¦--WHILE: while [0/1] {140} + ¦ ¦--'(': ( [0/0] {141} + ¦ ¦--expr: [0/0] {142} + ¦ ¦ ¦--expr: [0/1] {144} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {143} + ¦ ¦ ¦--GT: > [0/1] {145} + ¦ ¦ °--expr: [0/0] {147} + ¦ ¦ °--NUM_CONST: 3 [0/0] {146} + ¦ ¦--')': ) [0/1] {148} + ¦ ¦--COMMENT: # [0/2] {149} + ¦ °--expr: [1/0] {150} + ¦ ¦--expr: [0/0] {152} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {151} + ¦ ¦--'(': ( [0/0] {153} ¦ ¦--expr: [0/0] {155} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {154} - ¦ ¦--'(': ( [0/0] {156} - ¦ ¦--expr: [0/0] {158} - ¦ ¦ °--NUM_CONST: FALSE [0/0] {157} - ¦ °--')': ) [0/0] {159} - ¦--expr: [2/0] {160} - ¦ ¦--WHILE: while [0/1] {161} - ¦ ¦--'(': ( [0/0] {162} - ¦ ¦--expr: [0/1] {163} - ¦ ¦ ¦--expr: [0/1] {165} - ¦ ¦ ¦ °--SYMBOL: x [0/0] {164} - ¦ ¦ ¦--GT: > [0/1] {166} - ¦ ¦ °--expr: [0/0] {168} - ¦ ¦ °--NUM_CONST: 3 [0/0] {167} - ¦ ¦--COMMENT: # [0/0] {169} - ¦ ¦--')': ) [1/2] {170} - ¦ °--expr: [1/0] {171} + ¦ ¦ °--NUM_CONST: FALSE [0/0] {154} + ¦ °--')': ) [0/0] {156} + ¦--expr: [2/0] {157} + ¦ ¦--WHILE: while [0/1] {158} + ¦ ¦--'(': ( [0/0] {159} + ¦ ¦--expr: [0/1] {160} + ¦ ¦ ¦--expr: [0/1] {162} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {161} + ¦ ¦ ¦--GT: > [0/1] {163} + ¦ ¦ °--expr: [0/0] {165} + ¦ ¦ °--NUM_CONST: 3 [0/0] {164} + ¦ ¦--COMMENT: # [0/0] {166} + ¦ ¦--')': ) [1/2] {167} + ¦ °--expr: [1/0] {168} + ¦ ¦--expr: [0/0] {170} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {169} + ¦ ¦--'(': ( [0/0] {171} ¦ ¦--expr: [0/0] {173} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {172} - ¦ ¦--'(': ( [0/0] {174} - ¦ ¦--expr: [0/0] {176} - ¦ ¦ °--NUM_CONST: FALSE [0/0] {175} - ¦ °--')': ) [0/0] {177} - ¦--expr: [2/0] {178} - ¦ ¦--WHILE: while [0/1] {179} - ¦ ¦--'(': ( [0/1] {180} - ¦ ¦--COMMENT: # tes [0/2] {181} - ¦ ¦--expr: [1/0] {182} - ¦ ¦ ¦--expr: [0/1] {184} - ¦ ¦ ¦ °--SYMBOL: x [0/0] {183} - ¦ ¦ ¦--GT: > [0/1] {185} - ¦ ¦ °--expr: [0/0] {187} - ¦ ¦ °--NUM_CONST: 3 [0/0] {186} - ¦ ¦--')': ) [0/1] {188} - ¦ ¦--COMMENT: # ano [0/2] {189} - ¦ °--expr: [1/0] {190} + ¦ ¦ °--NUM_CONST: FALSE [0/0] {172} + ¦ °--')': ) [0/0] {174} + ¦--expr: [2/0] {175} + ¦ ¦--WHILE: while [0/1] {176} + ¦ ¦--'(': ( [0/1] {177} + ¦ ¦--COMMENT: # tes [0/2] {178} + ¦ ¦--expr: [1/0] {179} + ¦ ¦ ¦--expr: [0/1] {181} + ¦ ¦ ¦ °--SYMBOL: x [0/0] {180} + ¦ ¦ ¦--GT: > [0/1] {182} + ¦ ¦ °--expr: [0/0] {184} + ¦ ¦ °--NUM_CONST: 3 [0/0] {183} + ¦ ¦--')': ) [0/1] {185} + ¦ ¦--COMMENT: # ano [0/2] {186} + ¦ °--expr: [1/0] {187} + ¦ ¦--expr: [0/0] {189} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {188} + ¦ ¦--'(': ( [0/0] {190} ¦ ¦--expr: [0/0] {192} - ¦ ¦ °--SYMBOL_FUNCTION_CALL: retur [0/0] {191} - ¦ ¦--'(': ( [0/0] {193} - ¦ ¦--expr: [0/0] {195} - ¦ ¦ °--NUM_CONST: FALSE [0/0] {194} - ¦ °--')': ) [0/0] {196} - ¦--COMMENT: # FIX [2/0] {197} - ¦--expr: [1/0] {198} - ¦ ¦--WHILE: while [0/1] {199} - ¦ ¦--'(': ( [0/2] {200} - ¦ ¦--expr: [1/1] {201} - ¦ ¦ ¦--expr: [0/1] {203} - ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {202} - ¦ ¦ ¦--GT: > [0/1] {204} - ¦ ¦ ¦--COMMENT: #here [0/2] {205} - ¦ ¦ °--expr: [1/0] {207} - ¦ ¦ °--NUM_CONST: 3 [0/0] {206} - ¦ ¦--COMMENT: # [0/0] {208} - ¦ ¦--')': ) [1/1] {209} - ¦ ¦--COMMENT: # [0/2] {210} - ¦ °--expr: [1/0] {212} - ¦ °--NUM_CONST: FALSE [0/0] {211} - ¦--COMMENT: # FIX [2/0] {213} - ¦--expr: [1/0] {214} - ¦ ¦--WHILE: while [0/1] {215} - ¦ ¦--'(': ( [0/2] {216} - ¦ ¦--expr: [1/1] {217} - ¦ ¦ ¦--expr: [0/1] {219} - ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {218} - ¦ ¦ ¦--GT: > [0/1] {220} - ¦ ¦ ¦--COMMENT: #here [0/2] {221} - ¦ ¦ °--expr: [1/0] {223} - ¦ ¦ °--NUM_CONST: 3 [0/0] {222} - ¦ ¦--COMMENT: # [0/0] {224} - ¦ ¦--')': ) [1/2] {225} - ¦ °--expr: [1/0] {227} - ¦ °--NUM_CONST: FALSE [0/0] {226} - ¦--COMMENT: # FIX [2/0] {228} - ¦--expr: [1/0] {229} - ¦ ¦--WHILE: while [0/1] {230} - ¦ ¦--'(': ( [0/2] {231} - ¦ ¦--expr: [1/0] {232} - ¦ ¦ ¦--expr: [0/1] {234} - ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {233} - ¦ ¦ ¦--GT: > [0/1] {235} - ¦ ¦ ¦--COMMENT: #here [0/2] {236} - ¦ ¦ °--expr: [1/0] {238} - ¦ ¦ °--NUM_CONST: 3 [0/0] {237} - ¦ ¦--')': ) [1/1] {239} - ¦ ¦--COMMENT: # [0/2] {240} - ¦ °--expr: [1/0] {242} - ¦ °--NUM_CONST: FALSE [0/0] {241} - °--expr: [2/0] {243} - ¦--WHILE: while [0/1] {244} - ¦--'(': ( [0/0] {245} - ¦--COMMENT: # [0/2] {246} - ¦--expr: [1/0] {247} - ¦ ¦--expr: [0/1] {249} - ¦ ¦ °--NUM_CONST: 2 [0/0] {248} - ¦ ¦--GT: > [0/2] {250} - ¦ °--expr: [1/0] {252} - ¦ °--NUM_CONST: 3 [0/0] {251} - ¦--')': ) [1/1] {253} - ¦--COMMENT: # [0/2] {254} - °--expr: [1/0] {256} - °--NUM_CONST: FALSE [0/0] {255} + ¦ ¦ °--NUM_CONST: FALSE [0/0] {191} + ¦ °--')': ) [0/0] {193} + ¦--expr: [2/0] {194} + ¦ ¦--WHILE: while [0/1] {195} + ¦ ¦--'(': ( [0/2] {196} + ¦ ¦--expr: [1/1] {197} + ¦ ¦ ¦--expr: [0/1] {199} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {198} + ¦ ¦ ¦--GT: > [0/1] {200} + ¦ ¦ ¦--COMMENT: #here [0/2] {201} + ¦ ¦ °--expr: [1/0] {203} + ¦ ¦ °--NUM_CONST: 3 [0/0] {202} + ¦ ¦--COMMENT: # [0/0] {204} + ¦ ¦--')': ) [1/1] {205} + ¦ ¦--COMMENT: # [0/2] {206} + ¦ °--expr: [1/0] {208} + ¦ °--NUM_CONST: FALSE [0/0] {207} + ¦--expr: [2/0] {209} + ¦ ¦--WHILE: while [0/1] {210} + ¦ ¦--'(': ( [0/2] {211} + ¦ ¦--expr: [1/1] {212} + ¦ ¦ ¦--expr: [0/1] {214} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {213} + ¦ ¦ ¦--GT: > [0/1] {215} + ¦ ¦ ¦--COMMENT: #here [0/2] {216} + ¦ ¦ °--expr: [1/0] {218} + ¦ ¦ °--NUM_CONST: 3 [0/0] {217} + ¦ ¦--COMMENT: # [0/0] {219} + ¦ ¦--')': ) [1/2] {220} + ¦ °--expr: [1/0] {222} + ¦ °--NUM_CONST: FALSE [0/0] {221} + ¦--expr: [2/0] {223} + ¦ ¦--WHILE: while [0/1] {224} + ¦ ¦--'(': ( [0/2] {225} + ¦ ¦--expr: [1/0] {226} + ¦ ¦ ¦--expr: [0/1] {228} + ¦ ¦ ¦ °--NUM_CONST: 2 [0/0] {227} + ¦ ¦ ¦--GT: > [0/1] {229} + ¦ ¦ ¦--COMMENT: #here [0/2] {230} + ¦ ¦ °--expr: [1/0] {232} + ¦ ¦ °--NUM_CONST: 3 [0/0] {231} + ¦ ¦--')': ) [1/1] {233} + ¦ ¦--COMMENT: # [0/2] {234} + ¦ °--expr: [1/0] {236} + ¦ °--NUM_CONST: FALSE [0/0] {235} + °--expr: [2/0] {237} + ¦--WHILE: while [0/1] {238} + ¦--'(': ( [0/0] {239} + ¦--COMMENT: # [0/2] {240} + ¦--expr: [1/0] {241} + ¦ ¦--expr: [0/1] {243} + ¦ ¦ °--NUM_CONST: 2 [0/0] {242} + ¦ ¦--GT: > [0/2] {244} + ¦ °--expr: [1/0] {246} + ¦ °--NUM_CONST: 3 [0/0] {245} + ¦--')': ) [1/1] {247} + ¦--COMMENT: # [0/2] {248} + °--expr: [1/0] {250} + °--NUM_CONST: FALSE [0/0] {249} diff --git a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-out.R b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-out.R index d2ef5be83..00490d0db 100644 --- a/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-out.R +++ b/tests/testthat/indention_operators/while_for_if_without_curly_non_strict-out.R @@ -10,22 +10,19 @@ if (x) for (i in 1:3) # print(i) -# FIXME for (i in 1:3) # -print(i) + print(i) -# FIXME for (i in # 1:3) # -print(i) + print(i) -# FIXME for ( # i in # 1:3 # ) # -print(i) + print(i) while (x > 3) # @@ -39,26 +36,23 @@ while ( # test x > 3) # another return(FALSE) -# FIXME while ( 2 > # here 3 # ) # -FALSE + FALSE -# FIXME while ( 2 > # here 3 # ) -FALSE + FALSE -# FIXME while ( 2 > # here 3 ) # -FALSE + FALSE while ( # 2 > From 3acf60367cb7103a32526b87eb812789ec5cc1c8 Mon Sep 17 00:00:00 2001 From: lorenzwalthert Date: Mon, 5 Aug 2019 22:36:17 +0200 Subject: [PATCH 10/10] reformat with stylermd, add bullet for 356. --- NEWS.md | 47 +++++++++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/NEWS.md b/NEWS.md index d3bae1ab1..4d54ec5cf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,28 +2,35 @@ ## Breaking changes -* `style_file()` now correctly styles multiple files from different - directories. We no longer display the file name of the styled file, but - the absolute path. This is also reflected in the invisible return value of the - function (#522). -* `style_file()` and friends do not write content back to a file when - styling does not cause any changes in the file. This means the modification - date of files styled is only changed when the content is changed (#532). +* `style_file()` now correctly styles multiple files from different directories. + We no longer display the file name of the styled file, but the absolute path. + This is also reflected in the invisible return value of the function (#522). + +* `style_file()` and friends do not write content back to a file when styling + does not cause any changes in the file. This means the modification date of + files styled is only changed when the content is changed (#532). ## New features -* curlyl-curly (`{{`) syntactic sugar introduced with rlang 0.4.0 is now - explicitly handled, as opposed previously where it was just treated as two +* curlyl-curly (`{{`) syntactic sugar introduced with rlang 0.4.0 is now + explicitly handled, as opposed previously where it was just treated as two consequtive curly braces (#528). -* `style_pkg()`, `style_dir()` and the Addins can now style `.Rprofile`, and + +* `style_pkg()`, `style_dir()` and the Addins can now style `.Rprofile`, and hidden files are now also styled (#530). ## Minor improvements and fixes * escape characters in roxygen code examples are now correctly escaped (#512). -* style selection Addin now preserves line break when the last line selected is + +* style selection Addin now preserves line break when the last line selected is an entire line (#520). + * style file Addin can now properly handle cancelling (#511). + +* The body of a multi-line function declaration is now indented correctly for + `strict = FALSE` and also wrapped in curly braces for `strict = TRUE` (#536). + * advice for contributors in `CONTRIBUTING.md` was updated (#508). ## Adaption @@ -41,8 +48,8 @@ This is primarily a maintenance release upon the request of the CRAN team - Users can now control style configurations for styler Addins (#463, #500), using the `Set style` Addin. See `?styler::styler_addins` for details. -- `return()` is now always put in braces and put on a new line when used in - a conditional statement (#492). +- `return()` is now always put in braces and put on a new line when used in a + conditional statement (#492). - `%>%` almost always causes a line break now for `strict = TRUE` (#503). @@ -55,20 +62,20 @@ This is primarily a maintenance release upon the request of the CRAN team - indention in roxygen code example styling (#455) and EOF spacing (#469) was fixed. -- indention for for loop edge case (#457) and comments in pipe chain (#482) - were fixed. +- indention for for loop edge case (#457) and comments in pipe chain (#482) were + fixed. - line-break styling around comma is improved (#479). -- bug that can cause an error when the variable `text` in any name space - before styler on the search path was defined and did not have length 1 is - fixed (#484). +- bug that can cause an error when the variable `text` in any name space before + styler on the search path was defined and did not have length 1 is fixed + (#484). - slightly confusing warning about empty strings caused with roxygen code examples and Rmd was removed. -- right apostrophe to let package pass R CMD Check in strict Latin-1 - locale was removed (#490, reason for release). +- right apostrophe to let package pass R CMD Check in strict Latin-1 locale was + removed (#490, reason for release). ## Adaption of styler