pkgtools/R2pkg: refactoring, tests

2 files changed, 150 insertions, 173 deletions

diff --git a/pkgtools/R2pkg/files/R2pkg.R b/pkgtools/R2pkg/files/R2pkg.R
index 1c6a541ce0e..bb3270d9f74 100644
--- a/pkgtools/R2pkg/files/R2pkg.R
+++ b/pkgtools/R2pkg/files/R2pkg.R
@@ -1,4 +1,4 @@
-# $NetBSD: R2pkg.R,v 1.23 2019/10/19 19:10:31 rillig Exp $
+# $NetBSD: R2pkg.R,v 1.24 2019/10/19 21:12:18 rillig Exp $
 #
 # Copyright (c) 2014,2015,2016,2017,2018,2019
 #	Brook Milligan.  All rights reserved.
@@ -57,6 +57,8 @@ one.space <- function(s) gsub('[[:blank:]]+',' ',s)
 one.line <- function(s) gsub('\n',' ',s)
 pkg.vers <- function(s) gsub('_','.',s)
 varassign <- function(varname, value) paste0(varname, '=\t', value)
+relpath_category <- function(relpath)
+  unlist(sapply(strsplit(relpath, '/'), '[', 3))
 
 # The list of "recommended packages which are to be included in all
 # binary distributions of R." (R FAQ 5.1.2 2018-10-18)
@@ -138,14 +140,8 @@ licenses[['MPL-2.0']]                                <- 'mpl-2.0'
 licenses[['MPL-2.0 | file LICENSE']]                 <- 'mpl-2.0\t# OR file LICENSE'
 licenses[['POSTGRESQL']]                             <- 'postgresql-license'
 
-adjacent.duplicates <- function(x)
-{
-  a <- x[-length(x)]
-  b <- x[-1]
-  dups <- a == b
-  dups <- c(FALSE,dups)
-  dups
-}
+adjacent.duplicates <- function(lines)
+  c(FALSE, lines[-length(lines)] == lines[-1])
 
 paste2 <- function(s1,s2)
 {
@@ -172,14 +168,6 @@ as.sorted.list <- function(df)
   l
 }
 
-read.file.as.dataframe <- function(filename)
-{
-  df <- data.frame()
-  for (line in as.list(readLines(filename)))
-    df <- rbind(df, data.frame(line = line, stringsAsFactors = FALSE))
-  df
-}
-
 mklines.get_value <- function(mklines, varname, default = '')
 {
   values <- mklines$old_value[mklines$key == varname]
@@ -190,53 +178,39 @@ mklines.get_value <- function(mklines, varname, default = '')
 
 categorize.key_value <- function(df,line='line')
 {
-  re.skip_blank <- '[[:blank:]]*'
-  re.blank <- '[[:blank:]]+'
-  re.anything <- '.*'
-
-  re.key <- '[^+=[:blank:]]+'
-  re.operator <- '[+=]+'
-  re.delimiter <- re.skip_blank
-  re.value <- re.anything
-  re.optional_TODO <- '(#[[:blank:]]*TODO[[:blank:]]*:[[:blank:]]*)*'
-
-  re.match_key_value_line <- paste0('^',
-    re.skip_blank,
-    re.optional_TODO,
-    re.key,
-    re.skip_blank,
-    re.operator,
-    re.delimiter,
-    re.value,
-    '$')
-
-  re.match_key <- paste0('^',
-    re.skip_blank,
-    re.optional_TODO,
-    '(',re.key,')',
-    re.skip_blank,
-    re.operator,
-    re.delimiter,
-    re.value,
+  re_varassign <- paste0(
+    '^',
+    ' *',
+    '((?:#[\t ]*TODO[\t ]*:[\t ]*)*)',  # $old_todo
+    '([^+=\t ]+)',  # varname ($key)
+    '[\t ]*',
+    '(\\+?=)',      # operator
+    '([\t ]*)',     # delimiter
+    '(.*)',         # value ($old_value)
     '$')
 
-  df$key_value <- grepl(re.match_key_value_line,df[,line])
-  df$key <- sub(re.match_key,'\\2',df[,line])
-  df$key[!df$key_value] <- NA
+  va <- grepl(re_varassign, df[, line])
+  df$key_value     <- va
+  df$old_todo[va]  <- sub(re_varassign, '\\1', df[, line][va])
+  df$key <- NA  # XXX: why is this line necessary here, and not in the other columns?
+  df$key[va]       <- sub(re_varassign, '\\2', df[, line][va])
+  df$operator[va]  <- sub(re_varassign, '\\3', df[, line][va])
+  df$delimiter[va] <- sub(re_varassign, '\\4', df[, line][va])
+  df$old_value[va] <- sub(re_varassign, '\\5', df[, line][va])
   df
 }
 
-categorize.depends <- function(df,line='line')
+categorize.depends <- function(df, line='line')
 {
   df$depends <- df$key_value & df$key == 'DEPENDS'
-  df$category[df$depends] <- unlist(sapply(strsplit(df[df$depends,line],'/',fixed=TRUE),'[',3))
+  df$category[df$depends] <- unlist(relpath_category(df[df$depends, line]))
   df
 }
 
-categorize.buildlink <- function(df,line='line')
+categorize.buildlink <- function(df, line='line')
 {
-  df$buildlink3.mk <- grepl('buildlink3.mk',df[,line])
-  df$category[df$buildlink3.mk] <- unlist(sapply(strsplit(df[df$buildlink3.mk,line],'/',fixed=TRUE),'[',3))
+  df$buildlink3.mk <- grepl('buildlink3.mk', df[, line])
+  df$category[df$buildlink3.mk] <- relpath_category(df[df$buildlink3.mk, line])
   df
 }
 
@@ -264,34 +238,19 @@ fix.continued.lines <- function(df,line='line')
   df
 }
 
-read.Makefile.as.dataframe <- function(filename)
+read_mklines <- function(filename)
 {
-  re_varassign <- paste0(
-    '^',
-    ' *',
-    '(', '(?:#[\t ]*TODO[\t ]*:[\t ]*)*',')',  # comment
-    '[^+=[:blank:]]+',  # varname
-    '[\t ]*',
-    '(', '[+=]+',')',  # operator
-    '(', '[\t ]*',')',  # delimiter
-    '(', '.*',')',
-    '$')
-
-  df <- read.file.as.dataframe(filename)
+  df <- data.frame()
+  for (line in as.list(readLines(filename)))
+    df <- rbind(df, data.frame(line = line, stringsAsFactors = FALSE))
 
   df$order <- 1:nrow(df)
-  df$category <- NA  # for DEPENDS lines
 
   df <- categorize.key_value(df)
   df <- fix.continued.lines(df)
+  df$category <- NA
   df <- categorize.depends(df)
   df <- categorize.buildlink(df)
-
-  va <- df$key_value
-  df$old_todo[va] <- sub(re_varassign, '\\1', df$line[va])
-  df$operator[va] <- sub(re_varassign, '\\2', df$line[va])
-  df$delimiter[va] <- sub(re_varassign, '\\3', df$line[va])
-  df$old_value[va] <- sub(re_varassign, '\\4', df$line[va])
   df
 }
 
@@ -663,7 +622,7 @@ make.new_license <- function(df,license)
   df
 }
 
-license.in.pkgsrc <- function(license) { license %in% sapply(licenses,'[',1) }
+license.in.pkgsrc <- function(license) license %in% sapply(licenses, '[', 1)
 
 make.license <- function(df)
 {
@@ -865,58 +824,45 @@ make.df.buildlink3 <- function(df,BUILDLINK3.MK)
   df.buildlink3.mk
 }
 
-make.df.makefile <- function(df,df.conflicts,df.depends,df.buildlink3.mk)
+#' updates the dependencies and returns the lines to be written to the
+#' updated package Makefile.
+mklines.lines <- function(mklines, df.conflicts, df.depends, df.buildlink3.mk)
 {
-  # message('===> make.df.makefile():')
-  # message('===> df:')
-  # str(df)
-  # print(df)
-  fields <- c('new_line','order','category','depends','buildlink3.mk')
-  df.makefile <- df[!df$depends & !df$buildlink3.mk,fields]
-  df.makefile <- rbind(df.makefile,df.conflicts,df.depends,df.buildlink3.mk)
-  df.makefile <- df.makefile[order(df.makefile$order,df.makefile$category,df.makefile$new_line),]
-  df.makefile <- df.makefile[!adjacent.duplicates(df.makefile$new_line),]
-  df.makefile
+  fields <- c('new_line', 'order', 'category', 'depends', 'buildlink3.mk')
+  lines <- mklines[! mklines$depends & ! mklines$buildlink3.mk, fields]
+  lines <- rbind(lines, df.conflicts, df.depends, df.buildlink3.mk)
+  lines <- lines[order(lines$order, lines$category, lines$new_line),]
+  lines <- lines[! adjacent.duplicates(lines$new_line),]
+  lines$new_line
 }
 
-update.Makefile <- function(orig, metadata)
+update.Makefile <- function(mklines, metadata)
 {
-  DEPENDENCIES  <- make.depends(metadata$Imports,metadata$Depends)
+  DEPENDENCIES  <- make.depends(metadata$Imports, metadata$Depends)
   DEPENDS       <- DEPENDENCIES[[1]]
   BUILDLINK3.MK <- DEPENDENCIES[[2]]
-  # message('===> DEPENDS:')
-  # str(DEPENDS)
-  # print(DEPENDS)
-  # message('===> BUILDLINK3.MK:')
-  # str(BUILDLINK3.MK)
-  # print(BUILDLINK3.MK)
-
-  # message('===> df:')
-  df <- orig
-  df <- mklines.update_with_metadata(df, metadata)
-  df <- mklines.update_value(df)
-  df <- mklines.update_new_line(df)
-  df <- mklines.annotate_distname(df)
-  df <- mklines.remove_lines_before_update(df)
-  df <- mklines.reassign_order(df)
-
-  df.conflicts <- make.df.conflicts(df,metadata)
-  df.depends <- make.df.depends(df,DEPENDS)
-  df.buildlink3 <- make.df.buildlink3(df,BUILDLINK3.MK)
-  df.makefile <- make.df.makefile(df,df.conflicts,df.depends,df.buildlink3)
-
-  write(df.makefile[, 'new_line'], 'Makefile')
+
+  mklines <- mklines.update_with_metadata(mklines, metadata)
+  mklines <- mklines.update_value(mklines)
+  mklines <- mklines.update_new_line(mklines)
+  mklines <- mklines.annotate_distname(mklines)
+  mklines <- mklines.remove_lines_before_update(mklines)
+  mklines <- mklines.reassign_order(mklines)
+
+  conflicts   <- make.df.conflicts(mklines, metadata)
+  depends     <- make.df.depends(mklines, DEPENDS)
+  buildlink3  <- make.df.buildlink3(mklines, BUILDLINK3.MK)
+  lines       <- mklines.lines(mklines, conflicts, depends, buildlink3)
+
+  write(lines, 'Makefile')
 }
 
 create.Makefile <- function(metadata)
 {
-  if (arg.update && file.exists('Makefile.orig')) {
-    orig <- read.Makefile.as.dataframe('Makefile.orig')
-    update.Makefile(orig, metadata)
-  } else {
-    orig <- read.Makefile.as.dataframe(textConnection(''))
-    write.Makefile(orig, metadata)
-  }
+  if (arg.update && file.exists('Makefile.orig'))
+    update.Makefile(read_mklines('Makefile.orig'), metadata)
+  else
+    write.Makefile(read_mklines(textConnection('')), metadata)
 }
 
 create.DESCR <- function(metadata) {
diff --git a/pkgtools/R2pkg/files/R2pkg_test.R b/pkgtools/R2pkg/files/R2pkg_test.R
index 1b0fda4a374..2d65b41a1b6 100644
--- a/pkgtools/R2pkg/files/R2pkg_test.R
+++ b/pkgtools/R2pkg/files/R2pkg_test.R
@@ -1,4 +1,4 @@
-# $NetBSD: R2pkg_test.R,v 1.18 2019/10/19 19:10:31 rillig Exp $
+# $NetBSD: R2pkg_test.R,v 1.19 2019/10/19 21:12:18 rillig Exp $
 #
 # Copyright (c) 2019
 #	Roland Illig.  All rights reserved.
@@ -36,16 +36,19 @@ library(withr)
 arg.recursive <- FALSE
 arg.update <- FALSE
 
+original_wd <- getwd()
 package_dir <- file.path(Sys.getenv('PKGSRCDIR'), 'pkgtools', 'R2pkg')
 
-# don't use tabs in the output; see https://stackoverflow.com/q/58465177
+#' don't use tabs in the output; see https://stackoverflow.com/q/58465177
 expect_printed <- function(obj, ...) {
     out <- ''
-    with_output_sink(textConnection('out', 'w', local = TRUE), print(obj))
+    with_output_sink(textConnection('out', 'w', local = TRUE), {
+        print(obj, right = FALSE)
+    })
     exp <- c(...)
     if (! identical(out, exp)) {
-        write(out, 'R2pkg_test.out.txt')
-        write(exp, 'R2pkg_test.exp.txt')
+        write(out, file.path(original_wd, 'R2pkg_test.out.txt'))
+        write(exp, file.path(original_wd, 'R2pkg_test.exp.txt'))
     }
     expect_equal(length(out), length(exp))
     expect_equal(!!out, !!exp)
@@ -55,7 +58,7 @@ linesConnection <- function(...)
     textConnection(paste0(c(...), collapse = '\n'))
 
 make_mklines <- function(...)
-    read.Makefile.as.dataframe(linesConnection(...))
+    read_mklines(linesConnection(...))
 
 mocked_system <- function() {
     commands <- list()
@@ -143,11 +146,26 @@ test_that('varassign', {
     expect_equal(varassign('VAR', 'value'), 'VAR=\tvalue')
 })
 
+test_that('relpath_category', {
+    expect_equal(relpath_category('../../other/pkgbase'), 'other')
+    expect_equal(relpath_category('../../wip/pkgbase/Makefile'), 'wip')
+
+    expect_equal(
+        relpath_category(c(
+            '../../wip/pkgbase/Makefile',
+            '../../other/pkgbase')),
+        c(
+            'wip',
+            'other'))
+
+    # undefined behavior
+    expect_equal(relpath_category('..'), NA_character_)
+})
+
 test_that('adjacent.duplicates', {
     expect_equal(
-    adjacent.duplicates(c(1, 2, 2, 2, 3, 3, 4)),
-    c(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, FALSE)
-    )
+        adjacent.duplicates(c(1, 2, 2, 2, 3, 3, 4)),
+        c(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, FALSE))
 })
 
 test_that('paste2', {
@@ -173,26 +191,38 @@ test_that('as.sorted.list', {
     list('1', '1', '2', '3'))
 })
 
-test_that('read.file.as.dataframe', {
-    content <- linesConnection(
-        'VAR=value',
-        'VAR2=value2')
-
-    df <- read.file.as.dataframe(content)
+test_that('categorize.key_value', {
+    mklines <- make_mklines(
+        '\tPATH=/bin echo',
+        'DEPENDS+= R-ellipsis>=0:../../math/R-ellipsis',
+        '.include "../../math/R-ellipsis/buildlink3.mk"')
 
-    expect_equal(length(df$line), 2)
-    expect_equal(df$line[[1]], 'VAR=value')
-    expect_equal(df$line[[2]], 'VAR2=value2')
+    expect_printed(
+        data.frame(
+            key_value = mklines$key_value,
+            key = mklines$key,
+            old_value = mklines$old_value),
+        '  key_value key     old_value                          ',
+        '1 FALSE     <NA>    <NA>                               ',
+        '2  TRUE     DEPENDS R-ellipsis>=0:../../math/R-ellipsis',
+        '3 FALSE     <NA>    <NA>                               ')
 })
 
-# test_that('categorize.key_value', {
-# })
+test_that('categorize.depends', {
+    mklines <- make_mklines(
+        'DEPENDS+=\tR-ellipsis>=0:../../math/R-ellipsis',
+        '.include "../../math/R-ellipsis/buildlink3.mk"')
 
-# test_that('categorize.depends', {
-# })
+    expect_equal(mklines$depends, c(TRUE, FALSE))
+})
 
-# test_that('categorize.buildlink', {
-# })
+test_that('categorize.buildlink', {
+    mklines <- make_mklines(
+        'DEPENDS+=\tR-ellipsis>=0:../../math/R-ellipsis',
+        '.include "../../math/R-ellipsis/buildlink3.mk"')
+
+    expect_equal(mklines$buildlink3.mk, c(FALSE, TRUE))
+})
 
 test_that('fix.continued.lines', {
     message <- mocked_message()
@@ -232,7 +262,7 @@ test_that('fix.continued.lines, no continued lines', {
     expect_equal(mklines$line, rep('VAR= value',3))
 })
 
-test_that('read.Makefile.as.dataframe', {
+test_that('read_mklines', {
     mklines <- make_mklines(
         '# comment',
         'VAR= value',
@@ -242,20 +272,20 @@ test_that('read.Makefile.as.dataframe', {
         '.endif')
 
     expect_printed(mklines,
-        '                 line order category key_value  key depends buildlink3.mk',
-        '1           # comment     1       NA     FALSE <NA>   FALSE         FALSE',
-        '2          VAR= value     2       NA      TRUE  VAR   FALSE         FALSE',
-        '3                         3       NA     FALSE <NA>   FALSE         FALSE',
-        '4 .include "other.mk"     4       NA     FALSE <NA>   FALSE         FALSE',
-        '5               .if 0     5       NA     FALSE <NA>   FALSE         FALSE',
-        '6              .endif     6       NA     FALSE <NA>   FALSE         FALSE',
-        '  old_todo operator delimiter old_value',
-        '1     <NA>     <NA>      <NA>      <NA>',
-        '2                 =               value',
-        '3     <NA>     <NA>      <NA>      <NA>',
-        '4     <NA>     <NA>      <NA>      <NA>',
-        '5     <NA>     <NA>      <NA>      <NA>',
-        '6     <NA>     <NA>      <NA>      <NA>')
+        '  line                order key_value old_todo key  operator delimiter',
+        '1 # comment           1     FALSE     <NA>     <NA> <NA>     <NA>     ',
+        '2 VAR= value          2      TRUE              VAR  =                 ',
+        '3                     3     FALSE     <NA>     <NA> <NA>     <NA>     ',
+        '4 .include "other.mk" 4     FALSE     <NA>     <NA> <NA>     <NA>     ',
+        '5 .if 0               5     FALSE     <NA>     <NA> <NA>     <NA>     ',
+        '6 .endif              6     FALSE     <NA>     <NA> <NA>     <NA>     ',
+        '  old_value category depends buildlink3.mk',
+        '1 <NA>      NA       FALSE   FALSE        ',
+        '2 value     NA       FALSE   FALSE        ',
+        '3 <NA>      NA       FALSE   FALSE        ',
+        '4 <NA>      NA       FALSE   FALSE        ',
+        '5 <NA>      NA       FALSE   FALSE        ',
+        '6 <NA>      NA       FALSE   FALSE        ')
 })
 
 test_that('read.file.as.list can read an empty file', {
@@ -704,11 +734,11 @@ test_that('mklines.update_with_metadata with CATEGORIES', {
     updated <- mklines.update_with_metadata(df, metadata)
 
     expect_printed(data.frame(varname = updated$key, new_value = updated$new_value),
-        '     varname                   new_value',
-        '1 CATEGORIES                    pkgtools',
+        '  varname    new_value                  ',
+        '1 CATEGORIES pkgtools                   ',
         '2 MAINTAINER with-categories@example.org',  # FIXME: Should not always be reset.
-        '3    COMMENT             Package comment',
-        '4   R_PKGVER                        19.3')
+        '3 COMMENT    Package comment            ',
+        '4 R_PKGVER   19.3                       ')
 })
 
 # If the variable has been removed from the Makefile, it is not updated.
@@ -723,10 +753,10 @@ test_that('mklines.update_with_metadata without CATEGORIES', {
     updated <- mklines.update_with_metadata(df, metadata)
 
     expect_printed(data.frame(varname = updated$key, new_value = updated$new_value),
-        '     varname                      new_value',
+        '  varname    new_value                     ',
         '1 MAINTAINER without-categories@example.org',
-        '2    COMMENT                Package comment',
-        '3   R_PKGVER                           19.3')
+        '2 COMMENT    Package comment               ',
+        '3 R_PKGVER   19.3                          ')
 })
 
 test_that('mklines.update_value', {
@@ -821,18 +851,18 @@ test_that('mklines.reassign_order, reordered', {
         'R_PKGVER= 0.1')
 
     expect_printed(data.frame(varname = mklines$key, order = mklines$order),
-        '     varname order',
-        '1 CATEGORIES     1',
-        '2  R_PKGNAME     2',
-        '3   R_PKGVER     3')
+        '  varname    order',
+        '1 CATEGORIES 1    ',
+        '2 R_PKGNAME  2    ',
+        '3 R_PKGVER   3    ')
 
     updated <- mklines.reassign_order(mklines)
 
     expect_printed(data.frame(varname = updated$key, order = updated$order),
-        '     varname order',
-        '1 CATEGORIES   1.0',
-        '2  R_PKGNAME   0.8',
-        '3   R_PKGVER   0.9')
+        '  varname    order',
+        '1 CATEGORIES 1.0  ',
+        '2 R_PKGNAME  0.8  ',
+        '3 R_PKGVER   0.9  ')
 })
 
 test_that('conflicts', {
@@ -872,14 +902,15 @@ test_that('update.Makefile', {
             '',
             '.include "../../mk/bsd.pkg.mk"'),
         'Makefile.orig')
+    orig <- read_mklines('Makefile.orig')
     metadata <- make.metadata(linesConnection(
         'Package: pkgname',
         'Version: 1.0',
         'Depends: dep1 dep2(>=2.0)'))
     expect_printed(
         as.data.frame(metadata),
-        '  Package Version Title Description License Imports          Depends',
-        '1 pkgname     1.0  <NA>        <NA>    <NA>    <NA> dep1 dep2(>=2.0)')
+        '  Package Version Title Description License Imports Depends         ',
+        '1 pkgname 1.0     <NA>  <NA>        <NA>    <NA>    dep1 dep2(>=2.0)')
     expect_printed(metadata$Imports, '[1] NA')
     expect_printed(metadata$Depends, '[1] "dep1 dep2(>=2.0)"')
     expect_printed(
@@ -892,7 +923,7 @@ test_that('update.Makefile', {
         make.depends(metadata$Imports, metadata$Depends),
         '[1] "dep1"        "dep2(>=2.0)"')
 
-    FALSE && update.Makefile(metadata)  # FIXME
+    FALSE && update.Makefile(orig, metadata)  # FIXME
 
     FALSE && expect_equal(  # FIXME
         c(