diff --git a/R/rules-indention.R b/R/rules-indention.R index 30cf7b246..608a05214 100644 --- a/R/rules-indention.R +++ b/R/rules-indention.R @@ -34,8 +34,8 @@ unindent_fun_dec <- function(pd, indent_by = 2L) { #' Is the function declaration double indented? #' #' Assumes you already checked if it's a function with -#' `is_function_declaration`. It is double indented if the first token -#' after the first line break that is a `"SYMBOL_FORMALS"`. +#' `is_function_declaration`. It is double indented if the body of the function +#' is indented less than the first argument of the function. #' @param pd A parse table. #' @inheritParams tidyverse_style #' @keywords internal @@ -45,7 +45,26 @@ is_double_indent_function_declaration <- function(pd, indent_by = 2L) { if (length(line_break_in_header) > 0L) { # indent results from applying the rules, spaces is the initial spaces # (which is indention if a newline is ahead) - pd$spaces[line_break_in_header[1L] - 1L] <= 2L * indent_by + + idx_line_break <- last(which(pd$newlines > 0L)) + if (length(idx_line_break) > 0L && idx_line_break + 1L == nrow(pd)) { + # function() # + # { <- measure indention on opening brace + # if last line break is at last token ("'{'") + indention_child <- pd$spaces[idx_line_break] + } else { + # function() { # + # stuff <-measure indention inside the brace + child <- pd$child[[nrow(pd)]] + # even with comments, first is {, otherwise it's first case + # child$token == "'{'" & child$lag_newlines > 0 + + idx_first_line_break_in_child <- which(child$newlines > 0L)[1L] + indention_child <- child$spaces[idx_first_line_break_in_child] + } + + + pd$spaces[line_break_in_header[1L] - 1L] > indention_child } else { FALSE } diff --git a/man/is_double_indent_function_declaration.Rd b/man/is_double_indent_function_declaration.Rd index d9a36a367..8cc75fb82 100644 --- a/man/is_double_indent_function_declaration.Rd +++ b/man/is_double_indent_function_declaration.Rd @@ -14,7 +14,7 @@ operators such as '('.} } \description{ Assumes you already checked if it's a function with -\code{is_function_declaration}. It is double indented if the first token -after the first line break that is a \code{"SYMBOL_FORMALS"}. +\code{is_function_declaration}. It is double indented if the body of the function +is indented less than the first argument of the function. } \keyword{internal} diff --git a/tests/testthat/indention_operators/r6-double-in.R b/tests/testthat/indention_operators/r6-double-in.R new file mode 100644 index 000000000..189f56512 --- /dev/null +++ b/tests/testthat/indention_operators/r6-double-in.R @@ -0,0 +1,62 @@ +# normal cases +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) { # + self$param <- my_long_paramete + } + ) +) + + +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) { + self$param <- my_long_paramete + } + ) +) + + +R6Class("MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) + { + self$param <- my_long_paramete + } + ) +) + +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) + # + { + self$param <- my_long_paramete + } + ) +) + +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) + {self$param <- my_long_paramete} + ) +) + +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) + NULL + ) +) diff --git a/tests/testthat/indention_operators/r6-double-in_tree b/tests/testthat/indention_operators/r6-double-in_tree new file mode 100644 index 000000000..23af9cf53 --- /dev/null +++ b/tests/testthat/indention_operators/r6-double-in_tree @@ -0,0 +1,268 @@ +ROOT (token: short_text [lag_newlines/spaces] {pos_id}) + ¦--COMMENT: # nor [0/0] {1} + ¦--expr: R6Cla [1/0] {2} + ¦ ¦--expr: R6Cla [0/0] {4} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: R6Cla [0/0] {3} + ¦ ¦--'(': ( [0/2] {5} + ¦ ¦--expr: "MyCl [1/0] {7} + ¦ ¦ °--STR_CONST: "MyCl [0/0] {6} + ¦ ¦--',': , [0/2] {8} + ¦ ¦--SYMBOL_SUB: publi [1/1] {9} + ¦ ¦--EQ_SUB: = [0/1] {10} + ¦ ¦--expr: list( [0/0] {11} + ¦ ¦ ¦--expr: list [0/0] {13} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: list [0/0] {12} + ¦ ¦ ¦--'(': ( [0/4] {14} + ¦ ¦ ¦--SYMBOL_SUB: initi [1/1] {15} + ¦ ¦ ¦--EQ_SUB: = [0/1] {16} + ¦ ¦ ¦--expr: funct [0/2] {17} + ¦ ¦ ¦ ¦--FUNCTION: funct [0/0] {18} + ¦ ¦ ¦ ¦--'(': ( [0/8] {19} + ¦ ¦ ¦ ¦--SYMBOL_FORMALS: my_lo [1/1] {20} + ¦ ¦ ¦ ¦--EQ_FORMALS: = [0/1] {21} + ¦ ¦ ¦ ¦--expr: getOp [0/0] {22} + ¦ ¦ ¦ ¦ ¦--expr: getOp [0/0] {24} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: getOp [0/0] {23} + ¦ ¦ ¦ ¦ ¦--'(': ( [0/0] {25} + ¦ ¦ ¦ ¦ ¦--expr: "defa [0/0] {27} + ¦ ¦ ¦ ¦ ¦ °--STR_CONST: "defa [0/0] {26} + ¦ ¦ ¦ ¦ ¦--',': , [0/1] {28} + ¦ ¦ ¦ ¦ ¦--expr: 7 [0/0] {30} + ¦ ¦ ¦ ¦ ¦ °--NUM_CONST: 7 [0/0] {29} + ¦ ¦ ¦ ¦ °--')': ) [0/0] {31} + ¦ ¦ ¦ ¦--')': ) [0/1] {32} + ¦ ¦ ¦ °--expr: { # + [0/0] {33} + ¦ ¦ ¦ ¦--'{': { [0/1] {34} + ¦ ¦ ¦ ¦--COMMENT: # [0/6] {35} + ¦ ¦ ¦ ¦--expr: self$ [1/4] {36} + ¦ ¦ ¦ ¦ ¦--expr: self$ [0/1] {37} + ¦ ¦ ¦ ¦ ¦ ¦--expr: self [0/0] {39} + ¦ ¦ ¦ ¦ ¦ ¦ °--SYMBOL: self [0/0] {38} + ¦ ¦ ¦ ¦ ¦ ¦--'$': $ [0/0] {40} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL: param [0/0] {41} + ¦ ¦ ¦ ¦ ¦--LEFT_ASSIGN: <- [0/1] {42} + ¦ ¦ ¦ ¦ °--expr: my_lo [0/0] {44} + ¦ ¦ ¦ ¦ °--SYMBOL: my_lo [0/0] {43} + ¦ ¦ ¦ °--'}': } [1/0] {45} + ¦ ¦ °--')': ) [1/0] {46} + ¦ °--')': ) [1/0] {47} + ¦--expr: R6Cla [3/0] {48} + ¦ ¦--expr: R6Cla [0/0] {50} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: R6Cla [0/0] {49} + ¦ ¦--'(': ( [0/2] {51} + ¦ ¦--expr: "MyCl [1/0] {53} + ¦ ¦ °--STR_CONST: "MyCl [0/0] {52} + ¦ ¦--',': , [0/2] {54} + ¦ ¦--SYMBOL_SUB: publi [1/1] {55} + ¦ ¦--EQ_SUB: = [0/1] {56} + ¦ ¦--expr: list( [0/0] {57} + ¦ ¦ ¦--expr: list [0/0] {59} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: list [0/0] {58} + ¦ ¦ ¦--'(': ( [0/4] {60} + ¦ ¦ ¦--SYMBOL_SUB: initi [1/1] {61} + ¦ ¦ ¦--EQ_SUB: = [0/1] {62} + ¦ ¦ ¦--expr: funct [0/2] {63} + ¦ ¦ ¦ ¦--FUNCTION: funct [0/0] {64} + ¦ ¦ ¦ ¦--'(': ( [0/8] {65} + ¦ ¦ ¦ ¦--SYMBOL_FORMALS: my_lo [1/1] {66} + ¦ ¦ ¦ ¦--EQ_FORMALS: = [0/1] {67} + ¦ ¦ ¦ ¦--expr: getOp [0/0] {68} + ¦ ¦ ¦ ¦ ¦--expr: getOp [0/0] {70} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: getOp [0/0] {69} + ¦ ¦ ¦ ¦ ¦--'(': ( [0/0] {71} + ¦ ¦ ¦ ¦ ¦--expr: "defa [0/0] {73} + ¦ ¦ ¦ ¦ ¦ °--STR_CONST: "defa [0/0] {72} + ¦ ¦ ¦ ¦ ¦--',': , [0/1] {74} + ¦ ¦ ¦ ¦ ¦--expr: 7 [0/0] {76} + ¦ ¦ ¦ ¦ ¦ °--NUM_CONST: 7 [0/0] {75} + ¦ ¦ ¦ ¦ °--')': ) [0/0] {77} + ¦ ¦ ¦ ¦--')': ) [0/1] {78} + ¦ ¦ ¦ °--expr: { + [0/0] {79} + ¦ ¦ ¦ ¦--'{': { [0/6] {80} + ¦ ¦ ¦ ¦--expr: self$ [1/4] {81} + ¦ ¦ ¦ ¦ ¦--expr: self$ [0/1] {82} + ¦ ¦ ¦ ¦ ¦ ¦--expr: self [0/0] {84} + ¦ ¦ ¦ ¦ ¦ ¦ °--SYMBOL: self [0/0] {83} + ¦ ¦ ¦ ¦ ¦ ¦--'$': $ [0/0] {85} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL: param [0/0] {86} + ¦ ¦ ¦ ¦ ¦--LEFT_ASSIGN: <- [0/1] {87} + ¦ ¦ ¦ ¦ °--expr: my_lo [0/0] {89} + ¦ ¦ ¦ ¦ °--SYMBOL: my_lo [0/0] {88} + ¦ ¦ ¦ °--'}': } [1/0] {90} + ¦ ¦ °--')': ) [1/0] {91} + ¦ °--')': ) [1/0] {92} + ¦--expr: R6Cla [3/0] {93} + ¦ ¦--expr: R6Cla [0/0] {95} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: R6Cla [0/0] {94} + ¦ ¦--'(': ( [0/0] {96} + ¦ ¦--expr: "MyCl [0/0] {98} + ¦ ¦ °--STR_CONST: "MyCl [0/0] {97} + ¦ ¦--',': , [0/2] {99} + ¦ ¦--SYMBOL_SUB: publi [1/1] {100} + ¦ ¦--EQ_SUB: = [0/1] {101} + ¦ ¦--expr: list( [0/0] {102} + ¦ ¦ ¦--expr: list [0/0] {104} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: list [0/0] {103} + ¦ ¦ ¦--'(': ( [0/4] {105} + ¦ ¦ ¦--SYMBOL_SUB: initi [1/1] {106} + ¦ ¦ ¦--EQ_SUB: = [0/1] {107} + ¦ ¦ ¦--expr: funct [0/2] {108} + ¦ ¦ ¦ ¦--FUNCTION: funct [0/0] {109} + ¦ ¦ ¦ ¦--'(': ( [0/8] {110} + ¦ ¦ ¦ ¦--SYMBOL_FORMALS: my_lo [1/1] {111} + ¦ ¦ ¦ ¦--EQ_FORMALS: = [0/1] {112} + ¦ ¦ ¦ ¦--expr: getOp [0/0] {113} + ¦ ¦ ¦ ¦ ¦--expr: getOp [0/0] {115} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: getOp [0/0] {114} + ¦ ¦ ¦ ¦ ¦--'(': ( [0/0] {116} + ¦ ¦ ¦ ¦ ¦--expr: "defa [0/0] {118} + ¦ ¦ ¦ ¦ ¦ °--STR_CONST: "defa [0/0] {117} + ¦ ¦ ¦ ¦ ¦--',': , [0/1] {119} + ¦ ¦ ¦ ¦ ¦--expr: 7 [0/0] {121} + ¦ ¦ ¦ ¦ ¦ °--NUM_CONST: 7 [0/0] {120} + ¦ ¦ ¦ ¦ °--')': ) [0/0] {122} + ¦ ¦ ¦ ¦--')': ) [0/4] {123} + ¦ ¦ ¦ °--expr: { + [1/0] {124} + ¦ ¦ ¦ ¦--'{': { [0/6] {125} + ¦ ¦ ¦ ¦--expr: self$ [1/4] {126} + ¦ ¦ ¦ ¦ ¦--expr: self$ [0/1] {127} + ¦ ¦ ¦ ¦ ¦ ¦--expr: self [0/0] {129} + ¦ ¦ ¦ ¦ ¦ ¦ °--SYMBOL: self [0/0] {128} + ¦ ¦ ¦ ¦ ¦ ¦--'$': $ [0/0] {130} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL: param [0/0] {131} + ¦ ¦ ¦ ¦ ¦--LEFT_ASSIGN: <- [0/1] {132} + ¦ ¦ ¦ ¦ °--expr: my_lo [0/0] {134} + ¦ ¦ ¦ ¦ °--SYMBOL: my_lo [0/0] {133} + ¦ ¦ ¦ °--'}': } [1/0] {135} + ¦ ¦ °--')': ) [1/0] {136} + ¦ °--')': ) [1/0] {137} + ¦--expr: R6Cla [2/0] {138} + ¦ ¦--expr: R6Cla [0/0] {140} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: R6Cla [0/0] {139} + ¦ ¦--'(': ( [0/2] {141} + ¦ ¦--expr: "MyCl [1/0] {143} + ¦ ¦ °--STR_CONST: "MyCl [0/0] {142} + ¦ ¦--',': , [0/2] {144} + ¦ ¦--SYMBOL_SUB: publi [1/1] {145} + ¦ ¦--EQ_SUB: = [0/1] {146} + ¦ ¦--expr: list( [0/0] {147} + ¦ ¦ ¦--expr: list [0/0] {149} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: list [0/0] {148} + ¦ ¦ ¦--'(': ( [0/4] {150} + ¦ ¦ ¦--SYMBOL_SUB: initi [1/1] {151} + ¦ ¦ ¦--EQ_SUB: = [0/1] {152} + ¦ ¦ ¦--expr: funct [0/2] {153} + ¦ ¦ ¦ ¦--FUNCTION: funct [0/0] {154} + ¦ ¦ ¦ ¦--'(': ( [0/8] {155} + ¦ ¦ ¦ ¦--SYMBOL_FORMALS: my_lo [1/1] {156} + ¦ ¦ ¦ ¦--EQ_FORMALS: = [0/1] {157} + ¦ ¦ ¦ ¦--expr: getOp [0/0] {158} + ¦ ¦ ¦ ¦ ¦--expr: getOp [0/0] {160} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: getOp [0/0] {159} + ¦ ¦ ¦ ¦ ¦--'(': ( [0/0] {161} + ¦ ¦ ¦ ¦ ¦--expr: "defa [0/0] {163} + ¦ ¦ ¦ ¦ ¦ °--STR_CONST: "defa [0/0] {162} + ¦ ¦ ¦ ¦ ¦--',': , [0/1] {164} + ¦ ¦ ¦ ¦ ¦--expr: 7 [0/0] {166} + ¦ ¦ ¦ ¦ ¦ °--NUM_CONST: 7 [0/0] {165} + ¦ ¦ ¦ ¦ °--')': ) [0/0] {167} + ¦ ¦ ¦ ¦--')': ) [0/4] {168} + ¦ ¦ ¦ ¦--COMMENT: # [1/4] {169} + ¦ ¦ ¦ °--expr: { + [1/0] {170} + ¦ ¦ ¦ ¦--'{': { [0/6] {171} + ¦ ¦ ¦ ¦--expr: self$ [1/4] {172} + ¦ ¦ ¦ ¦ ¦--expr: self$ [0/1] {173} + ¦ ¦ ¦ ¦ ¦ ¦--expr: self [0/0] {175} + ¦ ¦ ¦ ¦ ¦ ¦ °--SYMBOL: self [0/0] {174} + ¦ ¦ ¦ ¦ ¦ ¦--'$': $ [0/0] {176} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL: param [0/0] {177} + ¦ ¦ ¦ ¦ ¦--LEFT_ASSIGN: <- [0/1] {178} + ¦ ¦ ¦ ¦ °--expr: my_lo [0/0] {180} + ¦ ¦ ¦ ¦ °--SYMBOL: my_lo [0/0] {179} + ¦ ¦ ¦ °--'}': } [1/0] {181} + ¦ ¦ °--')': ) [1/0] {182} + ¦ °--')': ) [1/0] {183} + ¦--expr: R6Cla [2/0] {184} + ¦ ¦--expr: R6Cla [0/0] {186} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: R6Cla [0/0] {185} + ¦ ¦--'(': ( [0/2] {187} + ¦ ¦--expr: "MyCl [1/0] {189} + ¦ ¦ °--STR_CONST: "MyCl [0/0] {188} + ¦ ¦--',': , [0/2] {190} + ¦ ¦--SYMBOL_SUB: publi [1/1] {191} + ¦ ¦--EQ_SUB: = [0/1] {192} + ¦ ¦--expr: list( [0/0] {193} + ¦ ¦ ¦--expr: list [0/0] {195} + ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: list [0/0] {194} + ¦ ¦ ¦--'(': ( [0/4] {196} + ¦ ¦ ¦--SYMBOL_SUB: initi [1/1] {197} + ¦ ¦ ¦--EQ_SUB: = [0/1] {198} + ¦ ¦ ¦--expr: funct [0/2] {199} + ¦ ¦ ¦ ¦--FUNCTION: funct [0/0] {200} + ¦ ¦ ¦ ¦--'(': ( [0/8] {201} + ¦ ¦ ¦ ¦--SYMBOL_FORMALS: my_lo [1/1] {202} + ¦ ¦ ¦ ¦--EQ_FORMALS: = [0/1] {203} + ¦ ¦ ¦ ¦--expr: getOp [0/0] {204} + ¦ ¦ ¦ ¦ ¦--expr: getOp [0/0] {206} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: getOp [0/0] {205} + ¦ ¦ ¦ ¦ ¦--'(': ( [0/0] {207} + ¦ ¦ ¦ ¦ ¦--expr: "defa [0/0] {209} + ¦ ¦ ¦ ¦ ¦ °--STR_CONST: "defa [0/0] {208} + ¦ ¦ ¦ ¦ ¦--',': , [0/1] {210} + ¦ ¦ ¦ ¦ ¦--expr: 7 [0/0] {212} + ¦ ¦ ¦ ¦ ¦ °--NUM_CONST: 7 [0/0] {211} + ¦ ¦ ¦ ¦ °--')': ) [0/0] {213} + ¦ ¦ ¦ ¦--')': ) [0/4] {214} + ¦ ¦ ¦ °--expr: {self [1/0] {215} + ¦ ¦ ¦ ¦--'{': { [0/0] {216} + ¦ ¦ ¦ ¦--expr: self$ [0/0] {217} + ¦ ¦ ¦ ¦ ¦--expr: self$ [0/1] {218} + ¦ ¦ ¦ ¦ ¦ ¦--expr: self [0/0] {220} + ¦ ¦ ¦ ¦ ¦ ¦ °--SYMBOL: self [0/0] {219} + ¦ ¦ ¦ ¦ ¦ ¦--'$': $ [0/0] {221} + ¦ ¦ ¦ ¦ ¦ °--SYMBOL: param [0/0] {222} + ¦ ¦ ¦ ¦ ¦--LEFT_ASSIGN: <- [0/1] {223} + ¦ ¦ ¦ ¦ °--expr: my_lo [0/0] {225} + ¦ ¦ ¦ ¦ °--SYMBOL: my_lo [0/0] {224} + ¦ ¦ ¦ °--'}': } [0/0] {226} + ¦ ¦ °--')': ) [1/0] {227} + ¦ °--')': ) [1/0] {228} + °--expr: R6Cla [2/0] {229} + ¦--expr: R6Cla [0/0] {231} + ¦ °--SYMBOL_FUNCTION_CALL: R6Cla [0/0] {230} + ¦--'(': ( [0/2] {232} + ¦--expr: "MyCl [1/0] {234} + ¦ °--STR_CONST: "MyCl [0/0] {233} + ¦--',': , [0/2] {235} + ¦--SYMBOL_SUB: publi [1/1] {236} + ¦--EQ_SUB: = [0/1] {237} + ¦--expr: list( [0/0] {238} + ¦ ¦--expr: list [0/0] {240} + ¦ ¦ °--SYMBOL_FUNCTION_CALL: list [0/0] {239} + ¦ ¦--'(': ( [0/2] {241} + ¦ ¦--SYMBOL_SUB: initi [1/1] {242} + ¦ ¦--EQ_SUB: = [0/1] {243} + ¦ ¦--expr: funct [0/2] {244} + ¦ ¦ ¦--FUNCTION: funct [0/0] {245} + ¦ ¦ ¦--'(': ( [0/6] {246} + ¦ ¦ ¦--SYMBOL_FORMALS: my_lo [1/1] {247} + ¦ ¦ ¦--EQ_FORMALS: = [0/1] {248} + ¦ ¦ ¦--expr: getOp [0/0] {249} + ¦ ¦ ¦ ¦--expr: getOp [0/0] {251} + ¦ ¦ ¦ ¦ °--SYMBOL_FUNCTION_CALL: getOp [0/0] {250} + ¦ ¦ ¦ ¦--'(': ( [0/0] {252} + ¦ ¦ ¦ ¦--expr: "defa [0/0] {254} + ¦ ¦ ¦ ¦ °--STR_CONST: "defa [0/0] {253} + ¦ ¦ ¦ ¦--',': , [0/1] {255} + ¦ ¦ ¦ ¦--expr: 7 [0/0] {257} + ¦ ¦ ¦ ¦ °--NUM_CONST: 7 [0/0] {256} + ¦ ¦ ¦ °--')': ) [0/0] {258} + ¦ ¦ ¦--')': ) [0/4] {259} + ¦ ¦ °--expr: NULL [1/0] {261} + ¦ ¦ °--NULL_CONST: NULL [0/0] {260} + ¦ °--')': ) [1/0] {262} + °--')': ) [1/0] {263} diff --git a/tests/testthat/indention_operators/r6-double-out.R b/tests/testthat/indention_operators/r6-double-out.R new file mode 100644 index 000000000..b776a6615 --- /dev/null +++ b/tests/testthat/indention_operators/r6-double-out.R @@ -0,0 +1,63 @@ +# normal cases +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) { # + self$param <- my_long_paramete + } + ) +) + + +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) { + self$param <- my_long_paramete + } + ) +) + + +R6Class("MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) { + self$param <- my_long_paramete + } + ) +) + +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) + # + { + self$param <- my_long_paramete + } + ) +) + +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) { + self$param <- my_long_paramete + } + ) +) + +R6Class( + "MyClass", + public = list( + initialize = function( + my_long_parameter = getOption("default_long_parameter", 7)) { + NULL + } + ) +) diff --git a/tests/testthat/test-indention_operators.R b/tests/testthat/test-indention_operators.R index 2e7d1d4ff..2d1a098e1 100644 --- a/tests/testthat/test-indention_operators.R +++ b/tests/testthat/test-indention_operators.R @@ -153,3 +153,10 @@ test_that("overall", { transformer = style_text ), NA) }) + +test_that("double-indent-r6", { + expect_warning(test_collection("indention_operators", + "r6", + transformer = style_text + ), NA) +})