[ { "path": ".Rbuildignore", "content": "^covr\\.Rproj$\n\\.tar\\.gz$\n^travis-tool\\.sh$\n^LICENSE\\.md$\n^covr\\.Rcheck$\n^\\.travis\\.yml$\n^shim_package\\.sh$\n^unshim_package\\.sh$\nMakefile\ndocker_checker\n_dev\\.R$\n^\\.lintr$\n^appveyor\\.yml$\n^wercker\\.yml$\n^\\.Rproj\\.user$\n^tests/testthat/.*/.*(o|sl|so|dylib|a|dll|def)$\n^covr.*$\n^cran_comments\\.md$\n^revdep/\n^cran-comments\\.md$\n^cache$\n^data.Rmd$\n^covr_performance.Rmd$\n^revdep$\n^CRAN-RELEASE$\n^docs$\n^_pkgdown\\.yml$\n^pkgdown$\n^script.R$\n^azure-pipelines\\.yml$\n^[.]github$\n^codecov\\.yml$\n^CODE_OF_CONDUCT\\.md$\n^\\.github$\n^SECURITY\\.md$\n^CRAN-SUBMISSION$\n" }, { "path": ".gitattributes", "content": "/NEWS.md merge=union\n" }, { "path": ".github/.gitignore", "content": "*.html\n" }, { "path": ".github/workflows/R-CMD-check.yaml", "content": "# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples\n# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help\n#\n# NOTE: This workflow is overkill for most R packages and\n# check-standard.yaml is likely a better choice.\n# usethis::use_github_action(\"check-standard\") will install it.\non:\n workflow_dispatch:\n push:\n branches: [main, master]\n pull_request:\n branches: [main, master]\n\nname: R-CMD-check\n\njobs:\n R-CMD-check:\n runs-on: ${{ matrix.config.os }}\n\n name: ${{ matrix.config.os }} (${{ matrix.config.r }})\n\n strategy:\n fail-fast: false\n matrix:\n config:\n - {os: macos-latest, r: 'release'}\n\n - {os: windows-latest, r: 'release'}\n # Use 3.6 to trigger usage of RTools35\n - {os: windows-latest, r: '3.6'}\n # use 4.1 to check with rtools40's older compiler\n - {os: windows-latest, r: '4.1'}\n\n - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}\n - {os: ubuntu-latest, r: 'release'}\n - {os: ubuntu-latest, r: 'oldrel-1'}\n - {os: ubuntu-latest, r: 'oldrel-2'}\n - {os: ubuntu-latest, r: 'oldrel-3'}\n - {os: ubuntu-latest, r: 'oldrel-4'}\n\n env:\n GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}\n R_KEEP_PKG_SOURCE: yes\n\n steps:\n - uses: actions/checkout@v3\n\n - uses: r-lib/actions/setup-pandoc@v2\n\n - uses: r-lib/actions/setup-r@v2\n with:\n r-version: ${{ matrix.config.r }}\n http-user-agent: ${{ matrix.config.http-user-agent }}\n use-public-rspm: true\n\n - uses: r-lib/actions/setup-r-dependencies@v2\n with:\n extra-packages: any::rcmdcheck\n needs: check\n\n - uses: r-lib/actions/check-r-package@v2\n with:\n upload-snapshots: true\n" }, { "path": ".github/workflows/pkgdown.yaml", "content": "# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples\n# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help\non:\n push:\n branches: [main, master]\n pull_request:\n branches: [main, master]\n release:\n types: [published]\n workflow_dispatch:\n\nname: pkgdown\n\njobs:\n pkgdown:\n runs-on: ubuntu-latest\n # Only restrict concurrency for non-PR jobs\n concurrency:\n group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}\n env:\n GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}\n permissions:\n contents: write\n steps:\n - uses: actions/checkout@v3\n\n - uses: r-lib/actions/setup-pandoc@v2\n\n - uses: r-lib/actions/setup-r@v2\n with:\n use-public-rspm: true\n\n - uses: r-lib/actions/setup-r-dependencies@v2\n with:\n extra-packages: any::pkgdown, local::.\n needs: website\n\n - name: Build site\n run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)\n shell: Rscript {0}\n\n - name: Deploy to GitHub pages 🚀\n if: github.event_name != 'pull_request'\n uses: JamesIves/github-pages-deploy-action@v4.4.1\n with:\n clean: false\n branch: gh-pages\n folder: docs\n" }, { "path": ".github/workflows/pr-commands.yaml", "content": "# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples\n# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help\non:\n issue_comment:\n types: [created]\n\nname: Commands\n\njobs:\n document:\n if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }}\n name: document\n runs-on: ubuntu-latest\n env:\n GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}\n steps:\n - uses: actions/checkout@v3\n\n - uses: r-lib/actions/pr-fetch@v2\n with:\n repo-token: ${{ secrets.GITHUB_TOKEN }}\n\n - uses: r-lib/actions/setup-r@v2\n with:\n use-public-rspm: true\n\n - uses: r-lib/actions/setup-r-dependencies@v2\n with:\n extra-packages: any::roxygen2\n needs: pr-document\n\n - name: Document\n run: roxygen2::roxygenise()\n shell: Rscript {0}\n\n - name: commit\n run: |\n git config --local user.name \"$GITHUB_ACTOR\"\n git config --local user.email \"$GITHUB_ACTOR@users.noreply.github.com\"\n git add man/\\* NAMESPACE\n git commit -m 'Document'\n\n - uses: r-lib/actions/pr-push@v2\n with:\n repo-token: ${{ secrets.GITHUB_TOKEN }}\n\n style:\n if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }}\n name: style\n runs-on: ubuntu-latest\n env:\n GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}\n steps:\n - uses: actions/checkout@v3\n\n - uses: r-lib/actions/pr-fetch@v2\n with:\n repo-token: ${{ secrets.GITHUB_TOKEN }}\n\n - uses: r-lib/actions/setup-r@v2\n\n - name: Install dependencies\n run: install.packages(\"styler\")\n shell: Rscript {0}\n\n - name: Style\n run: styler::style_pkg()\n shell: Rscript {0}\n\n - name: commit\n run: |\n git config --local user.name \"$GITHUB_ACTOR\"\n git config --local user.email \"$GITHUB_ACTOR@users.noreply.github.com\"\n git add \\*.R\n git commit -m 'Style'\n\n - uses: r-lib/actions/pr-push@v2\n with:\n repo-token: ${{ secrets.GITHUB_TOKEN }}\n" }, { "path": ".github/workflows/test-coverage.yaml", "content": "# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples\n# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help\non:\n push:\n branches: [main, master]\n pull_request:\n branches: [main, master]\n\nname: test-coverage\n\njobs:\n test-coverage:\n runs-on: ubuntu-latest\n env:\n GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}\n\n steps:\n - uses: actions/checkout@v3\n\n - uses: r-lib/actions/setup-r@v2\n with:\n use-public-rspm: true\n\n - uses: r-lib/actions/setup-r-dependencies@v2\n with:\n needs: coverage\n\n - name: Setup\n run: |\n R CMD INSTALL .\n source shim_package.sh\n\n - name: Test coverage\n run: |\n covr::codecov(\n quiet = FALSE,\n clean = FALSE,\n install_path = file.path(Sys.getenv(\"RUNNER_TEMP\"), \"package\")\n )\n shell: Rscript {0}\n\n - name: Show testthat output\n if: always()\n run: |\n ## --------------------------------------------------------------------\n find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \\; || true\n shell: bash\n\n - name: Upload test results\n if: failure()\n uses: actions/upload-artifact@v4\n with:\n name: coverage-test-failures\n path: ${{ runner.temp }}/package\n" }, { "path": ".gitignore", "content": "*.o\n*.so\ninst/doc\n.Rproj.user\ncovr.Rproj\ncache/\ndata.Rmd\nvignettes/covr_performance.Rmd\nrevdep/checks\nrevdep/library\ndocs/\nscript.R\n.Rhistory\n" }, { "path": ".lintr", "content": "linters: linters_with_defaults(line_length_linter(120))\nexclusions: list(\"inst/doc/how_it_works.R\")\n" }, { "path": "CODE_OF_CONDUCT.md", "content": "# Contributor Covenant Code of Conduct\n\n## Our Pledge\n\nWe as members, contributors, and leaders pledge to make participation in our\ncommunity a harassment-free experience for everyone, regardless of age, body\nsize, visible or invisible disability, ethnicity, sex characteristics, gender\nidentity and expression, level of experience, education, socio-economic status,\nnationality, personal appearance, race, caste, color, religion, or sexual\nidentity and orientation.\n\nWe pledge to act and interact in ways that contribute to an open, welcoming,\ndiverse, inclusive, and healthy community.\n\n## Our Standards\n\nExamples of behavior that contributes to a positive environment for our\ncommunity include:\n\n* Demonstrating empathy and kindness toward other people\n* Being respectful of differing opinions, viewpoints, and experiences\n* Giving and gracefully accepting constructive feedback\n* Accepting responsibility and apologizing to those affected by our mistakes,\n and learning from the experience\n* Focusing on what is best not just for us as individuals, but for the overall\n community\n\nExamples of unacceptable behavior include:\n\n* The use of sexualized language or imagery, and sexual attention or advances of\n any kind\n* Trolling, insulting or derogatory comments, and personal or political attacks\n* Public or private harassment\n* Publishing others' private information, such as a physical or email address,\n without their explicit permission\n* Other conduct which could reasonably be considered inappropriate in a\n professional setting\n\n## Enforcement Responsibilities\n\nCommunity leaders are responsible for clarifying and enforcing our standards of\nacceptable behavior and will take appropriate and fair corrective action in\nresponse to any behavior that they deem inappropriate, threatening, offensive,\nor harmful.\n\nCommunity leaders have the right and responsibility to remove, edit, or reject\ncomments, commits, code, wiki edits, issues, and other contributions that are\nnot aligned to this Code of Conduct, and will communicate reasons for moderation\ndecisions when appropriate.\n\n## Scope\n\nThis Code of Conduct applies within all community spaces, and also applies when\nan individual is officially representing the community in public spaces.\nExamples of representing our community include using an official e-mail address,\nposting via an official social media account, or acting as an appointed\nrepresentative at an online or offline event.\n\n## Enforcement\n\nInstances of abusive, harassing, or otherwise unacceptable behavior may be\nreported to the community leaders responsible for enforcement at james.f.hester@gmail.com. \nAll complaints will be reviewed and investigated promptly and fairly.\n\nAll community leaders are obligated to respect the privacy and security of the\nreporter of any incident.\n\n## Enforcement Guidelines\n\nCommunity leaders will follow these Community Impact Guidelines in determining\nthe consequences for any action they deem in violation of this Code of Conduct:\n\n### 1. Correction\n\n**Community Impact**: Use of inappropriate language or other behavior deemed\nunprofessional or unwelcome in the community.\n\n**Consequence**: A private, written warning from community leaders, providing\nclarity around the nature of the violation and an explanation of why the\nbehavior was inappropriate. A public apology may be requested.\n\n### 2. Warning\n\n**Community Impact**: A violation through a single incident or series of\nactions.\n\n**Consequence**: A warning with consequences for continued behavior. No\ninteraction with the people involved, including unsolicited interaction with\nthose enforcing the Code of Conduct, for a specified period of time. This\nincludes avoiding interactions in community spaces as well as external channels\nlike social media. Violating these terms may lead to a temporary or permanent\nban.\n\n### 3. Temporary Ban\n\n**Community Impact**: A serious violation of community standards, including\nsustained inappropriate behavior.\n\n**Consequence**: A temporary ban from any sort of interaction or public\ncommunication with the community for a specified period of time. No public or\nprivate interaction with the people involved, including unsolicited interaction\nwith those enforcing the Code of Conduct, is allowed during this period.\nViolating these terms may lead to a permanent ban.\n\n### 4. Permanent Ban\n\n**Community Impact**: Demonstrating a pattern of violation of community\nstandards, including sustained inappropriate behavior, harassment of an\nindividual, or aggression toward or disparagement of classes of individuals.\n\n**Consequence**: A permanent ban from any sort of public interaction within the\ncommunity.\n\n## Attribution\n\nThis Code of Conduct is adapted from the [Contributor Covenant][homepage],\nversion 2.1, available at\n.\n\nCommunity Impact Guidelines were inspired by\n[Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion].\n\nFor answers to common questions about this code of conduct, see the FAQ at\n. Translations are available at .\n\n[homepage]: https://www.contributor-covenant.org\n" }, { "path": "DESCRIPTION", "content": "Encoding: UTF-8\nPackage: covr\nTitle: Test Coverage for Packages\nVersion: 3.6.5.9001\nAuthors@R: c(\n person(\"Jim\", \"Hester\", email = \"james.f.hester@gmail.com\", role = c(\"aut\", \"cre\")),\n person(\"Willem\", \"Ligtenberg\", role = \"ctb\"),\n person(\"Kirill\", \"Müller\", role = \"ctb\"),\n person(\"Henrik\", \"Bengtsson\", role = \"ctb\"),\n person(\"Steve\", \"Peak\", role = \"ctb\"),\n person(\"Kirill\", \"Sevastyanenko\", role = \"ctb\"),\n person(\"Jon\", \"Clayden\", role = \"ctb\"),\n person(\"Robert\", \"Flight\", role = \"ctb\"),\n person(\"Eric\", \"Brown\", role = \"ctb\"),\n person(\"Brodie\", \"Gaslam\", role = \"ctb\"),\n person(\"Will\", \"Beasley\", role = \"ctb\"),\n person(\"Robert\", \"Krzyzanowski\", role = \"ctb\"),\n person(\"Markus\", \"Wamser\", role = \"ctb\"),\n person(\"Karl\", \"Forner\", role = \"ctb\"),\n person(\"Gergely\", \"Daróczi\", role = \"ctb\"),\n person(\"Jouni\", \"Helske\", role = \"ctb\"),\n person(\"Kun\", \"Ren\", role = \"ctb\"),\n person(\"Jeroen\", \"Ooms\", role = \"ctb\"),\n person(\"Ken\", \"Williams\", role = \"ctb\"),\n person(\"Chris\", \"Campbell\", role = \"ctb\"),\n person(\"David\", \"Hugh-Jones\", role = \"ctb\"),\n person(\"Qin\", \"Wang\", role = \"ctb\"),\n person(\"Doug\", \"Kelkhoff\", role = \"ctb\"),\n person(\"Ivan\", \"Sagalaev\", role = c(\"ctb\", \"cph\"), comment = \"highlight.js library\"),\n person(\"Mark\", \"Otto\", role = \"ctb\", comment = \"Bootstrap library\"),\n person(\"Jacob\", \"Thornton\", role = \"ctb\", comment = \"Bootstrap library\"),\n person(family = \"Bootstrap contributors\", role = \"ctb\", comment = \"Bootstrap library\"),\n person(family = \"Twitter, Inc\", role = \"cph\", comment = \"Bootstrap library\")\n )\nDescription: Track and report code coverage for your package and (optionally)\n upload the results to a coverage service like 'Codecov' or\n 'Coveralls' . Code coverage is a measure of the amount of\n code being exercised by a set of tests. It is an indirect measure of test\n quality and completeness. This package is compatible with any testing\n methodology or framework and tracks coverage of both R code and compiled\n C/C++/FORTRAN code.\nURL: https://covr.r-lib.org, https://github.com/r-lib/covr\nBugReports: https://github.com/r-lib/covr/issues\nDepends:\n R (>= 3.1.0),\n methods\nImports:\n digest,\n stats,\n utils,\n jsonlite,\n rex,\n httr,\n cli,\n withr (>= 1.0.2),\n yaml\nSuggests:\n R6,\n S7 (>= 0.2.0),\n curl,\n knitr,\n rmarkdown,\n htmltools,\n DT (>= 0.2),\n testthat (>= 3.0.0),\n rlang,\n rstudioapi (>= 0.2),\n xml2 (>= 1.0.0),\n parallel,\n memoise,\n covr,\n box (>= 1.2.0)\nLicense: MIT + file LICENSE\nVignetteBuilder: knitr\nRoxygenNote: 7.3.3\nRoxygen: list(markdown = TRUE)\nConfig/testthat/edition: 3\nConfig/testthat/parallel: TRUE\n" }, { "path": "LICENSE", "content": "YEAR: 2022\nCOPYRIGHT HOLDER: covr authors\n" }, { "path": "LICENSE.md", "content": "# MIT License\n\nCopyright (c) 2022 covr authors\n\nPermission is hereby granted, free of charge, to any person obtaining a copy\nof this software and associated documentation files (the \"Software\"), to deal\nin the Software without restriction, including without limitation the rights\nto use, copy, modify, merge, publish, distribute, sublicense, and/or sell\ncopies of the Software, and to permit persons to whom the Software is\nfurnished to do so, subject to the following conditions:\n\nThe above copyright notice and this permission notice shall be included in all\ncopies or substantial portions of the Software.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\nIMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\nFITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE\nAUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER\nLIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,\nOUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE\nSOFTWARE.\n" }, { "path": "Makefile", "content": "RCHECKER=docker_checker\nFILTER=\n\n# to install test packages, code must be compiled inside src/ dir, \n# that may cause problems for docker user docker\n# so we grant all permissions\nfix-permission-tests:\n\tchmod -R a+rwx tests\n\n\nbuild-docker-checker:\n\tdocker build -t $(RCHECKER) docker_checker\n\nrun-rocker: build-docker-checker\n\t-docker rm $(RCHECKER)\n\tdocker run --rm -ti -v $(PWD)/..:/home/docker $(RCHECKER) bash\n\t\ntest: build-docker-checker fix-permission-tests\n\tdocker run --rm -ti -v $(PWD)/..:/home/docker $(RCHECKER) Rscript -e 'library(devtools);install(\"covr\");test(\"covr\", \"$(FILTER)\")'\n\n\ncheck: build-docker-checker fix-permission-tests\n\tdocker run --rm -ti -v $(PWD)/..:/home/docker $(RCHECKER) Rscript -e 'library(devtools);install(\"covr\");devtools::check(\"covr\")'\n\n\nrox: build-docker-checker\n\tdocker run --rm -ti -v $(PWD)/..:/home/docker $(RCHECKER) Rscript -e 'devtools::document(\"covr\")'\n" }, { "path": "NAMESPACE", "content": "# Generated by roxygen2: do not edit by hand\n\nS3method(\"[\",coverage)\nS3method(as.data.frame,coverage)\nS3method(markers,coverage)\nS3method(markers,coverages)\nS3method(markers,data.frame)\nS3method(merge_coverage,character)\nS3method(merge_coverage,list)\nS3method(print,coverage)\nS3method(print,coverages)\nS3method(value,coverage)\nS3method(value,expression_coverage)\nS3method(value,expression_coverages)\nS3method(value,line_coverage)\nS3method(value,line_coverages)\nexport(azure)\nexport(code_coverage)\nexport(codecov)\nexport(coverage_to_list)\nexport(coveralls)\nexport(display_name)\nexport(environment_coverage)\nexport(file_coverage)\nexport(file_report)\nexport(function_coverage)\nexport(gitlab)\nexport(in_covr)\nexport(package_coverage)\nexport(percent_coverage)\nexport(report)\nexport(tally_coverage)\nexport(to_cobertura)\nexport(to_sonarqube)\nexport(value)\nexport(zero_coverage)\nimport(methods)\nimportFrom(httr,RETRY)\nimportFrom(httr,content)\nimportFrom(httr,upload_file)\nimportFrom(stats,aggregate)\nimportFrom(stats,na.omit)\nimportFrom(stats,na.pass)\nimportFrom(stats,setNames)\nimportFrom(utils,capture.output)\nimportFrom(utils,getParseData)\nimportFrom(utils,getSrcDirectory)\nimportFrom(utils,getSrcFilename)\nimportFrom(utils,getSrcref)\nimportFrom(utils,head)\nimportFrom(utils,relist)\nimportFrom(utils,str)\nimportFrom(utils,tail)\nuseDynLib(covr, .registration = TRUE)\n" }, { "path": "NEWS.md", "content": "# covr (development version)\n\n* Fix a rare edge case where `count_test` was called before `.current_test` has\n been initialized leading to crash (@maksymiuks, #631).\n\n* Fix rare error in `clean_coverage_tests` where `NA` were being compared\n in `if` condition (@maksymiuks, #631).\n\n# covr 3.6.5\n\n## New Features and improvements\n\n* Added support for `klmr/box` modules. This works best with `file_coverage()`. (@radbasa, #491)\n\n* Performance improvement for compiled code with a lot of compilation units (@krlmlr, #611)\n\n* Fix R CMD check NOTE for upcoming R 4.6: non-API calls to SET_BODY, SET_CLOENV, SET_FORMALS (@t-kalinowski, #587)\n\n## Fixes and minor improvements\n\n* Messages are now displayed using cli instead of crayon (@olivroy, #591).\n\n* covr now uses `testthat::with_mocked_bindings()` for its internal testing (@olivroy, #595).\n\n* Fix a bug preventing `package_coverage()` from running tests when `install_path` is set to a relative path (@gergness, #517, #548).\n\n* Fixed a performance regression and an error triggered by a change in R\n 4.4.0. (@kyleam, #588)\n\n* Fixed an issue where attempting to generate code coverage on an already-loaded\n package could fail on Windows. (@kevinushey, #574)\n\n* Prevent `covr.record_tests` option from logging duplicate tests when the same\n line of testing code is hit repeatedly, as in a loop. (@dgkf, #528)\n\n* Normalize `install_path` path before creating directory to prevent\n failures when running covr in a subprocess using a path with Windows \n `\\\\` path separators. (@maksymiuks, #592)\n\n# covr 3.6.4\n\n* Fix for a failing test on CRAN\n\n# covr 3.6.3\n\n* Updates to internal usage of `is.atomic()` to work with upcoming R release (@mmaechler , #542)\n\n* `package_coverage()` now works correctly with ignore files when it is not run in the package root directory (@mpadge, #538)\n\n# covr 3.6.2\n\n# covr 3.6.1\n\n* `to_cobertura()` is now explicit about the doctype of the resulting XML. It also sets a source path if recorded. (@mmyrte, #524)\n\n* The internal generic `merge_coverage()` now correctly registers the S3 methods.\n\n* The internal test for recording large calls no longer assumes R is on the system PATH.\n\n# covr 3.6.0\n\n* Added `covr.record_tests` option. When `TRUE`, this enables the recording of the trace of the tests being executed and adds an itemization of which tests result in the execution of each trace.\n For more details see `?covr.record_tests` (@dgkf, #463, #485, #503)\n\n* `as.data.frame()` now returns an 0 row data frame when there are no functions in a package (#427)\n\n* `codecov()` is now more robust when `coverage` is not the output from `package_coverage()` and `token` is not provided (#456)\n\n* `package_coverage(code = )` now accepts character vectors of length greater than 1 (@bastistician, #481)\n\n* `package_coverage()` now handles packages with install or render time examples (#488)\n\n* `package_coverage()` now sets the environment variable `R_TESTS` to the tests-startup.R file like R CMD check does (#420)\n\n* `report()` now provides a more detailed error message if the `DT` and `htmltools` dependencies are not installed (#500).\n\n* Fix `parse_gcov` bug when package is stored in directory with regex special characters, see #459\n\n* Error/warning thrown for, respectively, missing gcov or empty parsed gcov output (@stephematician, #448)\n\n* Support Google Cloud Build uploading reports to Codecov.io (@MarkEdmondson1234 #469)\n\n* covr is now licensed as MIT (#454)\n\n# covr 3.5.1\n\n* Generated files from [cpp11](https://cpp11.r-lib.org/) are now ignored (#437)\n\n* `codecov()` and `coveralls()` now retry failed requests before raising an error (#428, @jameslamb)\n\n# covr 3.5.0\n\n* `codecov()` now supports GitHub Actions for public repositories without having to specify a token.\n\n* New `to_sonarqube()` function added to support SonarQube generic XML format (@nibant, @Delfic, #413).\n\n# covr 3.4.0\n\n* `codecov()` now supports GitHub Actions.\n\n* New `in_covr()` function added to return true if code is being run by covr (#407).\n\n* `file_coverage()`, `environment_coverage()` and `function_coverage()` now set\n `R_COVR=true`, to be consistent with `package_coverage()` (#407)\n\n# covr 3.3.2\n\n* Fix test failures in the development version of R (4.0.0) (#400)\n\n# covr 3.3.1\n\n* Fix inadvertent regression in return visibility when functions are covered.\n covr versions prior to 3.3.0 surrounded each statement in `{` blocks. covr\n 3.3.0 switched to using `({`, but this caused an inadvertent regression, as\n `(` will make the result visible it is the last expression in a function.\n Using `if (TRUE) {` restores the previous behavior. (#391, #392)\n\n# covr 3.3.0\n\n## New Features\n\n* New `azure()` function added to make it easy to use covr on [Azure\n Pipelines](https://azure.microsoft.com/en-us/products/devops/pipelines/)\n (#370)\n\n* Work around issues related to the new curly curly syntax in rlang (#379, #377, rlang#813)\n\n* Compiled code coverage has been improved, in particular C++ templates now\n contain the merged coverage of all template instances, even if the instances\n were defined in separate compilation units. (#390)\n\n## Bugfixes and minor improvements\n\n* `codecov()` now includes support for the flags field (#365)\n* `codecov` now looks `codecov.yml` for token if `CODECOV_TOKEN` envvar is not\n set (@MishaCivey #349).\n* `per_line()` now does not track lines with only punctuation such as `}` or `{` (#387)\n* `tally_coverage()` now includes compiled code, like it did previously (#384)\n\n* Define the necessary coverage flags for C++14, C++17 and C++20 (#369).\n\n* `to_cobertura()` now works with Cobertura coverage-04.dtd (@samssann, #337).\n\n* [R6](https://github.com/r-lib/R6) class generators prefixed with `.` are now\n included in coverage results (@jameslamb, #356).\n\n* `package_coverage()` gains option `pre_clean`, set to `FALSE` to disable\n cleaning of existing objects before running `package_coverage()` (@jpritikin, #375)\n\n# 3.2.1\n\n* Fix for regression when testing coverage of packages using mclapply (#335).\n\n# 3.2.0\n\n## Breaking changes\n\n* Previously deprecated `shine()` has been removed. Instead use `report()`.\n\n## New Features\n\n* `file_report()` added when viewing coverage for a single file (#308).\n\n* `display_name()` is now exported, which can be useful to filter the coverage\n object by filename.\n\n* `environment_coverage()` added, mainly so it can be used for `devtools::test_coverage_file()`.\n\n* `gitlab()` function added to create a coverage report for GitLab using\n GitLab's internal pages (@surmann, #327, #331).\n\n* The (optional) dependency on shiny has been removed. `report()` can now be\n built with only DT and htmltools installed.\n\n## Bugfixes and minor improvements\n\n* Fix for gcc-8 gcov output producing lines with no coverage counts in them (#328)\n\n* `impute_srcref()` now handles `...` and drop through arguments in switch\n statements (#325).\n\n* `tally_coverage()` now avoids an error when there are NA values in the source\n references (#322).\n\n* `covr(clean = TRUE)` now cleans the temporary library as well (#144)\n\n* `package_coverage()` now returns the end of the file if there is a test error (#319)\n\n* `report()` now handles reports in relative paths with subdirectories correctly (#329)\n\n* `report()` reworked to look more like codecov.io and to display the overall\n coverage (#302, #307).\n\n* DT explicitly loaded early in `report()` so that failures will occur fast if\n it is not installed. (#321, @renkun-ken).\n\n# 3.1.0 #\n\n## Breaking changes\n\n* `shine()` has been deprecated in favor of `report()`.\n\n## New Features\n\n* Add support for `.covrignore` files (#238), to exclude files from the coverage.\n\n* Support future versions of R which do not use parse data by default (#309).\n\n* Allow using `trace_calls()` for manually adding functions to package trace\n that are not found automatically (#295, @mb706).\n\n## Bugfixes\n\n* Fix errors when R is not in the `PATH` (#291)\n\n* Fix line computations when relative paths are being used (#242).\n\n* Fix for Coveralls `Build processing error.` (#285) on pro accounts from\n Travis CI (#306, @kiwiroy).\n\n* Keep attributes of function bodies (#311, @gaborcsardi)\n\n# 3.0.1 #\n* Add an RStudio Addin for running a coverage report.\n\n* Never use mcexit fix on windows (#223).\n\n* Fix for a performance regression in parsing and reading parse data (#274).\n\n* Fix `switch` support for packages, which was broken due to a bug in\n how parse data is stored in packages.\n\n* Improve behavior of `switch` coverage, it now supports default values and\n fall through properly.\n\n* Add `-p` flag to gcov command to preserve file paths. Fixes a bug where\n gcov output didn't get reported when multiple compiled source files had\n the same name (#271, @patperry)\n\n# 3.0.0 #\n* The covr license has been changed to GPL-3.\n* Set environment variable `R_COVR=true` when covr is running (#236, #268).\n* Made the gather-and-merge-results step at the end of package_coverage() more memory efficient (#226, @HenrikBengtsson).\n* Support code coverage with icc (#247, @QinWang).\n\n# 2.2.2 #\n* `filter_not_package_files()` now works if a source reference does not have a filename (#254, @hughjonesd).\n* Fix test broken with xml2 v1.1.0\n* Filter out non-local filenames from results (#237).\n* Vignette rewrite / improvements (#229, @CSJCampbell).\n* Fix code that returns `structure(NULL, *)` which is deprecated in R 3.4.0 (#260, #261, @renkun-ken).\n\n# 2.2.1 #\n* Fix test broken with DT 0.2\n\n# 2.2.0 #\n* Fix tests broken with updated htmlwidgets\n* Change report tab title based on filename (Chen Liang).\n* Add support for cobertura XML output (@wligtenberg).\n* Add mcparallel support by patching `mcparallel:::mcexit()`\n automatically for packages using parallel (#195, @kforner).\n\n# 2.1.0 #\n* Add support for GitLab CI (#190, @enbrown).\n* Update exclusion documentation to include line_exclusions and function\n exclusions (#191).\n* Support coverage of R6 methods (#174).\n* Explicitly set default packages (including methods) (#183, #180)\n* Set R_LIBS and R_LIBS_SITE as well as R_LIBS_USER (#188).\n* Automatically exclude RcppExport files (#170).\n* Memoised and Vectorized functions now able to be tracked.\n\n# 2.0.1 #\n* Support for filtering by function as well as line.\n* Now tracks coverage for RC methods\n* Rewrote loading and saving to support parallel code and tests including\n `quit()` calls.\n* Made passing code to `function_coverage()` and `package_coverage()` _not_ use\n non-standard evaluation.\n* `NULL` statements are analyzed for coverage (#156, @krlmlr).\n* Finer coverage analysis for brace-less `if`, `while` and `for` statements (#154, @krlmlr).\n* Run any combination of coverage types (#104, #133)\n* Remove inconsistencies in line counts between shiny app and services (#129)\n* Include header files in gcov output (#112)\n* Add support for C++11 (#131)\n* Always clean gcov files even on failure (#108)\n* zero_coverage works with RStudio markers (#119)\n* Remove the devtools dependency\n\n# 1.3.0 #\n* Set `.libPaths()` in subprocess to match those in calling process (#140, #147).\n* Move devtools dependency to suggests, only needed on windows\n* move htmltools to suggests\n\n# 1.0.0 #\n* Initial Release\n" }, { "path": "R/R6.R", "content": "replacements_R6 <- function(env) {\n unlist(recursive = FALSE, eapply(env, all.names = TRUE,\n function(obj) {\n if (inherits(obj, \"R6ClassGenerator\")) {\n traverse_R6(obj, env)\n }\n }))\n}\n\ntraverse_R6 <- function(obj, env) {\n unlist(recursive = FALSE, eapply(obj,\n function(o) {\n if (inherits(o, \"list\")) {\n lapply(names(o),\n function(f_name) {\n f <- get(f_name, o)\n if (inherits(f, \"function\")) {\n replacement(f_name, env = env, target_value = f)\n }\n })\n }\n }))\n}\n" }, { "path": "R/RC.R", "content": "replacements_RC <- function(env) {\n pat <- paste0(\"^\", classMetaName(\"\"))\n unlist(recursive = FALSE, lapply(ls(env, pattern = pat, all.names = TRUE),\n function(name) {\n class <- get(name, env)\n if (extends(class, \"envRefClass\")) {\n lapply(ls(class@refMethods, all.names = TRUE), replacement, env = class@refMethods)\n }\n }))\n}\n" }, { "path": "R/S4.R", "content": "replacements_S4 <- function(env) {\n generics <- getGenerics(env)\n\n unlist(recursive = FALSE,\n Map(generics@.Data, generics@package, USE.NAMES = FALSE,\n f = function(name, package) {\n what <- methodsPackageMetaName(\"T\", paste(name, package, sep = \":\"))\n\n table <- get(what, envir = env)\n\n lapply(ls(table, all.names = TRUE), replacement, env = table)\n })\n )\n}\n" }, { "path": "R/S7.R", "content": "replacements_S7 <- function(env) {\n bindings <- unlist(recursive = FALSE, use.names = FALSE, eapply(env, all.names = TRUE,\n function(obj) {\n if (inherits(obj, \"S7_generic\")) {\n traverse_S7_generic(obj)\n } else if (inherits(obj, \"S7_class\")) {\n traverse_S7_class(obj)\n }\n }))\n\n S7_methods_tbl <- attr(env[[\".__S3MethodsTable__.\"]], \"S7methods\", exact = TRUE)\n external_methods <- lapply(seq_along(S7_methods_tbl), function(i) {\n entry <- S7_methods_tbl[[i]]\n name <- external_generic_method_signature(entry$generic, entry$signature)\n\n replacement(\n # `name` is for informative printouts only.\n # It is not used by covr, and does not need to be unique,\n name = name,\n env = entry,\n target_value = entry$method)\n })\n\n c(bindings, external_methods)\n}\n\ntraverse_S7_generic <- function(x) {\n # Each binding in the environment at x@methods is either a function or, for\n # generics that dispatch on multiple arguments, another environment.\n get_replacements <- function(env) {\n replacements <- lapply(names(env), function(name) {\n target_value <- get(name, envir = env)\n if (is.environment(target_value)) {\n # Recurse for nested environments\n get_replacements(target_value)\n } else {\n name <- as.character(attr(target_value, \"name\", exact = TRUE) %||% name)\n list(replacement(name, env, target_value))\n }\n })\n unlist(replacements, recursive = FALSE, use.names = FALSE)\n }\n get_replacements(S7::prop(x, \"methods\"))\n}\n\ntraverse_S7_class <- function(x) {\n class_name <- S7::prop(x, \"name\")\n prop_fun_replacements <-\n lapply(S7::prop(x, \"properties\"), function(p) {\n lapply(c(\"getter\", \"setter\", \"validator\"), function(prop_fun) {\n if (!is.null(p[[prop_fun]])) {\n replacement(\n sprintf(\"%s@properties$%s$%s\", class_name, p$name, prop_fun),\n env = p,\n target_value = p[[prop_fun]])\n }\n })\n })\n prop_fun_replacements <- unlist(prop_fun_replacements, recursive = FALSE, use.names = FALSE)\n\n c(\n list(\n replacement(paste0(class_name, \"@constructor\"), env = x, target_value = S7::prop(x, \"constructor\")),\n replacement(paste0(class_name, \"@validator\") , env = x, target_value = S7::prop(x, \"validator\"))\n ),\n prop_fun_replacements\n )\n}\n\n\nexternal_generic_method_signature <- function(generic, signature) {\n # This function is a lightly modified copy of S7:::method_signature() for external generics\n display_generic <- paste0(c(generic$package, generic$name), collapse = \"::\")\n class_deparse <- asNamespace(\"S7\")$class_deparse # not exported from S7 :/\n single <- length(generic$dispatch_args) == 1\n if (single) {\n signature <- class_deparse(signature[[1]])\n } else {\n classes <- vapply(signature, class_deparse, \"\", USE.NAMES = FALSE)\n signature <- paste0(\"list(\", paste0(classes, collapse = \", \"), \")\")\n }\n\n sprintf(\"method(%s, %s)\", display_generic, signature)\n}\n" }, { "path": "R/azure.R", "content": "#' Run covr on a package and output the result so it is available on Azure Pipelines\n#' @inheritParams codecov\n#' @inheritParams to_cobertura\n#' @export\nazure <- function(\n ...,\n coverage = package_coverage(..., quiet = quiet), filename = \"coverage.xml\", quiet = TRUE) {\n\n to_cobertura(coverage, filename = filename)\n}\n" }, { "path": "R/box.R", "content": "replacements_box <- function(env) {\n unlist(recursive = FALSE, eapply(env, all.names = TRUE,\n function(obj) {\n if (inherits(attr(obj, \"spec\"), \"box$mod_spec\")) {\n obj_impl <- attr(obj, \"namespace\")\n compact(\n c(\n lapply(ls(obj_impl),\n function(f_name) {\n f <- get(f_name, obj_impl)\n if (inherits(f, \"function\")) {\n replacement(f_name, env = obj, target_value = f)\n }\n }\n ),\n unlist(recursive = FALSE,\n lapply(ls(obj_impl),\n function(f_name) {\n f <- get(f_name, obj_impl)\n if (inherits(f, \"R6ClassGenerator\")) {\n traverse_R6(f, obj)\n }\n }\n )\n )\n )\n )\n }\n }\n )\n )\n}\n" }, { "path": "R/cobertura.R", "content": "#' Create a Cobertura XML file\n#'\n#' Create a\n#' cobertura-compliant XML report following [this\n#' DTD](https://github.com/cobertura/cobertura/blob/master/cobertura/src/site/htdocs/xml/coverage-04.dtd).\n#' Because there are _two_ DTDs called `coverage-04.dtd` and some tools do not seem to\n#' adhere to either of them, the parser you're using may balk at the file. Please see\n#' [this github discussion](https://github.com/cobertura/cobertura/issues/425) for\n#' context. Where `covr` doesn't provide a coverage metric (branch coverage,\n#' complexity), a zero is reported.\n#'\n#' *Note*: This functionality requires the xml2 package be installed.\n#'\n#' @param cov the coverage object returned from [package_coverage()]\n#' @param filename the name of the Cobertura XML file\n#' @export\nto_cobertura <- function(cov, filename = \"cobertura.xml\") {\n\n loadNamespace(\"xml2\")\n\n df <- tally_coverage(cov, by = \"line\")\n percent_overall <- percent_coverage(df, by = \"line\") / 100\n percent_per_file <- tapply(df$value, df$filename, FUN = function(x) (sum(x > 0) / length(x)))\n percent_per_function <- tapply(df$value, df$functions, FUN = function(x) (sum(x > 0) / length(x)))\n lines_valid <- nrow(df)\n lines_covered <- sum(df$value > 0)\n\n d <- xml2::xml_new_document()\n\n xml2::xml_add_child(d, xml2::xml_dtd(\n name = \"coverage\",\n system_id = \"https://raw.githubusercontent.com/cobertura/cobertura/master/cobertura/src/site/htdocs/xml/coverage-04.dtd\"\n ))\n top <- xml2::xml_add_child(d,\n \"coverage\",\n \"line-rate\" = as.character(percent_overall),\n \"branch-rate\" = \"0\",\n `lines-covered` = as.character(lines_covered),\n `lines-valid` = as.character(lines_valid),\n `branches-covered` = \"0\",\n `branches-valid` = \"0\",\n complexity = 0,\n version = as.character(utils::packageVersion(\"covr\")),\n timestamp = as.character(Sys.time()))\n\n # Add sources\n sources <- xml2::xml_add_child(top, \"sources\")\n source_pth <- attr(cov, \"package\")$path %||% attr(cov, \"root\")\n if (!is.null(source_pth)) {\n xml2::xml_add_child(sources, \"source\", xml2::xml_cdata(source_pth))\n }\n\n files <- unique(df$filename)\n #for (f in files){\n #xml2::xml_add_child(sources, \"source\", f)\n #}\n\n # Add packages\n packages <- xml2::xml_add_child(top, \"packages\")\n package <- xml2::xml_add_child(packages, \"package\",\n name = attr(cov, \"package\")$package,\n \"line-rate\" = as.character(percent_overall),\n \"branch-rate\" = \"0\",\n complexity = \"0\")\n\n classes <- xml2::xml_add_child(package, \"classes\")\n\n # Add classes (for which we will use files for now)\n for (f in files){\n class <- xml2::xml_add_child(classes, \"class\",\n name = basename(f),\n filename = f,\n \"line-rate\" = as.character(percent_per_file[f]),\n \"branch-rate\" = \"0\",\n complexity = \"0\")\n\n # Add methods for all lines with functions\n methods <- xml2::xml_add_child(class, \"methods\")\n\n for (fun_name in unique(na.omit(df[df$filename == f, \"functions\"]))) {\n fun <- xml2::xml_add_child(methods, \"method\",\n name = fun_name,\n signature = \"\",\n \"line-rate\" = as.character(percent_per_function[fun_name]),\n \"branch-rate\" = \"0\",\n \"complexity\" = \"0\")\n\n # Add lines\n lines <- xml2::xml_add_child(fun, \"lines\")\n fun_lines <- which(df$functions == fun_name)\n for (i in fun_lines){\n line <- df[i, ]\n xml2::xml_add_child(lines, \"line\",\n number = as.character(line$line),\n hits = as.character(line$value),\n branch = \"false\")\n }\n }\n\n # Add lines for \"class\"\n class_lines <- xml2::xml_add_child(class, \"lines\")\n file_lines <- which(df$filename == f)\n for (i in file_lines) {\n line <- df[i, ]\n xml2::xml_add_child(class_lines, \"line\",\n number = as.character(line$line),\n hits = as.character(line$value),\n branch = \"false\")\n }\n }\n\n xml2::write_xml(d, file = filename)\n\n invisible(d)\n}\n" }, { "path": "R/codecov.R", "content": "#' Run covr on a package and upload the result to codecov.io\n#' @param coverage an existing coverage object to submit, if `NULL`,\n#' [package_coverage()] will be called with the arguments from\n#' `...`\n#' @param ... arguments passed to [package_coverage()]\n#' @param base_url Codecov url (change for Enterprise)\n#' @param quiet if `FALSE`, print the coverage before submission.\n#' @param token a codecov upload token, if `NULL` then following external\n#' sources will be checked in this order:\n#' 1. the environment variable \\sQuote{CODECOV_TOKEN}. If it is empty, then\n#' 1. package will look at directory of the package for a file `codecov.yml`.\n#' File must have `codecov` section where field `token` is set to a token that\n#' will be used.\n#' @param commit explicitly set the commit this coverage result object\n#' corresponds to. Is looked up from the service or locally if it is\n#' `NULL`.\n#' @param branch explicitly set the branch this coverage result object\n#' corresponds to, this is looked up from the service or locally if it is\n#' `NULL`.\n#' @param pr explicitly set the pr this coverage result object corresponds to,\n#' this is looked up from the service if it is `NULL`.\n#' @param flags A flag to use for this coverage upload see\n#' for details.\n#' @export\n#' @examples\n#' \\dontrun{\n#' codecov(path = \"test\")\n#' }\ncodecov <- function(...,\n coverage = NULL,\n base_url = \"https://codecov.io\",\n token = NULL,\n commit = NULL,\n branch = NULL,\n pr = NULL,\n flags = NULL,\n quiet = TRUE) {\n\n if (is.null(coverage)) {\n coverage <- package_coverage(quiet = quiet, ...)\n }\n\n if (!quiet) {\n print(coverage)\n }\n\n # -------\n # Jenkins\n # -------\n if (Sys.getenv(\"JENKINS_URL\") != \"\") {\n # https://wiki.jenkins-ci.org/display/JENKINS/Building+a+software+project\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(service = \"jenkins\",\n branch = branch %||% Sys.getenv(\"GIT_BRANCH\"),\n commit = commit %||% Sys.getenv(\"GIT_COMMIT\"),\n build = Sys.getenv(\"BUILD_NUMBER\"),\n build_url = utils::URLencode(Sys.getenv(\"BUILD_URL\")))\n # ---------\n # Travis CI\n # ---------\n } else if (Sys.getenv(\"CI\") == \"true\" && Sys.getenv(\"TRAVIS\") == \"true\") {\n # https://docs.travis-ci.com/user/environment-variables/#Default-Environment-Variables\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(branch = branch %||% Sys.getenv(\"TRAVIS_BRANCH\"),\n service = \"travis\",\n build = Sys.getenv(\"TRAVIS_JOB_NUMBER\"),\n pr = pr %||% Sys.getenv(\"TRAVIS_PULL_REQUEST\"),\n job = Sys.getenv(\"TRAVIS_JOB_ID\"),\n slug = Sys.getenv(\"TRAVIS_REPO_SLUG\"),\n root = Sys.getenv(\"TRAVIS_BUILD_DIR\"),\n commit = commit %||% Sys.getenv(\"TRAVIS_COMMIT\"))\n # --------\n # Codeship\n # --------\n } else if (Sys.getenv(\"CI\") == \"true\" && Sys.getenv(\"CI_NAME\") == \"codeship\") {\n # https://www.codeship.io/documentation/continuous-integration/set-environment-variables/\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(service = \"codeship\",\n branch = branch %||% Sys.getenv(\"CI_BRANCH\"),\n build = Sys.getenv(\"CI_BUILD_NUMBER\"),\n build_url = utils::URLencode(Sys.getenv(\"CI_BUILD_URL\")),\n commit = commit %||% Sys.getenv(\"CI_COMMIT_ID\"))\n # ---------\n # Circle CI\n # ---------\n } else if (Sys.getenv(\"CI\") == \"true\" && Sys.getenv(\"CIRCLECI\") == \"true\") {\n # https://circleci.com/docs/environment-variables\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(service = \"circleci\",\n branch = branch %||% Sys.getenv(\"CIRCLE_BRANCH\"),\n build = Sys.getenv(\"CIRCLE_BUILD_NUM\"),\n owner = Sys.getenv(\"CIRCLE_PROJECT_USERNAME\"),\n repo = Sys.getenv(\"CIRCLE_PROJECT_REPONAME\"),\n pr = pr %||% Sys.getenv(\"CIRCLE_PR_NUMBER\"),\n commit = commit %||% Sys.getenv(\"CIRCLE_SHA1\"))\n # ---------\n # Semaphore\n # ---------\n } else if (Sys.getenv(\"CI\") == \"true\" && Sys.getenv(\"SEMAPHORE\") == \"true\") {\n # https://semaphoreapp.com/docs/available-environment-variables.html\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n slug_info <- strsplit(Sys.getenv(\"SEMAPHORE_REPO_SLUG\"), \"/\")[[1]]\n codecov_query <- list(service = \"semaphore\",\n branch = branch %||% Sys.getenv(\"BRANCH_NAME\"),\n build = Sys.getenv(\"SEMAPHORE_BUILD_NUMBER\"),\n owner = slug_info[1],\n repo = slug_info[2],\n commit = commit %||% Sys.getenv(\"REVISION\"))\n # --------\n # drone.io\n # --------\n } else if (Sys.getenv(\"CI\") == \"true\" && Sys.getenv(\"DRONE\") == \"true\") {\n # http://docs.drone.io/env.html\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(service = \"drone.io\",\n branch = branch %||% Sys.getenv(\"DRONE_BRANCH\"),\n build = Sys.getenv(\"DRONE_BUILD_NUMBER\"),\n build_url = utils::URLencode(Sys.getenv(\"DRONE_BUILD_URL\")),\n pr = pr %||% Sys.getenv(\"DRONE_PULL_REQUEST\"),\n commit = commit %||% Sys.getenv(\"DRONE_COMMIT\"))\n # --------\n # AppVeyor\n # --------\n } else if (Sys.getenv(\"CI\") == \"True\" && Sys.getenv(\"APPVEYOR\") == \"True\") {\n # http://www.appveyor.com/docs/environment-variables\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(service = \"appveyor\",\n branch = branch %||% Sys.getenv(\"APPVEYOR_REPO_BRANCH\"),\n job = paste(Sys.getenv(\"APPVEYOR_ACCOUNT_NAME\"), Sys.getenv(\"APPVEYOR_PROJECT_SLUG\"), Sys.getenv(\"APPVEYOR_BUILD_VERSION\"), sep = \"/\"),\n build = Sys.getenv(\"APPVEYOR_JOB_ID\"),\n pr = pr %||% Sys.getenv(\"APPVEYOR_PULL_REQUEST_NUMBER\"),\n slug = Sys.getenv(\"APPVEYOR_REPO_NAME\"),\n commit = commit %||% Sys.getenv(\"APPVEYOR_REPO_COMMIT\"))\n # -------\n # Wercker\n # -------\n } else if (Sys.getenv(\"CI\") == \"true\" && Sys.getenv(\"WERCKER_GIT_BRANCH\") != \"\") {\n # http://devcenter.wercker.com/articles/steps/variables.html\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(service = \"wercker\",\n branch = branch %||% Sys.getenv(\"WERCKER_GIT_BRANCH\"),\n build = Sys.getenv(\"WERCKER_MAIN_PIPELINE_STARTED\"),\n owner = Sys.getenv(\"WERCKER_GIT_OWNER\"),\n repo = Sys.getenv(\"WERCKER_GIT_REPOSITORY\"),\n commit = commit %||% Sys.getenv(\"WERCKER_GIT_COMMIT\"))\n # ---------\n # GitLab-CI\n # ---------\n } else if (Sys.getenv(\"CI\") == \"true\" && Sys.getenv(\"CI_SERVER_NAME\") == \"GitLab CI\") {\n # http://docs.gitlab.com/ce/ci/variables/README.html\n slug <- sub(\".*/([^/]+/[^/]+)[.]git\", \"\\\\1\", Sys.getenv(\"CI_BUILD_REPO\"))\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(service = \"gitlab\",\n branch = branch %||% Sys.getenv(\"CI_BUILD_REF_NAME\"),\n build = Sys.getenv(\"CI_BUILD_ID\"),\n slug = slug,\n commit = commit %||% Sys.getenv(\"CI_BUILD_REF\"))\n # ---------\n # GitHub Actions\n # ---------\n } else if (nzchar(Sys.getenv(\"GITHUB_ACTION\"))) {\n # Adapted from\n # https://github.com/codecov/codecov-bash/blob/3316b21c8fe0ca7ada543fb8473ac616822ce27a/codecov#L763-L783\n slug <- Sys.getenv(\"GITHUB_REPOSITORY\")\n github_ref <- Sys.getenv(\"GITHUB_REF\")\n github_head_ref <- Sys.getenv(\"GITHUB_HEAD_REF\")\n github_run_id <- Sys.getenv(\"GITHUB_RUN_ID\")\n\n is_fork_pr <- nzchar(github_head_ref)\n if (is_fork_pr) {\n pr <- pr %||% sub(\"^refs/pull/(.*)/merge\", \"\\\\1\", github_ref)\n branch <- branch %||% github_head_ref\n } else {\n branch <- branch %||% sub(\"^refs/heads/\", \"\", github_ref)\n }\n\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(service = \"github-actions\",\n branch = branch,\n build = github_run_id,\n build_url = utils::URLencode(sprintf(\"https://github.com/%s/actions/runs/%s\", slug, github_run_id)),\n pr = pr,\n slug = slug,\n commit = commit %||% Sys.getenv(\"GITHUB_SHA\"))\n # ---------\n # Google Cloud Build\n # ---------\n } else if (nzchar(Sys.getenv(\"GCB_PROJECT_ID\"))) {\n\n # https://cloud.google.com/build/docs/configuring-builds/substitute-variable-values\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n\n build_url <- sprintf(\"https://console.cloud.google.com/cloud-build/builds/%s?project=%s\",\n Sys.getenv(\"GCB_BUILD_ID\"), Sys.getenv(\"GCB_PROJECT_ID\"))\n\n name <- NULL\n pr <- NULL\n if(nzchar(Sys.getenv(\"GCB_TAG_NAME\"))) name <- Sys.getenv(\"GCB_TAG_NAME\")\n if(nzchar(Sys.getenv(\"GCB_PR_NUMBER\"))) pr <- Sys.getenv(\"GCB_PR_NUMBER\")\n\n codecov_query <- list(\n branch = branch %||% Sys.getenv(\"GCB_BRANCH_NAME\"),\n service = \"custom\",\n build = Sys.getenv(\"GCB_BUILD_ID\"),\n build_url = build_url,\n name = name,\n pr = pr,\n commit = commit %||% Sys.getenv(\"GCB_COMMIT_SHA\")\n )\n\n # ---------\n # Local GIT\n # ---------\n } else {\n codecov_url <- paste0(base_url, \"/upload/v2\") # nolint\n codecov_query <- list(branch = branch %||% local_branch(),\n commit = commit %||% current_commit())\n }\n\n # Add flags parameter\n codecov_query$flags <- flags\n\n token <- token %||% Sys.getenv(\"CODECOV_TOKEN\", extract_from_yaml(attr(coverage, \"package\")$path))\n\n if (nzchar(token)) {\n codecov_query$token <- token\n }\n\n coverage_json <- to_codecov(coverage)\n\n content(RETRY(\"POST\",\n url = codecov_url,\n query = codecov_query,\n body = coverage_json,\n encode = \"json\",\n httr::config(http_version = curl_http_1_1())))\n}\n\ncurl_http_1_1 <- function() {\n symbols <- curl::curl_symbols()\n symbols$value[symbols$name == \"CURL_HTTP_VERSION_1_1\"]\n}\n\nextract_from_yaml <- function(path){\n if (is.null(path)) {\n return(\"\")\n }\n\n path_to_yaml <- file.path(path, \"codecov.yml\")\n if (file.exists(path_to_yaml)) {\n yaml::read_yaml(path_to_yaml)[[\"codecov\"]][[\"token\"]] %||% \"\"\n } else {\n \"\"\n }\n}\n\nto_codecov <- function(x) {\n coverages <- lapply(per_line(x),\n function(xx) {\n xx$coverage <- c(NA, xx$coverage)\n xx\n })\n\n res <- Map(function(coverage, name) {\n list(\n \"name\" = jsonlite::unbox(name),\n \"coverage\" = coverage$coverage\n )\n }, coverages, names(coverages), USE.NAMES = FALSE)\n\n jsonlite::toJSON(na = \"null\", list(\"files\" = res, \"uploader\" = jsonlite::unbox(\"R\")))\n}\n" }, { "path": "R/compiled.R", "content": "# this does not handle LCOV_EXCL_START ect.\nparse_gcov <- function(file, package_path = \"\") {\n if (!file.exists(file)) {\n return(NULL)\n }\n\n lines <- readLines(file)\n source_file <- rex::re_matches(lines[1], rex::rex(\"Source:\", capture(name = \"source\", anything)))$source\n\n # retrieve full path to the source files\n source_file <- normalize_path(source_file)\n\n # If the source file does not start with the package path or does not exist ignore it.\n if (!file.exists(source_file) || !grepl(rex::rex(start, rex::regex(paste0(rex::escape(package_path), collapse = \"|\"))), source_file)) {\n return(NULL)\n }\n\n re <- rex::rex(any_spaces,\n capture(name = \"coverage\", some_of(digit, \"-\", \"#\", \"=\")),\n \":\", any_spaces,\n capture(name = \"line\", digits),\n \":\"\n )\n\n matches <- rex::re_matches(lines, re)\n\n # Exclude lines with no match to the pattern\n lines <- lines[!is.na(matches$coverage)]\n matches <- na.omit(matches)\n\n # gcov lines which have no coverage\n matches$coverage[matches$coverage == \"#####\"] <- 0 # nolint\n\n # gcov lines which have parse error, so make untracked\n matches$coverage[matches$coverage == \"=====\"] <- \"-\"\n\n coverage_lines <- matches$line != \"0\" & matches$coverage != \"-\"\n matches <- matches[coverage_lines, ]\n\n values <- as.numeric(matches$coverage)\n\n if (any(is.na(values))) {\n stop(\"values could not be coerced to numeric \", matches$coverage)\n }\n\n # There are no functions for gcov, so we set everything to NA\n functions <- rep(NA_character_, length(values))\n\n line_coverages(source_file, matches, values, functions)\n}\n\n# for mocking\nreadLines <- NULL\nfile.exists <- NULL\n\nclean_gcov <- function(path) {\n src_dir <- file.path(path, \"src\")\n\n gcov_files <- list.files(src_dir,\n pattern = rex::rex(or(\".gcda\", \".gcno\", \".gcov\"), end),\n full.names = TRUE,\n recursive = TRUE)\n\n unlink(gcov_files)\n}\n\nrun_gcov <- function(path, quiet = TRUE, clean = TRUE,\n gcov_path = getOption(\"covr.gcov\", \"\"),\n gcov_args = getOption(\"covr.gcov_args\", NULL)) {\n src_path <- normalize_path(file.path(path, \"src\"))\n if (!file.exists(src_path)) {\n return()\n }\n\n withr::local_dir(src_path)\n\n gcov_inputs <- list.files(\".\", pattern = rex::rex(\".gcno\", end), recursive = TRUE, full.names = TRUE)\n\n if (!nzchar(gcov_path)) {\n if (length(gcov_inputs)) stop('gcov not found')\n return()\n }\n\n run_gcov_one <- function(src) {\n system_check(gcov_path,\n args = c(gcov_args, src, \"-p\", \"-o\", dirname(src)),\n quiet = quiet, echo = !quiet)\n gcov_outputs <- list.files(\".\", pattern = rex::rex(\".gcov\", end), recursive = TRUE, full.names = TRUE)\n\n if (!quiet) {\n message(\"gcov output for \", src, \":\")\n message(paste(gcov_outputs, collapse = \"\\n\"))\n }\n\n if (clean) {\n on.exit(unlink(gcov_outputs))\n } else {\n gcov_output_base <- file.path(\"..\", \"covr\", src)\n gcov_output_targets <- sub(\".\", gcov_output_base, gcov_outputs)\n\n if (!quiet) {\n message(\"gcov output targets for \", src, \":\")\n message(paste(gcov_output_targets, collapse = \"\\n\"))\n }\n\n lapply(\n unique(dirname(gcov_output_targets)),\n function(.x) dir.create(.x, recursive = TRUE, showWarnings = FALSE)\n )\n\n on.exit({\n\tif (!quiet) {\n\t message(\"Moving gcov outputs to covr directory.\\n\")\n\t}\n file.rename(gcov_outputs, gcov_output_targets)\n })\n }\n\n unlist(lapply(gcov_outputs, parse_gcov, package_path = c(path, getOption(\"covr.gcov_additional_paths\", NULL))), recursive = FALSE)\n }\n\n res <- compact(unlist(lapply(gcov_inputs, run_gcov_one), recursive = FALSE))\n\n if (!length(res) && length(gcov_inputs))\n warning('parsed gcov output was empty')\n\n res\n}\n\nline_coverages <- function(source_file, matches, values, functions) {\n\n # create srcfile reference from the source file\n src_file <- srcfilecopy(source_file, readLines(source_file))\n\n line_lengths <- vapply(src_file$lines[as.numeric(matches$line)], nchar, numeric(1))\n\n res <- Map(function(line, length, value, func) {\n src_ref <- srcref(src_file, c(line, 1, line, length))\n res <- list(srcref = src_ref, value = value, functions = func)\n class(res) <- \"line_coverage\"\n res\n },\n matches$line, line_lengths, values, functions)\n\n if (!length(res)) {\n return(NULL)\n }\n\n names(res) <- lapply(res, function(x) key(x$srcref))\n\n class(res) <- \"line_coverages\"\n res\n}\n" }, { "path": "R/coveralls.R", "content": "#' Run covr on a package and upload the result to coveralls\n#' @param coverage an existing coverage object to submit, if `NULL`,\n#' [package_coverage()] will be called with the arguments from\n#' `...`\n#' @param ... arguments passed to [package_coverage()]\n#' @param repo_token The secret repo token for your repository,\n#' found at the bottom of your repository's page on Coveralls. This is useful\n#' if your job is running on a service Coveralls doesn't support out-of-the-box.\n#' If set to NULL, it is assumed that the job is running on travis-ci\n#' @param service_name the CI service to use, if environment variable\n#' \\sQuote{CI_NAME} is set that is used, otherwise \\sQuote{travis-ci} is used.\n#' @param quiet if `FALSE`, print the coverage before submission.\n#' @export\ncoveralls <- function(..., coverage = NULL,\n repo_token = Sys.getenv(\"COVERALLS_TOKEN\"),\n service_name = Sys.getenv(\"CI_NAME\", \"travis-ci\"),\n quiet = TRUE) {\n\n if (is.null(coverage)) {\n coverage <- package_coverage(..., quiet = quiet)\n }\n\n if (!quiet) {\n print(coverage)\n }\n\n service <- tolower(service_name)\n\n coveralls_url <- \"https://coveralls.io/api/v1/jobs\"\n coverage_json <- to_coveralls(coverage,\n repo_token = repo_token, service_name = service)\n\n result <- RETRY(\"POST\", url = coveralls_url,\n body = list(json_file = upload_file(to_file(coverage_json))))\n\n content <- content(result)\n if (isTRUE(content$error)) {\n stop(\"Failed to upload coverage data. Reply by Coveralls: \", content$message)\n }\n content\n}\n\nto_file <- function(x) {\n name <- temp_file()\n con <- file(name)\n writeChar(con = con, x, eos = NULL)\n close(con)\n name\n}\n\nto_coveralls <- function(x, service_job_id = Sys.getenv(\"TRAVIS_JOB_ID\"),\n service_name, repo_token = \"\") {\n\n coverages <- per_line(x)\n\n res <- Map(function(coverage, name) {\n source_code <- paste(collapse = \"\\n\", coverage$file$file_lines)\n list(\n \"name\" = jsonlite::unbox(name),\n \"source\" = jsonlite::unbox(source_code),\n \"source_digest\" = jsonlite::unbox(digest::digest(source_code, algo = \"md5\", serialize = FALSE)),\n \"coverage\" = coverage$coverage)\n }, coverages, names(coverages), USE.NAMES = FALSE)\n\n git_info <- switch(service_name,\n drone = jenkins_git_info(), # drone has the same env vars as jenkins\n jenkins = jenkins_git_info(),\n 'travis-pro' = jenkins_git_info(),\n list(NULL)\n )\n\n payload <- if (!nzchar(repo_token)) {\n list(\n \"service_job_id\" = jsonlite::unbox(service_job_id),\n \"service_name\" = jsonlite::unbox(service_name),\n \"source_files\" = res)\n } else {\n tmp <- list(\n \"repo_token\" = jsonlite::unbox(repo_token),\n \"service_name\" = jsonlite::unbox(service_name),\n \"source_files\" = res)\n tmp$git <- git_info\n tmp\n }\n\n jsonlite::toJSON(na = \"null\", payload)\n}\n\njenkins_git_info <- function() {\n # check https://coveralls.zendesk.com/hc/en-us/articles/201350799-API-Reference\n # for why and how we are doing this\n formats <- c(\n id = \"%H\",\n author_name = \"%an\",\n author_email = \"%ae\",\n commiter_name = \"%cn\",\n commiter_email = \"%ce\",\n message = \"%s\"\n )\n head <- lapply(structure(\n scan(\n sep = \"\\n\",\n what = \"character\",\n text = system_output(\"git\", c(\"log\", \"-n\", \"1\",\n paste0(\"--pretty=format:\", paste(collapse = \"%n\", formats)))\n ),\n quiet = TRUE\n ),\n names = names(formats)\n ), jsonlite::unbox)\n\n remotes <- list(list(\n name = jsonlite::unbox(\"origin\"),\n url = jsonlite::unbox(Sys.getenv(\"CI_REMOTE\"))\n ))\n\n c(list(branch = jsonlite::unbox(Sys.getenv(\"CI_BRANCH\"))),\n head = list(head),\n remotes = list(remotes))\n}\n" }, { "path": "R/covr.R", "content": "#' covr: Test coverage for packages\n#'\n#' covr tracks and reports code coverage for your package and (optionally)\n#' upload the results to a coverage service like 'Codecov' or\n#' 'Coveralls' . Code coverage is a measure of the amount of\n#' code being exercised by a set of tests. It is an indirect measure of test\n#' quality and completeness. This package is compatible with any testing\n#' methodology or framework and tracks coverage of both R code and compiled\n#' C/C++/FORTRAN code.\n#'\n#' A coverage report can be used to inspect coverage for each line in your\n#' package. Using `report()` requires the additional dependencies `DT` and `htmltools`.\n#'\n#' ```r\n#' # If run with no arguments `report()` implicitly calls `package_coverage()`\n#' report()\n#' ```\n#'\n#' @section Package options:\n#'\n#' `covr` uses the following [options()] to configure behaviour:\n#'\n#' \\itemize{\n#' \\item `covr.covrignore`: A filename to use as an ignore file,\n#' listing glob-style wildcarded paths of files to ignore for coverage\n#' calculations. Defaults to the value of environment variable\n#' `COVR_COVRIGNORE`, or `\".covrignore\"` if the neither the option nor the\n#' environment variable are set.\n#'\n#' \\item `covr.exclude_end`: Used along with `covr.exclude_start`, an optional\n#' regular expression which ends a line-exclusion region. For more\n#' details, see `?exclusions`.\n#'\n#' \\item `covr.exclude_pattern`: An optional line-exclusion pattern. Lines\n#' which match the pattern will be excluded from coverage. For more details,\n#' see `?exclusions`.\n#'\n#' \\item `covr.exclude_start`: Used along with `covr.exclude_end`, an optional\n#' regular expression which starts a line-exclusion region. For more\n#' details, see `?exclusions`.\n#'\n#' \\item `covr.filter_non_package`: If `TRUE` (the default behavior), coverage\n#' of files outside the target package are filtered from coverage output.\n#'\n#' \\item `covr.fix_parallel_mcexit`:\n#'\n#' \\item `covr.flags`:\n#'\n#' \\item `covr.gcov`: If the appropriate gcov version is not on your path you\n#' can use this option to set the appropriate location. If set to \"\" it will\n#' turn off coverage of compiled code.\n#'\n#' \\item `covr.gcov_additional_paths`:\n#'\n#' \\item `covr.gcov_args`:\n#'\n#' \\item `covr.icov`:\n#'\n#' \\item `covr.icov_args`:\n#'\n#' \\item `covr.icov_flags`:\n#'\n#' \\item `covr.icov_prof`:\n#'\n#' \\item `covr.rstudio_source_markers`: A logical value. If `TRUE` (the\n#' default behavior), source markers are displayed within the RStudio IDE\n#' when using `zero_coverage`.\n#'\n#' \\item `covr.record_tests`: If `TRUE` (default `NULL`), record a listing of\n#' top level test expressions and associate tests with `covr` traces\n#' evaluated during the test's execution. For more details, see\n#' `?covr.record_tests`.\n#'\n#' \\item `covr.showCfunctions`:\n#' }\n#'\n#'\n\"_PACKAGE\"\n\n#' @import methods\n#' @importFrom stats aggregate na.omit na.pass setNames\n#' @importFrom utils capture.output getSrcFilename relist str head\n#' @importFrom httr content RETRY upload_file\nNULL\n\nthe <- new.env(parent = emptyenv())\n\nthe$replacements <- list()\n\ntrace_environment <- function(env) {\n clear_counters()\n\n the$replacements <- compact(c(\n replacements_S4(env),\n replacements_RC(env),\n replacements_R6(env),\n replacements_S7(env),\n replacements_box(env),\n lapply(ls(env, all.names = TRUE), replacement, env = env)))\n\n lapply(the$replacements, replace)\n}\n\nreset_traces <- function() {\n lapply(the$replacements, reset)\n}\n\nsave_trace <- function(directory) {\n tmp_file <- temp_file(\"covr_trace_\", tmpdir = directory)\n saveRDS(.counters, file = tmp_file)\n}\n\n#' Convert a counters object to a coverage object\n#'\n#' @param counters An environment of covr trace results to convert to a coverage\n#' object. If `counters` is not provided, the `covr` namespace value\n#' `.counters` is used.\n#' @param ... Additional attributes to include with the coverage object.\n#'\nas_coverage <- function(counters = NULL, ...) {\n if (missing(counters))\n counters <- .counters\n\n counters <- as.list(counters)\n counters <- as_coverage_with_tests(counters)\n\n structure(counters, ..., class = \"coverage\")\n}\n\n#' Clean and restructure counter tests for a coverage object\n#'\n#' For tests produced with `options(covr.record_tests)`, prune any unused\n#' records in the $tests$tally matrices of each trace and get rid of the\n#' wrapping $tests environment (reassigning with value of $tests$tally)\n#'\n#' @inheritParams as_coverage\n#'\nas_coverage_with_tests <- function(counters) {\n clean_coverage_tests(counters)\n\n # unnest environment-wrapped $tests$tally as more accessible $tests\n for (i in seq_along(counters)) {\n if (!is.environment(counters[[i]]$tests)) next\n counters[[i]]$tests <- counters[[i]]$tests$tally\n }\n\n tests <- counters$tests\n counters$tests <- NULL\n structure(counters, tests = tests, class = \"coverage\")\n}\n\n#' Calculate test coverage for a specific function.\n#'\n#' @param fun name of the function.\n#' @param code expressions to run.\n#' @param env environment the function is defined in.\n#' @param enc the enclosing environment which to run the expressions.\n#' @examples\n#' add <- function(x, y) { x + y }\n#' function_coverage(fun = add, code = NULL) # 0% coverage\n#' function_coverage(fun = add, code = add(1, 2) == 3) # 100% coverage\n#' @export\nfunction_coverage <- function(fun, code = NULL, env = NULL, enc = parent.frame()) {\n if (is.function(fun)) {\n env <- environment(fun)\n\n # get name of function, stripping preceding blah:: if needed\n fun <- rex::re_substitutes(deparse(substitute(fun)), rex::regex(\".*:::?\"), \"\")\n }\n\n clear_counters()\n\n replacement <- if (!is.null(env)) {\n replacement(fun, env)\n } else {\n replacement(fun)\n }\n\n on.exit({\n reset(replacement)\n clear_counters()\n })\n\n replace(replacement)\n\n withr::with_envvar(c(\"R_COVR\" = \"true\"),\n eval(code, enc)\n )\n\n as_coverage(as.list(.counters))\n}\n\n#' Calculate test coverage for sets of files\n#'\n#' The files in `source_files` are first sourced into a new environment\n#' to define functions to be checked. Then they are instrumented to track\n#' coverage and the files in `test_files` are sourced.\n#' @param source_files Character vector of source files with function\n#' definitions to measure coverage\n#' @param test_files Character vector of test files with code to test the\n#' functions\n#' @param parent_env The parent environment to use when sourcing the files.\n#' @inheritParams package_coverage\n#' @examples\n#' # For the purpose of this example, save code containing code and tests to files\n#' cat(\"add <- function(x, y) { x + y }\", file=\"add.R\")\n#' cat(\"add(1, 2) == 3\", file=\"add_test.R\")\n#'\n#' # Use file_coverage() to calculate test coverage\n#' file_coverage(source_files = \"add.R\", test_files = \"add_test.R\")\n#'\n#' # cleanup\n#' file.remove(c(\"add.R\", \"add_test.R\"))\n#' @export\nfile_coverage <- function(\n source_files,\n test_files,\n line_exclusions = NULL,\n function_exclusions = NULL,\n parent_env = parent.frame()) {\n\n env <- new.env(parent = parent_env)\n\n withr::with_options(c(\"keep.parse.data.pkgs\" = TRUE), {\n lapply(source_files,\n sys.source, keep.source = TRUE, envir = env)\n })\n\n trace_environment(env)\n on.exit({\n reset_traces()\n clear_counters()\n })\n\n withr::with_envvar(c(\"R_COVR\" = \"true\"),\n lapply(test_files,\n sys.source, keep.source = TRUE, envir = env)\n )\n\n coverage <- as_coverage(.counters)\n\n exclude(coverage,\n line_exclusions = line_exclusions,\n function_exclusions = function_exclusions,\n path = NULL)\n}\n\n#' Calculate coverage of code directly\n#'\n#' This function is useful for testing, and is a thin wrapper around\n#' [file_coverage()] because parseData is not populated properly\n#' unless the functions are defined in a file.\n#' @param source_code A character vector of source code\n#' @param test_code A character vector of test code\n#' @inheritParams file_coverage\n#' @param ... Additional arguments passed to [file_coverage()]\n#' @examples\n#' source <- \"add <- function(x, y) { x + y }\"\n#' test <- \"add(1, 2) == 3\"\n#' code_coverage(source, test)\n#' @export\ncode_coverage <- function(\n source_code,\n test_code,\n line_exclusions = NULL,\n function_exclusions = NULL,\n ...) {\n src <- tempfile(\"source.R\")\n test <- tempfile(\"test.R\")\n on.exit(file.remove(src, test))\n cat(source_code, file = src)\n cat(test_code, file = test)\n file_coverage(src, test, line_exclusions = line_exclusions,\n function_exclusions = function_exclusions, ...)\n}\n\n#' Calculate coverage of an environment\n#'\n#' @param env The environment to be instrumented.\n#' @inheritParams file_coverage\n#' @export\nenvironment_coverage <- function(\n env = parent.frame(),\n test_files,\n line_exclusions = NULL,\n function_exclusions = NULL) {\n\n exec_env <- new.env(parent = env)\n\n trace_environment(env)\n on.exit({\n reset_traces()\n clear_counters()\n })\n\n withr::with_envvar(c(\"R_COVR\" = \"true\"),\n lapply(test_files,\n sys.source, keep.source = TRUE, envir = exec_env)\n )\n\n coverage <- as_coverage(.counters)\n\n exclude(coverage,\n line_exclusions = line_exclusions,\n function_exclusions = function_exclusions,\n path = NULL)\n}\n\n#' Calculate test coverage for a package\n#'\n#' This function calculates the test coverage for a development package on the\n#' `path`. By default it runs only the package tests, but it can also run\n#' vignette and example code.\n#'\n#' @details\n#' This function uses [tools::testInstalledPackage()] to run the\n#' code, if you would like to test your package in another way you can set\n#' `type = \"none\"` and pass the code to run as a character vector to the\n#' `code` parameter.\n#'\n#' #ifdef unix\n#' Parallelized code using \\pkg{parallel}'s [mcparallel()] needs to\n#' use a patched `parallel:::mcexit`. This is done automatically if the\n#' package depends on \\pkg{parallel}, but can also be explicitly set using the\n#' environment variable `COVR_FIX_PARALLEL_MCEXIT` or the global option\n#' `covr.fix_parallel_mcexit`.\n#' #endif\n#'\n#' @param path file path to the package.\n#' @param type run the package \\sQuote{tests}, \\sQuote{vignettes},\n#' \\sQuote{examples}, \\sQuote{all}, or \\sQuote{none}. The default is\n#' \\sQuote{tests}.\n#' @param combine_types If `TRUE` (the default) the coverage for all types\n#' is simply summed into one coverage object. If `FALSE` separate objects\n#' are used for each type of coverage.\n#' @param relative_path whether to output the paths as relative or absolute\n#' paths. If a string, it is interpreted as a root path and all paths will be\n#' relative to that root.\n#' @param quiet whether to load and compile the package quietly, useful for\n#' debugging errors.\n#' @param clean whether to clean temporary output files after running, mainly\n#' useful for debugging errors.\n#' @param line_exclusions a named list of files with the lines to exclude from\n#' each file.\n#' @param function_exclusions a vector of regular expressions matching function\n#' names to exclude. Example `print\\\\\\.` to match print methods.\n#' @param code A character vector of additional test code to run.\n#' @param ... Additional arguments passed to [tools::testInstalledPackage()].\n#' @param exclusions \\sQuote{Deprecated}, please use \\sQuote{line_exclusions} instead.\n#' @param pre_clean whether to delete all objects present in the src directory before recompiling\n#' @param install_path The path the instrumented package will be installed to\n#' and tests run in. By default it is a path in the R sessions temporary\n#' directory. It can sometimes be useful to set this (along with `clean =\n#' FALSE`) to help debug test failures.\n#' @seealso [exclusions()] For details on excluding parts of the\n#' package from the coverage calculations.\n#' @export\npackage_coverage <- function(path = \".\",\n type = c(\"tests\", \"vignettes\", \"examples\", \"all\", \"none\"),\n combine_types = TRUE,\n relative_path = TRUE,\n quiet = TRUE,\n clean = TRUE,\n line_exclusions = NULL,\n function_exclusions = NULL,\n code = character(),\n install_path = temp_file(\"R_LIBS\"),\n ...,\n exclusions, pre_clean = TRUE) {\n\n if (!missing(exclusions)) {\n warning(\n \"`exclusions` is deprecated and will be removed in an upcoming release. Please use `line_exclusions` instead.\",\n call. = FALSE, domain = NA\n )\n line_exclusions <- exclusions\n }\n\n pkg <- as_package(path)\n\n if (missing(type)) {\n type <- \"tests\"\n }\n\n type <- parse_type(type)\n\n run_separately <- !isTRUE(combine_types) && length(type) > 1\n if (run_separately) {\n # store the args that were called\n called_args <- as.list(match.call())[-1]\n\n # remove the type\n called_args$type <- NULL\n res <- list()\n for (t in type) {\n res[[t]] <- do.call(Recall, c(called_args, type = t))\n attr(res[[t]], \"type\") <- t\n }\n\n attr(res, \"package\") <- pkg\n class(res) <- \"coverages\"\n return(res)\n }\n\n if (is.character(relative_path)) {\n stopifnot(length(relative_path) == 1)\n root <- normalize_path(relative_path)\n } else if (isTRUE(relative_path)) {\n root <- pkg$path\n } else {\n root <- NULL\n }\n\n # tools::testInstalledPackage requires normalized install_path (#517)\n install_path <- normalize_path(install_path)\n dir.create(install_path)\n\n # check for compiler\n if (!uses_icc()) {\n flags <- getOption(\"covr.flags\")\n } else if (length(getOption(\"covr.icov\")) > 0L) {\n flags <- getOption(\"covr.icov_flags\")\n # clean up old icov files\n unlink(file.path(pkg$path, \"src\", \"*.dyn\"))\n unlink(file.path(pkg$path, \"src\", \"pgopti.*\"))\n } else {\n stop(\"icc is not available\")\n }\n\n if (isTRUE(clean)) {\n on.exit({\n clean_objects(pkg$path)\n clean_gcov(pkg$path)\n clean_parse_data()\n unlink(install_path, recursive = TRUE)\n }, add = TRUE)\n }\n\n # clean any dlls prior to trying to install\n if (isTRUE(pre_clean)) clean_objects(pkg$path)\n\n # install the package in a temporary directory\n withr::with_envvar(\n list(R_LIBS = paste(.libPaths(), collapse = .Platform$path.sep)),\n withr::with_makevars(flags, assignment = \"+=\", {\n args <- c(\n \"--vanilla\", \"CMD\", \"INSTALL\",\n \"-l\", shQuote(install_path),\n \"--example\",\n \"--install-tests\",\n \"--with-keep.source\",\n \"--with-keep.parse.data\",\n \"--no-staged-install\",\n \"--no-multiarch\",\n shQuote(pkg$path)\n )\n\n name <- if (.Platform$OS.type == \"windows\") \"R.exe\" else \"R\"\n path <- file.path(R.home(\"bin\"), name)\n res <- system2(\n path,\n args,\n stdout = if (quiet) NULL else \"\",\n stderr = if (quiet) NULL else \"\"\n )\n })\n )\n\n if (res != 0) {\n stop(\"Package installation did not succeed.\")\n }\n\n # add hooks to the package startup\n add_hooks(pkg$package, install_path,\n fix_mcexit = should_enable_parallel_mcexit_fix(pkg))\n\n libs <- env_path(install_path, .libPaths())\n\n # We need to set the libpaths in the current R session for examples with\n # install or runtime Sexpr blocks, which may implicitly load the package in\n # the current R session.\n withr::with_libpaths(install_path, action = \"prefix\", {\n\n withr::with_envvar(\n c(R_DEFAULT_PACKAGES = \"datasets,utils,grDevices,graphics,stats,methods\",\n R_LIBS = libs,\n R_LIBS_USER = libs,\n R_LIBS_SITE = libs,\n R_COVR = \"true\",\n R_TESTS = file.path(R.home(\"share\"), \"R\", \"tests-startup.R\")), {\n\n\n withCallingHandlers({\n if (\"vignettes\" %in% type) {\n type <- type[type != \"vignettes\"]\n run_vignettes(pkg, install_path)\n }\n\n out_dir <- file.path(install_path, pkg$package)\n if (\"examples\" %in% type) {\n type <- type[type != \"examples\"]\n # testInstalledPackage explicitly sets R_LIBS=\"\" on windows, and does\n # not restore it after, so we need to reset it ourselves.\n withr::with_envvar(c(R_LIBS = Sys.getenv(\"R_LIBS\")), {\n result <- tools::testInstalledPackage(pkg$package, outDir = out_dir, types = \"examples\", lib.loc = install_path, ...)\n if (result != 0L) {\n show_failures(out_dir)\n }\n })\n }\n if (\"tests\" %in% type) {\n result <- tools::testInstalledPackage(pkg$package, outDir = out_dir, types = \"tests\", lib.loc = install_path, ...)\n if (result != 0L) {\n show_failures(out_dir)\n }\n }\n\n # We always run the commands file (even if empty) to load the package and\n # initialize all the counters to 0.\n run_commands(pkg, install_path, code)\n },\n message = function(e) if (quiet) invokeRestart(\"muffleMessage\") else e,\n warning = function(e) if (quiet) invokeRestart(\"muffleWarning\") else e)\n })\n })\n\n # read tracing files\n trace_files <- list.files(path = install_path, pattern = \"^covr_trace_[^/]+$\", full.names = TRUE)\n coverage <- merge_coverage(trace_files)\n if (!uses_icc()) {\n res <- run_gcov(pkg$path, quiet = quiet, clean = clean)\n } else {\n res <- run_icov(pkg$path, quiet = quiet)\n }\n\n coverage <- as_coverage(\n c(coverage, res),\n package = pkg,\n root = root\n )\n\n if (!clean) {\n attr(coverage, \"library\") <- install_path\n }\n\n if (getOption(\"covr.filter_non_package\", TRUE)) {\n coverage <- filter_non_package_files(coverage)\n }\n\n # Exclude generated files from Rcpp and cpp11 to avoid redundant coverage information\n line_exclusions <- c(\n \"src/RcppExports.cpp\",\n \"R/RcppExports.R\",\n \"src/cpp11.cpp\",\n \"R/cpp11.R\",\n line_exclusions,\n withr::with_dir(root, parse_covr_ignore())\n )\n\n exclude(coverage,\n line_exclusions = line_exclusions,\n function_exclusions = function_exclusions,\n path = root)\n}\n\n#' Convert a coverage dataset to a list\n#'\n#' @param x a coverage dataset, defaults to running `package_coverage()`.\n#' @return A list containing coverage result for each individual file and the whole package\n#' @export\ncoverage_to_list <- function(x = package_coverage()){\n covr_df <- tally_coverage(x)\n file_result <- tapply(covr_df$value, covr_df$filename,\n FUN = function(x) round(sum(x > 0) / length(x) * 100, digits = 2))\n total_result <- round(sum(covr_df$value > 0) / nrow(covr_df) * 100, digits = 2)\n return(list(filecoverage = file_result, totalcoverage = total_result))\n}\n\nshow_failures <- function(dir) {\n fail_files <- list.files(dir, pattern = \"fail$\", recursive = TRUE, full.names = TRUE)\n for (file in fail_files) {\n lines <- readLines(file)\n\n # Skip header lines (until first >)\n lines <- lines[seq(which.min(grepl(\"^>\", lines)), length(lines))]\n\n\n # R will only show options(\"warning.length\") number of characters in an\n # error, so show the last characters of that number\n error_header <- paste0(\"Failure in `\", file, \"`\\n\")\n\n # 9 is the length of `Error: ` + newline + NUL maybe?\n error_length <- getOption(\"warning.length\") - 9\n error_body <- paste(lines, collapse = \"\\n\")\n\n header_len <- nchar(error_header, \"bytes\")\n body_len <- nchar(error_body, \"bytes\")\n\n error_body <- substr(error_body, body_len - (error_length - header_len), body_len)\n\n cnd <- structure(list(message = paste0(error_header, error_body)), class = c(\"covr_error\", \"error\", \"condition\"))\n stop(cnd)\n }\n}\n\n# merge multiple coverage files together. Assumes the order of coverage lines\n# is the same in each object, this should always be the case if the objects are\n# from the same initial library.\nmerge_coverage <- function(x) {\n UseMethod(\"merge_coverage\")\n}\n\n#' @export\nmerge_coverage.character <- function(x) {\n coverage_objs <- lapply(x, function(f) {\n as.list(suppressWarnings(readRDS(f)))\n })\n merge_coverage(coverage_objs)\n}\n\n#' @export\nmerge_coverage.list <- function(x) {\n coverage_objs <- x\n if (length(coverage_objs) == 0) {\n return()\n }\n\n x <- coverage_objs[[1]]\n names <- names(x)\n clean_coverage_tests(x) # x[[key]]$tests environments modified in-place\n\n for (y in tail(coverage_objs, -1L)) {\n\n # only affects coverage produced with options(covr.record_tests = TRUE)\n clean_coverage_tests(y)\n x <- merge_coverage_tests(from = y, into = x)\n\n for (name in intersect(names, names(y))) {\n if (name == \"tests\") next\n x[[name]]$value <- x[[name]]$value + y[[name]]$value\n }\n\n for (name in setdiff(names(y), names)) {\n x[[name]] <- y[[name]]\n }\n\n names <- union(names, names(y))\n }\n\n x\n}\n\n# Strip allocated, but unused test records from coverage test matrix\n#\n# The tally of tests that hit each trace is held in a pre-allocated matrix\n# which may be padded with unused rows. Start by stripping unused rows:\n#\n# If tests were not recorded (that is, if `options(covr.record_tests)` was not\n# `TRUE` when the coverage was calculated, this function will have no effect.\n#\n# @param obj A coverage counter environment, within which a $tests$tally matrix\n# may have been allocated, but not entirely populated.\n#\nclean_coverage_tests <- function(obj) {\n counter_has_tests_tally <- function(counter) !is.null(counter$tests)\n if (is.na(Position(counter_has_tests_tally, obj))) return()\n\n for (i in seq_along(obj)) {\n val <- obj[[i]]$value\n if (is.null(val) || is.na(val)) next\n n <- nrow(obj[[i]]$tests$tally)\n if (is.null(n) || is.na(n) || n < val) next\n obj[[i]]$tests$tally <- obj[[i]]$tests$tally[seq_len(val),,drop = FALSE]\n }\n}\n\n# Merge recorded tests from one coverage object into another. Because coverage\n# objects are environments, these environments will be modified by-reference as\n# a side-effect of calling this function.\n#\n# If tests were not recorded (that is, if `options(covr.record_tests)` was not\n# `TRUE` when the coverage was calculated, this function will have no effect.\n#\n# @param from A coverage counter environment whose tests should be merged into\n# \\code{into}\n# @param into A coverage counter environment to add tests into\n#\nmerge_coverage_tests <- function(from, into = NULL) {\n if (is.null(from$tests)) return(into)\n\n # TODO: The x[[name]]$tests$tally matrices are re-allocated with each rbind of\n # additional test hits as each object is merged. This could be avoided by\n # first calculating the total rows needed to store all the merged tests and\n # then allocating a matrix of the appropriate size from the start. In most\n # cases, this amounts to neglegable overhead but is an opportunity for\n # improvement.\n\n # align tests from coverage objects\n test_idx <- match(names(from$tests), Filter(nchar, names(into$tests)))\n new_test_idx <- if (!length(test_idx)) seq_along(from$tests) else which(is.na(test_idx))\n test_idx[new_test_idx] <- length(into$tests) + seq_along(new_test_idx)\n\n # append any tests that we haven't encountered in previous objects\n into$tests <- append(into$tests, from$tests[new_test_idx])\n from$tests <- NULL\n\n # modify trace test tallies\n for (name in intersect(names(into), names(from))) {\n if (name == \"tests\") next\n from[[name]]$tests$tally[, 1L] <- test_idx[from[[name]]$tests$tally[, 1L]]\n into[[name]]$tests$tally <- rbind(into[[name]]$tests$tally, from[[name]]$tests$tally)\n }\n\n into\n}\n\nparse_type <- function(type) {\n type <- match_arg(type, choices = c(\"tests\", \"vignettes\", \"examples\", \"all\", \"none\"), several.ok = TRUE)\n if (type %==% \"all\") {\n type <- c(\"tests\", \"vignettes\", \"examples\")\n }\n\n if (length(type) > 1L) {\n\n if (\"all\" %in% type) {\n stop(sQuote(\"all\"), \" must be the only type specified\", call. = FALSE)\n }\n\n if (\"none\" %in% type) {\n stop(sQuote(\"none\"), \" must be the only type specified\", call. = FALSE)\n }\n }\n type\n}\n\n# Run vignettes for a package. This is done in a new process as otherwise the\n# finalizer is not called to dump the results. The namespace is first\n# explicitly loaded to ensure output even if no vignettes exist.\n# @param pkg Package object (from as_package) to run\n# @param lib the library path to look in\nrun_vignettes <- function(pkg, lib) {\n outfile <- file.path(lib, paste0(pkg$package, \"-Vignette.Rout\"))\n failfile <- paste(outfile, \"fail\", sep = \".\" )\n cat(\"tools::buildVignettes(dir = '\", pkg$path, \"')\\n\", file = outfile, sep = \"\")\n cmd <- paste(shQuote(file.path(R.home(\"bin\"), \"R\")),\n \"CMD BATCH --vanilla --no-timing\",\n shQuote(outfile), shQuote(failfile))\n res <- system(cmd)\n if (res != 0) {\n show_failures(dirname(failfile))\n } else {\n file.rename(failfile, outfile)\n }\n}\n\nrun_commands <- function(pkg, lib, commands) {\n outfile <- file.path(lib, paste0(pkg$package, \"-commands.Rout\"))\n failfile <- paste(outfile, \"fail\", sep = \".\" )\n writeLines(c(\n paste0(\"library('\", pkg$package, \"')\"),\n commands), con = outfile)\n cmd <- paste(shQuote(file.path(R.home(\"bin\"), \"R\")),\n \"CMD BATCH --vanilla --no-timing\",\n shQuote(outfile), shQuote(failfile))\n res <- system(cmd)\n if (res != 0L) {\n show_failures(dirname(failfile))\n } else {\n file.rename(failfile, outfile)\n }\n}\n\n# Add hooks to the installed package\n# Installed packages have lazy loading code to setup the lazy load database at\n# pkg_name/R/pkg_name. This function adds a user level onLoad Hook to the\n# package which calls `covr::trace_environment`, so the package environment is\n# traced when the package is loaded.\n# It also adds a finalizer that saves the tracing information to the package\n# namespace environment which is run when the ns is garbage collected or the\n# process ends. This ensures the tracing count information will be written\n# regardless of how the process terminates.\n# @param pkg_name name of the package to add hooks to\n# @param lib the library path to look in\n# @param fix_mcexit whether to add the fix for mcparallel:::mcexit\nadd_hooks <- function(pkg_name, lib, fix_mcexit = FALSE,\n record_tests = isTRUE(getOption(\"covr.record_tests\", FALSE))) {\n\n trace_dir <- paste0(\"Sys.getenv(\\\"COVERAGE_DIR\\\", \\\"\", lib, \"\\\")\")\n\n load_script <- file.path(lib, pkg_name, \"R\", pkg_name)\n lines <- readLines(load_script)\n lines <- append(lines,\n c(paste0(\"setHook(packageEvent(pkg, \\\"onLoad\\\"), function(...) options(covr.record_tests = \", record_tests, \"))\"),\n \"setHook(packageEvent(pkg, \\\"onLoad\\\"), function(...) covr:::trace_environment(ns))\",\n paste0(\"reg.finalizer(ns, function(...) { covr:::save_trace(\", trace_dir, \") }, onexit = TRUE)\")),\n length(lines) - 1L)\n\n if (fix_mcexit) {\n lines <- append(lines, sprintf(\"covr:::fix_mcexit('%s')\", trace_dir))\n }\n\n writeLines(text = lines, con = load_script)\n}\n\n#' @export\n`[.coverage` <- function(x, ...) {\n structure(NextMethod(), class = \"coverage\")\n}\n\n#' Determine if code is being run in covr\n#'\n#' covr functions set the environment variable `R_COVR` when they are running.\n#' [in_covr()] returns `TRUE` if this environment variable is set and `FALSE`\n#' otherwise.\n#' @export\n#' @examples\n#' if (require(testthat)) {\n#' testthat::skip_if(in_covr())\n#' }\nin_covr <- function() {\n identical(Sys.getenv(\"R_COVR\"), \"true\")\n}\n" }, { "path": "R/data_frame.R", "content": "#' @export\nas.data.frame.coverage <- function(x, row.names = NULL, optional = FALSE, sort = TRUE, ...) {\n column_names <- c(\"filename\", \"functions\", \"first_line\", \"first_byte\", \"last_line\", \"last_byte\",\n \"first_column\", \"last_column\", \"first_parsed\",\n \"last_parsed\", \"value\")\n\n res <- setNames(c(list(character(0)), rep(list(numeric(0)), times = length(column_names) - 1)),\n column_names)\n if (length(x)) {\n res$filename <- display_name(x)\n res$functions <- vcapply(x, function(xx) xx$functions[1])\n\n vals <- t(vapply(x,\n function(xx) c(xx$srcref, xx$value),\n numeric(9), USE.NAMES = FALSE))\n for (i in seq_len(NCOL(vals))) {\n res[[i + 2]] <- vals[, i]\n }\n }\n\n df <- data.frame(res, stringsAsFactors = FALSE, check.names = FALSE)\n\n if (sort) {\n # if we are sorting we no longer need to preserve the order of the input and can merge values together\n df <- merge_values(df)\n\n df <- df[order(df$filename, df$first_line, df$first_byte, df$last_line, df$last_byte), ]\n }\n\n rownames(df) <- NULL\n\n df\n}\n\nmerge_values <- function(x, sentinel = \"___NA___\") {\n if (NROW(x) == 0) {\n return(x)\n }\n # We can't use aggregate directly, because it doesn't allow missing values in\n # grouping variables...\n x$functions[is.na(x$functions)] <- sentinel\n res <- aggregate(value ~ ., x, sum)\n res$functions[res$functions == sentinel] <- NA_character_\n res\n}\n" }, { "path": "R/display_name.R", "content": "#' Retrieve the path name (filename) for each coverage object\n#'\n#' @param x A coverage object\n#' @keywords internal\n#' @export\ndisplay_name <- function(x) {\n stopifnot(inherits(x, \"coverage\"))\n if (length(x) == 0) {\n return()\n }\n\n filenames <- vcapply(x, function(x) get_source_filename(x$srcref, full.names = TRUE))\n to_relative_path(filenames, attr(x, \"root\"))\n}\n\nto_relative_path <- function(path, base) {\n if (is.null(base)) {\n return(path)\n }\n rex::re_substitutes(path, rex::rex(base, \"/\"), \"\")\n}\n\nfilter_non_package_files <- function(x) {\n filenames <- vcapply(x, function(x) get_source_filename(x$srcref, full.names = TRUE))\n x[rex::re_matches(filenames, rex::rex(attr(x, \"package\")$path, \"/\"), \"\")]\n}\n" }, { "path": "R/exclusions.R", "content": "#' Exclusions\n#'\n#' covr supports a couple of different ways of excluding some or all of a file.\n#'\n#' @section Line Exclusions:\n#'\n#' The `line_exclusions` argument to `package_coverage()` can be used\n#' to exclude some or all of a file. This argument takes a list of filenames\n#' or named ranges to exclude.\n#'\n#' @section Function Exclusions:\n#'\n#' Alternatively `function_exclusions` can be used to exclude R functions\n#' based on regular expression(s). For example `print\\\\\\.*` can be used to\n#' exclude all the print methods defined in a package from coverage.\n#'\n#' @section Exclusion Comments:\n#'\n#' In addition you can exclude lines from the coverage by putting special comments\n#' in your source code. This can be done per line or by specifying a range.\n#' The patterns used can be specified by the `exclude_pattern`, `exclude_start`,\n#' `exclude_end` arguments to `package_coverage()` or by setting the global\n#' options `covr.exclude_pattern`, `covr.exclude_start`, `covr.exclude_end`.\n\n#' @examples\n#' \\dontrun{\n#' # exclude whole file of R/test.R\n#' package_coverage(exclusions = \"R/test.R\")\n#'\n#' # exclude lines 1 to 10 and 15 from R/test.R\n#' package_coverage(line_exclusions = list(\"R/test.R\" = c(1:10, 15)))\n#'\n#' # exclude lines 1 to 10 from R/test.R, all of R/test2.R\n#' package_coverage(line_exclusions = list(\"R/test.R\" = 1:10, \"R/test2.R\"))\n#'\n#' # exclude all print and format methods from the package.\n#' package_coverage(function_exclusions = c(\"print\\\\.\", \"format\\\\.\"))\n#'\n#' # single line exclusions\n#' f1 <- function(x) {\n#' x + 1 # nocov\n#' }\n#'\n#' # ranged exclusions\n#' f2 <- function(x) { # nocov start\n#' x + 2\n#' } # nocov end\n#' }\n#' @name exclusions\nNULL\n\nexclude <- function(coverage,\n line_exclusions = NULL,\n function_exclusions = NULL,\n exclude_pattern = getOption(\"covr.exclude_pattern\"),\n exclude_start = getOption(\"covr.exclude_start\"),\n exclude_end = getOption(\"covr.exclude_end\"),\n path = NULL) {\n\n sources <- traced_files(coverage)\n\n source_exclusions <- lapply(sources,\n function(x) {\n parse_exclusions(x$file_lines, exclude_pattern, exclude_start, exclude_end)\n })\n\n excl <- normalize_exclusions(c(source_exclusions, line_exclusions), path)\n\n df <- as.data.frame(coverage, sort = FALSE)\n\n to_exclude <- rep(FALSE, length(coverage))\n\n if (!is.null(function_exclusions)) {\n to_exclude <- Reduce(`|`, init = to_exclude,\n Map(rex::re_matches, function_exclusions, MoreArgs = list(data = df$functions)))\n to_exclude[is.na(to_exclude)] <- FALSE\n }\n\n df$full_name <- vcapply(coverage,\n function(x) {\n normalize_path(get_source_filename(x$srcref, full.names = TRUE))\n })\n\n to_exclude <- to_exclude | vlapply(seq_len(NROW(df)),\n function(i) {\n file <- df[i, \"full_name\"]\n which_exclusion <- match(file, names(excl))\n\n !is.na(which_exclusion) &&\n (\n identical(excl[[which_exclusion]], Inf) ||\n all(seq(df[i, \"first_line\"], df[i, \"last_line\"]) %in% excl[[file]])\n )\n })\n\n if (any(to_exclude)) {\n coverage <- coverage[!to_exclude]\n }\n\n coverage\n}\n\nparse_exclusions <- function(lines,\n exclude_pattern = getOption(\"covr.exclude\"),\n exclude_start = getOption(\"covr.exclude_start\"),\n exclude_end = getOption(\"covr.exclude_end\")) {\n\n exclusions <- numeric(0)\n\n starts <- which(rex::re_matches(lines, exclude_start))\n ends <- which(rex::re_matches(lines, exclude_end))\n\n if (length(starts) > 0) {\n if (length(starts) != length(ends)) {\n starts_msg <- sprintf(\n ngettext(length(starts), \"%d range start (%s)\", \"%d range starts (%s)\"),\n length(starts), toString(starts)\n )\n ends_msg <- sprintf(\n ngettext(length(ends), \"%d range end (%s)\", \"%d range ends (%s)\"),\n length(ends), toString(ends)\n )\n stop(starts_msg, \" but only \", ends_msg, \" for exclusion from code coverage!\")\n }\n\n for (i in seq_along(starts)) {\n exclusions <- c(exclusions, seq(starts[i], ends[i]))\n }\n }\n\n exclusions <- c(exclusions, which(rex::re_matches(lines, exclude_pattern)))\n\n sort(unique(exclusions))\n}\n\nfile_exclusions <- function(x, path = NULL) {\n excl <- normalize_exclusions(x, path)\n\n full_files <- vlapply(excl, function(x1) length(x1) == 1 && x1 == Inf)\n if (any(full_files)) {\n names(excl)[full_files]\n } else {\n NULL\n }\n}\n\nnormalize_exclusions <- function(x, path = NULL) {\n if (is.null(x) || length(x) <= 0) {\n return(list())\n }\n\n # no named parameters at all\n if (is.null(names(x))) {\n x <- structure(relist(rep(Inf, length(x)), x), names = x)\n } else {\n unnamed <- names(x) == \"\"\n if (any(unnamed)) {\n\n # must be character vectors of length 1\n bad <- vlapply(seq_along(x),\n function(i) {\n unnamed[i] & (!is.character(x[[i]]) | length(x[[i]]) != 1)\n })\n\n if (any(bad)) {\n stop(\"Full file exclusions must be character vectors of length 1. items: \",\n paste(collapse = \", \", which(bad)),\n \" are not!\",\n call. = FALSE)\n }\n names(x)[unnamed] <- x[unnamed]\n x[unnamed] <- Inf\n }\n }\n\n if (!is.null(path)) {\n names(x) <- file.path(path, names(x))\n }\n names(x) <- normalize_path(names(x))\n\n remove_line_duplicates(\n remove_file_duplicates(\n compact(x)\n )\n )\n}\n\nremove_file_duplicates <- function(x) {\n unique_names <- unique(names(x))\n\n ## check for duplicate files\n if (length(unique_names) < length(names(x))) {\n x <- lapply(unique_names,\n function(name) {\n vals <- unname(unlist(x[names(x) == name]))\n if (any(vals == Inf)) {\n Inf\n } else {\n vals\n }\n })\n\n names(x) <- unique_names\n }\n\n x\n}\n\nremove_line_duplicates <- function(x) {\n x[] <- lapply(x, unique)\n\n x\n}\n\nparse_covr_ignore <- function(file = getOption(\"covr.covrignore\", Sys.getenv(\"COVR_COVRIGNORE\", \".covrignore\"))) {\n if (!file.exists(file)) {\n return(NULL)\n }\n lines <- readLines(file)\n paths <- Sys.glob(lines, dirmark = TRUE)\n files <- unlist(\n lapply(paths, function(x) {\n if (dir.exists(x)) {\n list.files(recursive = TRUE, all.files = TRUE, path = x, full.names = TRUE)\n } else {\n x\n }\n }))\n}\n" }, { "path": "R/gitlab.R", "content": "#' Run covr on package and create report for GitLab\n#'\n#' Utilize internal GitLab static pages to publish package coverage.\n#' Creates local covr report in a package subdirectory.\n#' Uses the [pages](https://docs.gitlab.com/user/project/pages/)\n#' GitLab job to publish the report.\n#' @inheritParams codecov\n#' @inheritParams report\n#' @export\ngitlab <- function(..., coverage = NULL, file = \"public/coverage.html\", quiet = TRUE) {\n if (is.null(coverage)) {\n coverage <- package_coverage(quiet = quiet, ...)\n }\n if (!quiet) {\n print(coverage)\n }\n\n out_file <- file.path(tempfile(), file)\n on.exit(unlink(out_dir, recursive = TRUE), add = TRUE)\n\n out_dir <- dirname(out_file)\n\n pkg_path <- attributes(coverage)$package$path\n\n report(coverage, file = out_file, browse = FALSE)\n\n file.copy(out_dir, pkg_path, recursive = TRUE)\n}\n" }, { "path": "R/icc.R", "content": "parse_icov <- function(lines, package_path = \"\") {\n\n source_file <- trim_ws(lines[1L])\n # If the source file does not start with the package path ignore it.\n if (!grepl(rex::rex(start, package_path), source_file)) {\n return(NULL)\n }\n\n # remove source file lines and empty/white space lines\n lines <- trim_ws(lines[-1L])\n lines <- lines[lines != \"\"]\n\n # get line, values, and functions\n r1 <- rex::re_matches(lines, rex::rex(\"function - \",\n capture(name = \"source\", anything),\n \"\\t\", digits, \"\\t\", digits, \"\\t\", digits, anything))$source\n idx1 <- which(!is.na(r1))\n\n re <- rex::rex(\n capture(name = \"instance\", digits), \"\\t\",\n capture(name = \"line\", digits), \"\\t\",\n capture(name = \"idcol\", digits), \"\\t\", any_spaces,\n capture(name = \"coverage\", digits))\n\n show_C_functions <- getOption(\"covr.showCfunctions\", FALSE)\n if (length(idx1) == 0L) {\n m1 <- rex::re_matches(lines, re)\n m1$functions <- rep(NA_character_, nrow(m1))\n } else {\n m1 <- rex::re_matches(lines[-idx1], re)\n if (isTRUE(show_C_functions)) {\n # get function names\n if (length(idx1) == 1L) {\n m1$functions <- rep(r1[idx1], nrow(m1))\n } else {\n stopifnot(idx1[1L] == 1L)\n nums <- c(idx1[2L:length(idx1)]-1L, length(r1)) - idx1\n stopifnot(sum(nums) == nrow(m1))\n m1$functions <- unlist(mapply(rep, r1[idx1], nums,\n SIMPLIFY=FALSE, USE.NAMES=FALSE))\n }\n }\n }\n # remove invalid rows if exists\n m1 <- na.omit(m1)\n m1$line <- as.numeric(m1$line)\n m1$coverage <- as.numeric(m1$coverage)\n if (is.null(m1$functions)) {\n m2 <- aggregate(m1$coverage, by = list(line=m1$line), sum)\n names(m2) <- c(\"line\", \"coverage\")\n m2$functions <- NA_character_\n } else {\n m2 <- aggregate(m1$coverage,\n by = list(line=m1$line, functions=m1$functions), sum)\n names(m2) <- c(\"line\", \"functions\", \"coverage\")\n }\n matches <- m2[order(m2$line), ]\n\n values <- as.numeric(matches$coverage > 0L)\n functions <- matches$functions\n\n line_coverages(source_file, matches, values, functions)\n}\n\nrun_icov <- function(path, quiet = TRUE,\n icov_path = getOption(\"covr.icov\", \"\"),\n icov_args = getOption(\"covr.icov_args\", NULL)) {\n\n src_path <- normalize_path(file.path(path, \"src\"))\n if (!file.exists(src_path)) {\n return()\n }\n\n if (!nzchar(icov_path)) {\n warning(\"icc codecov not available\")\n return()\n }\n\n icov_profmerge <- getOption(\"covr.icov_prof\", \"\")\n if (!nzchar(icov_profmerge)) {\n warning(\"icc profmerge not available\")\n return()\n }\n\n icov_inputs <- list.files(path, pattern = rex::rex(\".dyn\", end),\n recursive = TRUE, full.names = TRUE)\n if (length(icov_inputs) == 0L) {\n warning(\"no icc .dyn files are generated\")\n return()\n }\n\n system_check(icov_profmerge,\n args = c(\"-prof_dir\", src_path),\n quiet = quiet, echo = !quiet)\n\n withr::with_dir(src_path, {\n system_check(icov_path,\n args = c(\"-prj\", \"tmp\", \"-spi\", file.path(src_path, \"pgopti.spi\"),\n \"-dpi\", file.path(src_path, \"pgopti.dpi\"),\n \"-include-nonexec\",\n \"-txtbcvrg\", \"bcovg.log\"),\n quiet = quiet, echo = !quiet)\n })\n\n lines <- readLines(file.path(src_path, \"bcovg.log\"))\n\n # generate line coverage\n re <- rex::re_matches(lines, rex::rex(\"Covered Functions in File: \\\"\",\n capture(name = \"source\", anything), \"\\\"\"))$source\n idx1 <- which(!is.na(re))\n idx2 <- c(idx1[2:length(idx1)]-1, length(re))\n srcfilenms <- re[idx1]\n lines[idx1] <- srcfilenms\n icov_outputs <- lapply(seq_along(idx1), function(i) lines[idx1[i]:idx2[i]])\n\n structure(\n unlist(recursive = FALSE,\n lapply(icov_outputs, parse_icov, package_path = path)),\n class = \"coverage\")\n}\n\n# check if icc is used\nuses_icc <- function() {\n compiler <- tryCatch(\n {\n system2(file.path(R.home(\"bin\"), \"R\"),\n args = c(\"--vanilla\", \"CMD\", \"config\", \"CC\"),\n stdout = TRUE)\n },\n warning = function(e) NA_character_)\n isTRUE(any(grepl(\"\\\\bicc\\\\b\", compiler)))\n}\n" }, { "path": "R/parallel.R", "content": "# utility function to replace a symbol in a locked loaded package/namespace\nreplace_binding <- function(package, name, value) {\n ns <- getNamespace(package)\n unlock <- get('unlockBinding') # to fool r CMD check\n lock <- get('lockBinding')\n unlock(name, ns)\n assign(name, value, ns)\n lock(name, ns)\n}\n\n\n# patch parallel:::mcexit to force it to save the covr trace on exit\nfix_mcexit <- function(trace_dir) {\n get_from_ns <- `:::` # trick to fool R CMD check\n mcexit <- get_from_ns('parallel', 'mcexit')\n\n trace_dir <- parse(text = trace_dir)[[1]]\n\n # directly patch mcexit\n body(mcexit) <- as.call(append(after = 1, as.list(body(mcexit)),\n as.call(list(call(\":::\", as.symbol(\"covr\"), as.symbol(\"save_trace\")), trace_dir))))\n\n replace_binding('parallel', 'mcexit', mcexit)\n}\n\n\nuses_parallel <- function(pkg) {\n any(grepl(\"\\\\bparallel\\\\b\",\n pkg[c(\"depends\", \"imports\", \"suggests\", \"enhances\", \"linkingto\")]))\n}\n\non_windows <- function() {\n \"windows\" %in% tolower(Sys.info()[[\"sysname\"]])\n}\n\n# consider in that order: the environment variable COVR_FIX_PARALLEL_MCEXIT,\n# the option covr.fix_parallel_mcexit, or auto-detection of the usage of\n# parallel by the package (cf uses_parallel()).\nshould_enable_parallel_mcexit_fix <- function(pkg) {\n isTRUE(!on_windows() &&\n as.logical(Sys.getenv(\"COVR_FIX_PARALLEL_MCEXIT\",\n getOption(\"covr.fix_parallel_mcexit\",\n uses_parallel(pkg)))))\n}\n" }, { "path": "R/parse_data.R", "content": "#' @importFrom utils getParseData getSrcref tail\nimpute_srcref <- function(x, parent_ref) {\n if (!is_conditional_or_loop(x)) return(NULL)\n if (is.null(parent_ref)) return(NULL)\n\n pd <- get_tokens(parent_ref)\n pd_expr <-\n (\n (pd$line1 == parent_ref[[1L]] & pd$line2 == parent_ref[[3L]]) |\n (pd$line1 == parent_ref[[7L]] & pd$line2 == parent_ref[[8L]])\n ) &\n pd$col1 == parent_ref[[2L]] &\n pd$col2 == parent_ref[[4L]] &\n pd$token == \"expr\"\n pd_expr_idx <- which(pd_expr)\n if (length(pd_expr_idx) == 0L) return(NULL) # srcref not found in parse data\n\n if (length(pd_expr_idx) > 1) pd_expr_idx <- pd_expr_idx[[1]]\n\n expr_id <- pd$id[pd_expr_idx]\n pd_child <- pd[pd$parent == expr_id, ]\n pd_child <- pd_child[order(pd_child$line1, pd_child$col1), ]\n\n # exclude comments\n pd_child <- pd_child[pd_child$token != \"COMMENT\", ]\n\n if (pd$line1[pd_expr_idx] == parent_ref[[7L]] & pd$line2[pd_expr_idx] == parent_ref[[8L]]) {\n line_offset <- parent_ref[[7L]] - parent_ref[[1L]]\n } else {\n line_offset <- 0\n }\n\n make_srcref <- function(from, to = from) {\n if (length(from) == 0) {\n return(NULL)\n }\n\n srcref(\n attr(parent_ref, \"srcfile\"),\n c(pd_child$line1[from] - line_offset,\n pd_child$col1[from],\n pd_child$line2[to] - line_offset,\n pd_child$col2[to],\n pd_child$col1[from],\n pd_child$col2[to],\n pd_child$line1[from],\n pd_child$line2[to]\n )\n )\n }\n\n switch(\n as.character(x[[1L]]),\n \"if\" = {\n src_ref <- list(\n NULL,\n make_srcref(3),\n make_srcref(5),\n make_srcref(7)\n )\n # the fourth component isn't used for an \"if\" without \"else\"\n src_ref[seq_along(x)]\n },\n\n \"for\" = {\n list(\n NULL,\n NULL,\n make_srcref(2),\n make_srcref(3)\n )\n },\n\n \"while\" = {\n list(\n NULL,\n make_srcref(3),\n make_srcref(5)\n )\n },\n\n \"switch\" = {\n exprs <- tail(which(pd_child$token == \"expr\"), n = -1)\n\n # Add NULLs for drop through conditions\n token <- pd_child$token\n next_token <- c(tail(token, n = -1), NA_character_)\n drops <- which(token == \"EQ_SUB\" & next_token != \"expr\")\n\n exprs <- sort(c(exprs, drops))\n\n ignore_drop_through <- function(x) {\n if (x %in% drops) {\n return(NULL)\n }\n x\n }\n\n exprs <- lapply(exprs, ignore_drop_through)\n\n # Don't create srcrefs for ... conditions\n ignore_dots <- function(x) {\n if (identical(\"...\", pd$text[pd$parent == pd_child$id[x]])) {\n return(NULL)\n }\n x\n }\n\n exprs <- lapply(exprs, ignore_dots)\n\n c(list(NULL), lapply(exprs, make_srcref))\n },\n\n NULL\n )\n}\n\nis_conditional_or_loop <- function(x) is.symbol(x[[1L]]) && as.character(x[[1L]]) %in% c(\"if\", \"for\", \"else\", \"switch\")\n\npackage_parse_data <- new.env()\n\nget_parse_data <- function(srcfile) {\n if (length(package_parse_data) == 0) {\n lines <- getSrcLines(srcfile, 1L, Inf)\n lines_split <- split_on_line_directives(lines)\n if (!length(lines_split)) {\n return(NULL)\n }\n\n res <- lapply(lines_split,\n function(x) getParseData(parse(text = x, keep.source = TRUE), includeText = TRUE))\n for (i in seq_along(res)) {\n package_parse_data[[names(res)[[i]]]] <- res[[i]]\n }\n }\n package_parse_data[[srcfile[[\"filename\"]]]]\n}\n\nclean_parse_data <- function() {\n rm(list = ls(package_parse_data), envir = package_parse_data)\n}\n\nget_tokens <- function(srcref) {\n # Before R 4.4.0, covr's custom get_parse_data is necessary because\n # utils::getParseData returns parse data for only the last file in the\n # package. That issue (bug#16756) is fixed in R 4.4.0 (r84538).\n #\n # On R 4.4.0, continue to use get_parse_data because covr's code expects the\n # result to be limited to the srcref file. getParseData will return parse data\n # for all of the package's files.\n get_parse_data(attr(getSrcref(srcref), \"srcfile\")) %||%\n # This covers the non-installed file case where the source file isn't a\n # concatenated file with \"line N\" directives.\n getParseData(srcref)\n}\n" }, { "path": "R/replace.R", "content": "#' @useDynLib covr, .registration = TRUE\nreplacement <- function(name, env = as.environment(-1), target_value = get(name, envir = env)) {\n if (is.function(target_value) && !is.primitive(target_value)) {\n if (is_vectorized(target_value)) {\n new_value <- target_value\n environment(new_value)$FUN <- trace_calls(environment(new_value)$FUN, name)\n } else if (is.function(target_value) && inherits(target_value, \"memoised\")) {\n new_value <- target_value\n environment(new_value)$`_f` <- trace_calls(environment(new_value)$`_f`, name)\n } else {\n new_value <- trace_calls(target_value, name)\n attributes(body(new_value)) <- attributes(body(target_value))\n }\n attributes(new_value) <- attributes(target_value)\n\n if (isS4(target_value)) {\n new_value <- asS4(new_value)\n }\n\n list(\n env = env,\n name = as.name(name),\n orig_value = .Call(covr_duplicate_, target_value),\n target_value = target_value,\n new_value = new_value\n )\n }\n}\n\nreplace <- function(replacement) {\n .Call(covr_reassign_function, replacement$target_value, replacement$new_value)\n}\n\nreset <- function(replacement) {\n .Call(covr_reassign_function, replacement$target_value, replacement$orig_value)\n}\n" }, { "path": "R/report.R", "content": "#' Display covr results using a standalone report\n#'\n#' @param x a coverage dataset, defaults to running `package_coverage()`.\n#' @param file The report filename.\n#' @param browse whether to open a browser to view the report.\n#' @examples\n#' \\dontrun{\n#' x <- package_coverage()\n#' report(x)\n#' }\n#' @export\n# This function was originally a shiny application, but has now been converted into\n# a normal static document and no longer depends on shiny.\nreport <- function(x = package_coverage(),\n file = file.path(tempdir(), paste0(get_package_name(x), \"-report.html\")),\n browse = interactive()) {\n\n # Create any directories as needed\n dir.create(dirname(file), recursive = TRUE, showWarnings = FALSE)\n\n # Paths need to be absolute for save_html to work properly\n file <- file.path(normalizePath(dirname(file), mustWork = TRUE), basename(file))\n\n if (!(requireNamespace(\"htmltools\", quietly = TRUE) && requireNamespace(\"DT\", quietly = TRUE))) {\n stop(\"The `DT` and `htmltools` packages must be installed to use `covr::report()`\", call. = FALSE)\n }\n\n data <- to_report_data(x)\n\n # Color the td cells by coverage amount, like codecov.io does\n color_coverage_callback <- DT::JS(\n'function(td, cellData, rowData, row, col) {\n var percent = cellData.replace(\"%\", \"\");\n if (percent > 90) {\n var grad = \"linear-gradient(90deg, #edfde7 \" + cellData + \", white \" + cellData + \")\";\n } else if (percent > 75) {\n var grad = \"linear-gradient(90deg, #f9ffe5 \" + cellData + \", white \" + cellData + \")\";\n } else {\n var grad = \"linear-gradient(90deg, #fcece9 \" + cellData + \", white \" + cellData + \")\";\n }\n $(td).css(\"background\", grad);\n}\n')\n\n # Open a new file in the source tab and switch to it\n file_choice_callback <- DT::JS(\n\"table.on('click.dt', 'a', function() {\n files = $('div#files div');\n files.not('div.hidden').addClass('hidden');\n id = $(this).text();\n files.filter('div[id=\\\\'' + id + '\\\\']').removeClass('hidden');\n $('ul.nav a[data-value=Source]').text(id).tab('show');\n});\")\n\n package_name <- attr(x, \"package\")$package\n percentage <- sprintf(\"%02.2f%%\", data$overall)\n\n table <- DT::datatable(\n data$file_stats,\n escape = FALSE,\n fillContainer = FALSE,\n options = list(\n searching = FALSE,\n dom = \"t\",\n paging = FALSE,\n columnDefs = list(\n list(targets = 6, createdCell = color_coverage_callback))),\n rownames = FALSE,\n class = \"row-border\",\n callback = file_choice_callback\n )\n table$sizingPolicy$defaultWidth <- \"100%\"\n table$sizingPolicy$defaultHeight <- NULL\n\n ui <- fluid_page(\n htmltools::includeCSS(system.file(\"www/report.css\", package = \"covr\")),\n column(8, offset = 2, size = \"md\",\n htmltools::HTML(paste0(\"

\", package_name, \" coverage - \", percentage, \"

\")),\n tabset_panel(\n tab_panel(\"Files\",\n table\n ),\n tab_panel(\"Source\", addHighlight(renderSourceTable(data$full)))\n )\n )\n )\n\n htmltools::save_html(ui, file)\n viewer <- getOption(\"viewer\", utils::browseURL)\n if (browse) {\n viewer(file)\n }\n invisible(file)\n}\n\n#' A coverage report for a specific file\n#'\n#' @inheritParams report\n#' @param file The file to report on, if `NULL`, use the first file in the\n#' coverage output.\n#' @param out_file The output file\n#' @export\nfile_report <- function(x = package_coverage(), file = NULL, out_file = file.path(tempdir(), paste0(get_package_name(x), \"-file-report.html\")), browse = interactive()) {\n loadNamespace(\"htmltools\")\n loadNamespace(\"DT\")\n\n files <- display_name(x)\n\n if (is.null(file)) {\n file <- files[[1]]\n }\n stopifnot(length(file) == 1)\n\n x <- x[files %in% file]\n\n data <- to_report_data(x)\n\n percentage <- data$file_stats$Coverage\n\n ui <- fluid_page(\n htmltools::includeCSS(system.file(\"www/report.css\", package = \"covr\")),\n column(8, offset = 2, size = \"md\",\n htmltools::HTML(paste0(\"

\", file, \" - \", percentage, \"

\")),\n addHighlight(\n renderSourceTable(data$full, \"\")\n )\n )\n )\n\n htmltools::save_html(ui, out_file)\n viewer <- getOption(\"viewer\", utils::browseURL)\n if (browse) {\n viewer(out_file)\n }\n\n invisible(out_file)\n}\n\nto_report_data <- function(x) {\n coverages <- per_line(x)\n\n res <- list()\n res$overall <- percent_coverage(x)\n res$full <- lapply(coverages,\n function(coverage) {\n lines <- coverage$file$file_lines\n values <- coverage$coverage\n values[is.na(values)] <- \"\"\n data.frame(\n line = seq_along(lines),\n source = lines,\n coverage = values,\n stringsAsFactors = FALSE)\n })\n nms <- names(coverages)\n\n # set a temp name if it doesn't exist\n nms[nms == \"\"] <- \"\"\n\n names(res$full) <- nms\n\n res$file_stats <- compute_file_stats(res$full)\n\n res$file_stats$File <- add_link(names(res$full))\n\n res$file_stats <- sort_file_stats(res$file_stats)\n\n res$file_stats$Coverage <- res$file_stats$Coverage\n\n res\n}\n\ncompute_file_stats <- function(files) {\n do.call(\"rbind\",\n lapply(files,\n function(file) {\n data.frame(\n Coverage = sprintf(\"%.2f%%\", sum(file$coverage > 0) / sum(file$coverage != \"\") * 100),\n Lines = NROW(file),\n Relevant = sum(file$coverage != \"\"),\n Covered = sum(file$coverage > 0),\n Missed = sum(file$coverage == 0),\n `Hits / Line` = sprintf(\"%.0f\", sum(as.numeric(file$coverage), na.rm = TRUE) / sum(file$coverage != \"\")),\n stringsAsFactors = FALSE,\n check.names = FALSE)\n }\n )\n )\n}\n\nsort_file_stats <- function(stats) {\n stats[order(as.numeric(sub(\"%\", \"\", stats$Coverage)), -stats$Relevant),\n c(\"File\", \"Lines\", \"Relevant\", \"Covered\", \"Missed\", \"Hits / Line\", \"Coverage\")]\n}\n\nadd_link <- function(files) {\n vcapply(files, function(file) { as.character(htmltools::a(href = \"#\", file)) })\n}\n\nrenderSourceTable <- function(data, class = \"hidden\") {\n\n htmltools::div(id = \"files\",\n Map(function(lines, file) {\n htmltools::div(id = file, class=class,\n htmltools::tags$table(class = \"table-condensed\",\n htmltools::tags$tbody(\n lapply(seq_len(NROW(lines)),\n function(row_num) {\n coverage <- lines[row_num, \"coverage\"]\n\n cov_type <- NULL\n if (coverage == 0) {\n cov_value <- \"!\"\n cov_type <- \"missed\"\n } else if (coverage > 0) {\n cov_value <- htmltools::HTML(paste0(lines[row_num, \"coverage\"], \"x\", collapse = \"\"))\n cov_type <- \"covered\"\n } else {\n cov_type <- \"never\"\n cov_value <- \"\"\n }\n htmltools::tags$tr(class = cov_type,\n htmltools::tags$td(class = \"num\", lines[row_num, \"line\"]),\n htmltools::tags$td(class = \"coverage\", cov_value),\n htmltools::tags$td(class = \"col-sm-12\", htmltools::pre(class = \"language-r\", lines[row_num, \"source\"]))\n )\n })\n )\n ))\n }, lines = data, file = names(data)),\n htmltools::tags$script(\n \"$('div#files pre').each(function(i, block) {\n hljs.highlightBlock(block);\n});\"))\n}\n\naddHighlight <- function(x = list()) {\n highlight <- htmltools::htmlDependency(\"highlight.js\", \"6.2\",\n system.file(package = \"covr\",\n \"www/shared/highlight.js\"),\n script = \"highlight.pack.js\",\n stylesheet = \"rstudio.css\")\n\n htmltools::attachDependencies(x, c(htmltools::htmlDependencies(x), list(highlight)))\n}\n\naddin_report <- function() {\n loadNamespace(\"rstudioapi\")\n\n project <- rstudioapi::getActiveProject()\n\n covr::report(covr::package_coverage(project %||% getwd()))\n}\n\n# These are all adapted from functions in shiny\n\ncolumn <- function(width, ..., offset = 0, size = c(\"xs\", \"sm\", \"md\", \"lg\")) {\n size <- match.arg(size)\n\n col_class <- paste0(\"col-\", size, \"-\", width)\n if (offset > 0) {\n col_class <- paste0(col_class, \" \", \"col-\", size, \"-offset-\", offset)\n }\n htmltools::div(class = col_class, ...)\n}\n\ntab_panel <- function(title, ..., value = title) {\n htmltools::div(class = \"tab-pane\", title = title, `data-value` = value, ...)\n}\n\nfluid_page <- function(...) {\n bootstrap_page(\n htmltools::div(class = \"container-fluid\", ...)\n )\n}\n\nbootstrap_page <- function(...) {\n htmltools::attachDependencies(htmltools::tagList(list(...)), html_dependency_bootstrap())\n}\n\n# from htmldeps::html_dependency_bootstrap (not yet on CRAN)\nhtml_dependency_bootstrap <- function () {\n htmltools::htmlDependency(name = \"bootstrap\", version = \"3.3.5\",\n src = system.file(file = \"www/shared/bootstrap\", package = \"covr\"),\n meta = list(viewport = \"width=device-width, initial-scale=1\"),\n script = c(\"js/bootstrap.min.js\", \"shim/html5shiv.min.js\", \"shim/respond.min.js\"),\n stylesheet = c(\"css/bootstrap.min.css\", \"css/bootstrap-theme.min.css\")\n )\n}\n\ntabset_panel <- function(...) {\n tabset <- build_tabset(list(...))\n htmltools::div(class = \"tabbable\",\n tabset$nav_list,\n tabset$content)\n}\n\nbuild_tabset <- function(tabs) {\n tabset_id <- \"covr\"\n tabs <- lapply(seq_len(length(tabs)), build_tab_item, tabs = tabs, tabset_id = tabset_id)\n list(nav_list = ul(class = \"nav nav-tabs\", `data-tabsetid` = tabset_id, lapply(tabs, \"[[\", 1)),\n content = htmltools::div(class = \"tab-content\", `data-tabsetid` = tabset_id, lapply(tabs, \"[[\", 2))\n )\n}\n\nbuild_tab_item <- function(i, tabs, tabset_id) {\n\n div_tag <- tabs[[i]]\n tab_id <- paste(\"tab\", tabset_id, i, sep = \"-\")\n li_tag <- li(\n htmltools::a(href = paste0(\"#\", tab_id),\n `data-toggle` = \"tab\",\n `data-value` = div_tag$attribs$`data-value`,\n div_tag$attribs$title\n )\n )\n if (i == 1) {\n li_tag$attribs$class <- \"active\"\n div_tag$attribs$class <- paste(div_tag$attribs$class, \"active\")\n }\n div_tag$attribs$id <- tab_id\n\n list(li_tag = li_tag, div_tag = div_tag)\n}\n\nli <- function(...) htmltools::tag(\"li\", list(...))\nul <- function(...) htmltools::tag(\"ul\", list(...))\n" }, { "path": "R/sonarqube.R", "content": "#' Create a SonarQube Generic XML file for test coverage according to\n#' https://docs.sonarqube.org/latest/analysis/generic-test/\n#' Based on cobertura.R\n#'\n#' This functionality requires the xml2 package be installed.\n#' @param cov the coverage object returned from [package_coverage()]\n#' @param filename the name of the SonarQube Generic XML file\n#' @author Talkdesk Inc.\n#' @export\nto_sonarqube <- function(cov, filename = \"sonarqube.xml\"){\n\n loadNamespace(\"xml2\")\n\n df <- tally_coverage(cov, by = \"line\")\n\n d <- xml2::xml_new_document()\n\n top <- xml2::xml_add_child(d, \"coverage\", version = \"1\")\n\n files <- unique(df$filename)\n\n for (f in files){\n file <- xml2::xml_add_child(top, \"file\", path = paste(attr(cov, \"package\")$package, \"/\", as.character(f), sep=\"\"))\n\n for (fun_name in unique(na.omit(df[df$filename == f, \"functions\"]))) {\n fun_lines <- which(df$functions == fun_name & df$filename == f)\n for (i in fun_lines){\n line <- df[i, ]\n xml2::xml_add_child(file, \"lineToCover\", lineNumber = as.character(line$line),\n covered = tolower(as.character(line$value>0)))\n }\n }\n }\n\n xml2::write_xml(d, file = filename)\n\n invisible(d)\n}\n" }, { "path": "R/summary_functions.R", "content": "#' Provide percent coverage of package\n#'\n#' Calculate the total percent coverage from a coverage result object.\n#' @param x the coverage object returned from [package_coverage()]\n#' @param ... additional arguments passed to [tally_coverage()]\n#' @return The total percentage as a `numeric(1)`.\n#' @export\npercent_coverage <- function(x, ...) {\n res <- tally_coverage(x, ...)\n\n (sum(res$value > 0) / length(res$value)) * 100\n}\n\n#' Tally coverage by line or expression\n#'\n#' @inheritParams percent_coverage\n#' @param by whether to tally coverage by line or expression\n#' @return a `data.frame` of coverage tallied by line or expression.\n#' @export\ntally_coverage <- function(x, by = c(\"line\", \"expression\")) {\n\n # Rarely something goes wrong with the source references and we get all NAs\n # for them, so we omit them here\n df <- as.data.frame(x)\n\n all_na_rows <- rowSums(is.na(df)) == ncol(df)\n df <- df[!all_na_rows, ]\n\n if (NROW(df) == 0) {\n return(df)\n }\n\n by <- match.arg(by)\n\n switch(by,\n \"line\" = {\n\n # if it already has a line column it has already been tallied.\n if (!is.null(df$line)) {\n return(df)\n }\n\n # aggregate() can't cope with zero-length data frames anyway.\n if (nrow(df) == 0L) {\n return(NULL)\n }\n\n # results with NA functions (such as from compiled code) are dropped\n # unless NA is a level.\n df$functions <- addNA(df$functions)\n res <- expand_lines(df)\n\n res <- aggregate(value ~ filename + functions + line,\n data = res, FUN = min, na.action = na.pass)\n res$functions <- as.character(res$functions)\n\n # exclude blank lines from results\n if (inherits(x, \"coverage\")) {\n srcfiles <- unique(lapply(x, function(x) attr(x$srcref, \"srcfile\")))\n\n srcfile_names <- vcapply(srcfiles, `[[`, \"filename\")\n\n srcfile_names <- to_relative_path(srcfile_names, attr(x, \"root\"))\n\n blank_lines <- compact(\n setNames(lapply(srcfiles, function(srcfile) attr(srcfile_lines(srcfile), \"blanks\")),\n srcfile_names))\n\n if (length(blank_lines)) {\n blank_lines <- utils::stack(blank_lines)\n\n\n non_blanks <- setdiff.data.frame(\n res,\n blank_lines,\n by.x = c(\"filename\", \"line\"),\n by.y = c(\"ind\", \"values\"))\n\n res <- res[non_blanks, ]\n }\n res\n }\n res[order(res$filename, res$line), ]\n },\n\n \"expression\" = df\n )\n}\n\n#' Provide locations of zero coverage\n#'\n#' When examining the test coverage of a package, it is useful to know if there are\n#' any locations where there is **0** test coverage.\n#'\n#' @param x a coverage object returned [package_coverage()]\n#' @param ... additional arguments passed to\n#' [tally_coverage()]\n#' @return A `data.frame` with coverage data where the coverage is 0.\n#' @details if used within RStudio this function outputs the results using the\n#' Marker API.\n#' @export\nzero_coverage <- function(x, ...) {\n coverage_data <- tally_coverage(x, ...)\n coverage_data <- coverage_data[coverage_data$value == 0, , drop = FALSE]\n\n res <- coverage_data[\n # need to use %in% rather than explicit indexing because\n # tally_coverage returns a df without the columns if\n # by is equal to \"line\"\n colnames(coverage_data) %in%\n c(\"filename\",\n \"functions\",\n \"line\",\n \"first_line\",\n \"last_line\",\n \"first_column\",\n \"last_column\",\n \"value\")]\n\n if (getOption(\"covr.rstudio_source_markers\", TRUE) &&\n rstudioapi::hasFun(\"sourceMarkers\")) {\n markers <- markers(coverage_data)\n rstudioapi::callFun(\"sourceMarkers\",\n name = \"covr\",\n markers = markers,\n basePath = attr(x, \"package\")$path,\n autoSelect = \"first\")\n invisible(res)\n } else {\n res\n }\n}\n\n#' Print a coverage object\n#'\n#' @param x the coverage object to be printed\n#' @param group whether to group coverage by filename or function\n#' @param by whether to count coverage by line or expression\n#' @param ... additional arguments ignored\n#' @return The coverage object (invisibly).\n#' @export\nprint.coverage <- function(x, group = c(\"filename\", \"functions\"), by = \"line\", ...) {\n\n if (length(x) == 0) {\n return()\n }\n group <- match.arg(group)\n\n type <- attr(x, \"type\")\n\n if (is.null(type) || type == \"none\") {\n type <- NULL\n }\n\n df <- tally_coverage(x, by = by)\n\n if (!NROW(df)) {\n return(invisible())\n }\n\n percents <- tapply(df$value, df[[group]], FUN = function(x) (sum(x > 0) / length(x)) * 100)\n\n overall_percentage <- percent_coverage(df, by = by)\n\n msg <- cli::format_message(paste0(\n cli::style_bold(\n \"{attr(x, 'package')$package} {to_title(type)} Coverage: \"\n ),\n format_percentage(overall_percentage)\n ))\n message(msg)\n by_coverage <- percents[order(percents,\n names(percents))]\n\n for (i in seq_along(by_coverage)) {\n msg <- cli::format_message(\n paste0(\n cli::style_bold(names(by_coverage)[i], \": \"),\n format_percentage(by_coverage[i])\n )\n )\n message(msg)\n }\n invisible(x)\n}\n\n#' @export\nprint.coverages <- function(x, ...) {\n for (i in seq_along(x)) {\n # Add a blank line between consecutive coverage items\n if (i != 1) {\n message()\n }\n print(x[[i]], ...)\n }\n invisible(x)\n}\n\nformat_percentage <- function(x) {\n color <- if (x >= 90) cli::col_green\n else if (x >= 75) cli::col_yellow\n else cli::col_red\n\n color(sprintf(\"%02.2f%%\", x))\n}\n\nmarkers <- function(x, ...) UseMethod(\"markers\")\n\n#' @export\nmarkers.coverages <- function(x, ...) {\n mrks <- unlist(lapply(unname(x), markers), recursive = FALSE)\n\n mrks <- mrks[order(\n vcapply(mrks, `[[`, \"file\"),\n viapply(mrks, `[[`, \"line\"),\n vcapply(mrks, `[[`, \"message\")\n )]\n\n # request source markers\n rstudioapi::callFun(\"sourceMarkers\",\n name = \"covr\",\n markers = mrks,\n basePath = NULL,\n autoSelect = \"first\")\n invisible()\n}\n#' @export\nmarkers.coverage <- function(x, ...) {\n\n # generate the markers\n markers <- lapply(unname(x), function(xx) {\n filename <- get_source_filename(xx$srcref, full.names = TRUE)\n\n list(\n type = \"warning\",\n file = filename,\n line = xx$srcref[1],\n column = xx$srcref[2],\n message = sprintf(\"No %s Coverage!\", to_title(attr(x, \"type\")))\n )\n })\n\n}\n\n#' @export\nmarkers.data.frame <- function(x, ..., type = \"test\") { # nolint\n # generate the markers\n markers <- Map(function(filename, line, column) {\n list(\n type = \"warning\",\n file = filename,\n line = line,\n column = column %||% 1,\n message = sprintf(\"No %s Coverage!\", to_title(type))\n )},\n x$filename,\n x$first_line %||% x$line,\n x$first_column %||% rep(list(NULL), NROW(x)),\n USE.NAMES = FALSE)\n}\n\n# Expand lines given as start and end ranges to enumerate each line\nexpand_lines <- function(x) {\n repeats <- (x$last_line - x$first_line) + 1L\n\n lines <- unlist(Map(seq, x$first_line, x$last_line)) %||% integer()\n\n res <- x[rep(seq_len(NROW(x)), repeats), c(\"filename\", \"functions\", \"value\")]\n res$line <- lines\n rownames(res) <- NULL\n res\n}\n" }, { "path": "R/system.R", "content": "#' Run a system command and check if it succeeds.\n#'\n#' This function automatically quotes both the command and each\n#' argument so they are properly protected from shell expansion.\n#' @param cmd the command to run.\n#' @param args a vector of command arguments.\n#' @param env a named character vector of environment variables. Will be quoted\n#' @param quiet if `TRUE`, the command output will be echoed.\n#' @param echo if `TRUE`, the command to run will be echoed.\n#' @param ... additional arguments passed to [base::system()]\n#' @return `TRUE` if the command succeeds, an error will be thrown if the\n#' command fails.\n#' @keywords internal\nsystem_check <- function(cmd, args = character(), env = character(),\n quiet = FALSE, echo = FALSE, ...) {\n full <- paste(c(shQuote(cmd), lapply(args, shQuote)), collapse = \" \")\n\n if (echo) {\n message(wrap_command(full), \"\\n\")\n }\n\n status <- withr::with_envvar(env,\n system(full, intern = FALSE, ignore.stderr = quiet, ignore.stdout = quiet, ...)\n )\n\n if (!identical(as.character(status), \"0\")) {\n stop(\"Command \", sQuote(full), \" failed (\", status, \")\", call. = FALSE)\n }\n\n invisible(TRUE)\n}\n\n#' Run a system command and capture the output.\n#'\n#' This function automatically quotes both the command and each\n#' argument so they are properly protected from shell expansion.\n#' @inheritParams system_check\n#' @return command output if the command succeeds, an error will be thrown if\n#' the command fails.\n#' @keywords internal\nsystem_output <- function(cmd, args = character(), env = character(),\n quiet = FALSE, echo = FALSE, ...) {\n full <- paste(c(shQuote(cmd), lapply(args, shQuote)), collapse = \" \")\n\n if (echo) {\n message(wrap_command(full), \"\\n\")\n }\n result <- withCallingHandlers(withr::with_envvar(env,\n system(full, intern = TRUE, ignore.stderr = quiet, ...)\n ), warning = function(w) stop(w))\n\n result\n}\n\nwrap_command <- function(x) {\n lines <- strwrap(x, getOption(\"width\") - 2, exdent = 2)\n continue <- c(rep(\" \\\\\", length(lines) - 1), \"\")\n paste(lines, continue, collapse = \"\\n\")\n}\n" }, { "path": "R/trace_calls.R", "content": "#' trace each call with a srcref attribute\n#'\n#' This function calls itself recursively so it can properly traverse the AST.\n#' @param x the call\n#' @param parent_functions the functions which this call is a child of.\n#' @param parent_ref argument used to set the srcref of the current call during\n#' the recursion.\n#' @seealso \n#' @return a modified expression with count calls inserted before each previous\n#' call.\n#' @keywords internal\ntrace_calls <- function (x, parent_functions = NULL, parent_ref = NULL) {\n\n # Construct the calls by hand to avoid a NOTE from R CMD check\n count <- function(key, val) {\n call(\"if\", TRUE,\n call(\"{\",\n as.call(list(call(\":::\", as.symbol(\"covr\"), as.symbol(\"count\")), key)),\n val\n )\n )\n }\n\n if (is.null(parent_functions)) {\n parent_functions <- deparse(substitute(x))\n }\n recurse <- function(y) {\n lapply(y, trace_calls, parent_functions = parent_functions)\n }\n\n if (is.atomic(x) || is.name(x) || is.null(x)) {\n if (is.null(parent_ref)) {\n x\n } else {\n if (is_na(x) || is_brace(x)) {\n x\n } else {\n key <- new_counter(parent_ref, parent_functions) # nolint\n count(key, x)\n }\n }\n } else if (is.call(x)) {\n src_ref <- attr(x, \"srcref\") %||% impute_srcref(x, parent_ref)\n if ((identical(x[[1]], as.name(\"<-\")) || identical(x[[1]], as.name(\"=\"))) && # nolint\n (is.call(x[[3]]) && identical(x[[3]][[1]], as.name(\"function\")))) {\n parent_functions <- c(parent_functions, as.character(x[[2]]))\n }\n\n # do not try to trace curly curly\n if (identical(x[[1]], as.name(\"{\")) && length(x) == 2 && is.call(x[[2]]) && identical(x[[2]][[1]], as.name(\"{\"))) {\n as.call(x)\n } else if (!is.null(src_ref)) {\n as.call(Map(trace_calls, x, src_ref, MoreArgs = list(parent_functions = parent_functions)))\n } else if (!is.null(parent_ref)) {\n key <- new_counter(parent_ref, parent_functions)\n count(key, as.call(recurse(x)))\n } else {\n as.call(recurse(x))\n }\n } else if (is.function(x)) {\n\n # We cannot trace primitive functions\n if (is.primitive(x)) {\n return(x)\n }\n\n fun_body <- body(x)\n\n if (!is.null(attr(x, \"srcref\")) &&\n (is.symbol(fun_body) || !identical(fun_body[[1]], as.name(\"{\")))) {\n src_ref <- attr(x, \"srcref\")\n key <- new_counter(src_ref, parent_functions)\n fun_body <- count(key, trace_calls(fun_body, parent_functions))\n } else {\n fun_body <- trace_calls(fun_body, parent_functions)\n }\n\n new_formals <- trace_calls(formals(x), parent_functions)\n if (is.null(new_formals)) new_formals <- list()\n formals(x) <- new_formals\n body(x) <- fun_body\n x\n } else if (is.pairlist(x)) {\n as.pairlist(recurse(x))\n } else if (is.expression(x)) {\n as.expression(recurse(x))\n } else if (is.list(x)) {\n recurse(x)\n } else {\n message(\"Unknown language class: \", paste(class(x), collapse = \"/\"))\n x\n }\n}\n\n.counters <- new.env(parent = emptyenv())\n.current_test <- new.env(parent = emptyenv())\n\n#' initialize a new counter\n#'\n#' @param src_ref a [base::srcref()]\n#' @param parent_functions the functions that this srcref is contained in.\n#' @keywords internal\nnew_counter <- function(src_ref, parent_functions) {\n key <- key(src_ref)\n .counters[[key]]$value <- 0\n .counters[[key]]$srcref <- src_ref\n .counters[[key]]$functions <- parent_functions\n if (isTRUE(getOption(\"covr.record_tests\", FALSE))) new_test_counter(key)\n key\n}\n\n#' increment a given counter\n#'\n#' @param key generated with [key()]\n#' @keywords internal\ncount <- function(key) {\n .counters[[key]]$value <- .counters[[key]]$value + 1L\n if (isTRUE(.current_test$record)) count_test(key)\n}\n\n#' clear all previous counters\n#'\n#' @keywords internal\nclear_counters <- function() {\n rm(envir = .counters, list = ls(envir = .counters))\n rm(envir = .current_test, list = ls(envir = .current_test))\n .current_test$record <- isTRUE(getOption(\"covr.record_tests\", FALSE))\n}\n\n#' Generate a key for a call\n#'\n#' @param x the srcref of the call to create a key for\n#' @keywords internal\nkey <- function(x) {\n paste(collapse = \":\", c(get_source_filename(x), x))\n}\n" }, { "path": "R/trace_tests.R", "content": "#' Record Test Traces During Coverage Execution\n#'\n#' By setting `options(covr.record_tests = TRUE)`, the result of covr coverage\n#' collection functions will include additional data pertaining to the tests\n#' which are executed and an index of which tests, at what stack depth, trigger\n#' the execution of each trace.\n#'\n#' This functionality requires that the package code and tests are installed and\n#' sourced with the source. For more details, refer to R options, `keep.source`,\n#' `keep.source.pkgs` and `keep.parse.data.pkgs`.\n#'\n#' @section Additional fields:\n#'\n#' Within the `covr` result, you can explore this information in two places:\n#'\n#' \\itemize{\n#' \\item `attr(,\"tests\")`: A list of call stacks, which results in target code\n#' execution.\n#'\n#' \\item `$$tests`: For each srcref count in the coverage object, a\n#' `$tests` field is now included which contains a matrix with three columns,\n#' \"test\", \"call\", \"depth\" and \"i\" which specify the test number\n#' (corresponding to the index of the test in `attr(,\"tests\")`, the number\n#' of times the test expression was evaluated to produce the trace hit, the\n#' stack depth into the target code where the trace was executed, and the\n#' order of execution for each test.\n#' }\n#'\n#' @section Test traces:\n#'\n#' The content of test traces are dependent on the unit testing framework that\n#' is used by the target package. The behavior is contingent on the available\n#' information in the sources kept for the testing files.\n#'\n#' Test traces are extracted by the following criteria:\n#'\n#' 1. If any `srcref` files are are provided by a file within [covr]'s temporary\n#' library, all calls from those files are kept as a test trace. This will\n#' collect traces from tests run with common testing frameworks such as\n#' `testthat` and `RUnit`.\n#' 1. Otherwise, as a conservative fallback in situations where no source\n#' references are found, or when none are from within the temporary\n#' directory, the entire call stack is collected.\n#'\n#' These calls are subsequently subset for only those up until the call to\n#' [covr]'s internal `count` function, and will always include the last call in\n#' the call stack prior to a call to `count`.\n#'\n#' @examples\n#' fcode <- '\n#' f <- function(x) {\n#' if (x)\n#' f(!x)\n#' else\n#' FALSE\n#' }'\n#'\n#' options(covr.record_tests = TRUE)\n#' cov <- code_coverage(fcode, \"f(TRUE)\")\n#'\n#' # extract executed test code for the first test\n#' tail(attr(cov, \"tests\")[[1L]], 1L)\n#' # [[1]]\n#' # f(TRUE)\n#'\n#' # extract test itemization per trace\n#' cov[[3]][c(\"srcref\", \"tests\")]\n#' # $srcref\n#' # f(!x)\n#' #\n#' # $tests\n#' # test call depth i\n#' # [1,] 1 1 2 4\n#'\n#' # reconstruct the code path of a test by ordering test traces by [,\"i\"]\n#' lapply(cov, `[[`, \"tests\")\n#' # $`source.Ref2326138c55:4:6:4:10:6:10:4:4`\n#' # test call depth i\n#' # [1,] 1 1 1 2\n#' #\n#' # $`source.Ref2326138c55:3:8:3:8:8:8:3:3`\n#' # test call depth i\n#' # [1,] 1 1 1 1\n#' # [2,] 1 1 2 3\n#' #\n#' # $`source.Ref2326138c55:6:6:6:10:6:10:6:6`\n#' # test call depth i\n#' # [1,] 1 1 2 4\n#'\n#' @name covr.record_tests\nNULL\n\n#' Append a test trace to a counter, updating global current test\n#'\n#' @param key generated with [key()]\n#' @keywords internal\n#'\ncount_test <- function(key) {\n n_calls_into_covr <- 2L\n\n if (is_current_test_finished()) {\n update_current_test()\n }\n\n # ignore if .counter was not created with record_tests (nested coverage calls)\n if (is.null(.counters[[key]]$tests)) return()\n\n .current_test$i <- .current_test$i + 1L\n\n # expand infrequently as new tests are added, doubling matrix size as needed\n tests <- .counters[[key]]$tests\n n <- NROW(tests$tally)\n if (.counters[[key]]$value > n) {\n tests$tally <- rbind(tests$tally, matrix(NA_integer_, ncol = 4L, nrow = n))\n }\n\n # ignore if .current_test was not initialized properly yet\n if (length(.current_test$index) == 0) {\n return()\n }\n\n # test number\n tests$.data[[1L]] <- .current_test$index\n\n # test call number (for test expressions that are called multiple times)\n tests$.data[[2L]] <- .current_test$call_count\n\n # call stack depth when trace is hit\n tests$.data[[3L]] <- sys.nframe() - length(.current_test$frames) - n_calls_into_covr + 1L\n\n # number of traces hit by the test so far\n tests$.data[[4L]] <- .current_test$i\n\n tests$.value <- .counters[[key]]$value\n with(tests, tally[.value, ] <- .data)\n}\n\n#' Initialize a new test counter for a coverage trace\n#'\n#' Initialize a test counter, a matrix used to tally tests, their stack depth\n#' and the execution order as the trace associated with \\code{key} is hit. Each\n#' test trace is an environment, which allows assignment into a pre-allocated\n#' \\code{tests} matrix with minimall reallocation.\n#'\n#' The \\code{tests} matrix has columns \\code{tests}, \\code{depth} and \\code{i},\n#' corresponding to the test index (the index of the associated test in\n#' \\code{.counters$tests}), the stack depth when the trace is evaluated and the\n#' number of traces that have been hit so far during test evaluation.\n#'\n#' @inheritParams count\n#'\nnew_test_counter <- function(key) {\n .counters[[key]]$tests <- new.env(parent = baseenv())\n .counters[[key]]$tests$.data <- vector(\"integer\", 4L)\n .counters[[key]]$tests$.value <- integer(1L)\n .counters[[key]]$tests$tally <- matrix(\n NA_integer_,\n ncol = 4L,\n # initialize with 4 empty rows, only expanded once populated\n nrow = 4L,\n # cols: test index; call index; call stack depth of covr:::count; execution order index\n dimnames = list(c(), c(\"test\", \"call\", \"depth\", \"i\"))\n )\n}\n\n#' Update current test if unit test expression has progressed\n#'\n#' Updating a test logs some metadata regarding the current call stack, noteably\n#' trying to capture information about the call stack prior to the covr::count\n#' call being traced.\n#'\n#' There are a couple patterns of behavior, which try to accommodate a variety\n#' of testing suites:\n#'\n#' \\itemize{\n#' \\item `testthat`: During execution of `testthat`'s `test_*` functions,\n#' files are sourced and the working directory is temporarily changed to the\n#' package `/tests` directory. Knowing this, calls in the call stack which\n#' are relative to this directory are extracted and recorded.\n#' \\item `RUnit`:\n#' \\item `custom`: Any other custom test suites may not have source kept with\n#' their execution, in which case the entire test call stack is kept.\n#' }\n#'\n#' checks to see if the current call stack has the same\n#' `srcref` (or expression, if no source is available) at the same frame prior\n#' to entering into a package where `covr:::count` is called.\n#'\n#' @keywords internal\n#'\n#' @importFrom utils getSrcDirectory\n#'\nupdate_current_test <- function() {\n syscalls <- sys.calls()\n syscall_first_count <- Position(is_covr_count_call, syscalls, nomatch = -1L)\n if (syscall_first_count < 2L) return() # skip if nothing before covr::count\n syscall_srcfile <- vcapply(syscalls, get_source_filename, normalize = TRUE)\n\n has_srcfile <- viapply(syscall_srcfile, length) > 0L\n srcfile_tmp <- logical(length(has_srcfile))\n srcfile_tmp[has_srcfile] <- startsWith(\n syscall_srcfile[has_srcfile],\n normalizePath(.libPaths()[[1]], mustWork = FALSE)\n )\n\n test_frames <- if (any(srcfile_tmp)) {\n # if possible, try to take any frames within the temporary library\n which(srcfile_tmp)\n } else {\n # otherwise, default to taking all syscalls up until covr:::count\n seq_len(syscall_first_count - 1L)\n }\n\n # add in outer frame, which may call intermediate .Internal or .External\n exec_frames <- unique(c(test_frames, syscall_first_count - 1L))\n\n # build updated current test data, isolating relevant frames\n .current_test$trace <- syscalls[exec_frames]\n .current_test$i <- 0L\n .current_test$frames <- exec_frames\n .current_test$last_frame <- exec_frames[[Position(\n has_srcref,\n .current_test$trace,\n right = TRUE,\n nomatch = length(exec_frames)\n )]]\n\n # might be NULL if srcrefs aren't kept during building / sourcing\n .current_test$src_env <- sys.frame(which = .current_test$last_frame - 1L)\n .current_test$src_call <- syscalls[[.current_test$last_frame]]\n .current_test$srcref <- getSrcref(.current_test$src_call)\n .current_test$src <- .current_test$srcref %||% .current_test$src_call\n\n .current_test$key <- current_test_key()\n .current_test$index <- current_test_index()\n .current_test$call_count <- current_test_call_count()\n\n # NOTE: r-bugs 18348\n # restrict test call lengths to avoid R Rds deserialization limit\n # https://bugs.r-project.org/show_bug.cgi?id=18348\n max_call_len <- 1e4\n call_lengths <- vapply(.current_test$trace, length, numeric(1L))\n if (any(call_lengths > max_call_len)) {\n .current_test$trace <- lapply(\n .current_test$trace,\n truncate_call,\n limit = max_call_len\n )\n\n warning(\"A large call was captured as part of a test and will be truncated.\")\n }\n\n .counters$tests[[.current_test$index]] <- .current_test$trace\n attr(.counters$tests[[.current_test$index]], \"call_count\") <- .current_test$call_count\n names(.counters$tests)[[.current_test$index]] <- .current_test$key\n}\n\n#' Build key for the current test\n#'\n#' If the current test has a srcref, a unique character key is built from its\n#' srcref. Otherwise, an empty string is returned.\n#'\n#' @return A unique character string if the test call has a srcref, or an empty\n#' string otherwise.\n#'\n#' @keywords internal\ncurrent_test_key <- function() {\n if (!inherits(.current_test$src, \"srcref\")) return(\"\")\n file.path(\n dirname(get_source_filename(.current_test$src, normalize = TRUE)),\n key(.current_test$src)\n )\n}\n\n#' Retrieve the index for the test in `.counters$tests`\n#'\n#' If the test was encountered before, the index will be the index of the test\n#' in the logged tests list. Otherwise, the index will be the next index beyond\n#' the length of the tests list.\n#'\n#' @return An integer index for the test call\n#'\n#' @keywords internal\ncurrent_test_index <- function() {\n # check if test has already been encountered and reuse test index\n if (inherits(.current_test$src, \"srcref\")) {\n # when tests have srcrefs, we can quickly compare test keys\n match(\n .current_test$key,\n names(.counters$tests),\n nomatch = length(.counters$tests) + 1L\n )\n } else {\n # otherwise we compare call stacks\n Position(\n function(t) identical(t[], .current_test$trace), # t[] to ignore attr\n .counters$tests,\n right = TRUE,\n nomatch = length(.counters$tests) + 1L\n )\n }\n}\n\n#' Retrieve the number of times the test call was called\n#'\n#' A single test expression might be evaluated many times. Each time the same\n#' expression is called, the call count is incremented.\n#'\n#' @return An integer value representing the number of calls of the current\n#' call into the package from the testing suite.\n#'\ncurrent_test_call_count <- function() {\n if (.current_test$index <= length(.counters$tests)) {\n attr(.counters$tests[[.current_test$index]], \"call_count\") + 1L\n } else {\n 1L\n }\n}\n\n#' Truncate call objects to limit the number of arguments\n#'\n#' A helper to circumvent R errors when deserializing large call objects from\n#' Rds. Trims the number of arguments in a call object, and replaces the last\n#' argument with a `` symbol.\n#'\n#' @param call_obj A (possibly large) \\code{call} object\n#' @param limit A \\code{call} length limit to impose\n#' @return The \\code{call_obj} with arguments trimmed\n#'\ntruncate_call <- function(call_obj, limit = 1e4) {\n if (length(call_obj) < limit) return(call_obj)\n call_obj <- head(call_obj, limit)\n call_obj[[length(call_obj)]] <- quote(``)\n call_obj\n}\n\n#' Returns TRUE if we've moved on from test reflected in .current_test\n#'\n#' Quickly dismiss the need to update the current test if we can. To test if\n#' we're still in the last test, check if the same srcref (or call, if source is\n#' not kept) exists at the last recorded calling frame prior to entering a covr\n#' trace. If this has changed, do a more comprehensive test to see if any of the\n#' test call stack has changed, in which case we are onto a new test.\n#'\nis_current_test_finished <- function() {\n is.null(.current_test$src) ||\n .current_test$last_frame > sys.nframe() ||\n !identical(.current_test$src_call, sys.call(which = .current_test$last_frame)) ||\n !identical(.current_test$src_env, sys.frame(which = .current_test$last_frame - 1L))\n}\n\n#' Is the source bound to the expression\n#'\n#' @param expr A language object which may have a `srcref` attribute\n#' @return A logical value indicating whether the language object has source\n#'\nhas_srcref <- function(expr) {\n !is.null(getSrcref(expr))\n}\n\n#' Is the expression a call to covr:::count\n#'\n#' @param expr A language object\n#' @return A logical value indicating whether the object is a call to\n#' `covr:::count`.\n#'\nis_covr_count_call <- function(expr) {\n count_call <- call(\":::\", as.symbol(\"covr\"), as.symbol(\"count\"))\n identical(expr[[1]], count_call)\n}\n" }, { "path": "R/utils.R", "content": "`%||%` <- function(x, y) {\n if (!is.null(x)) {\n x\n } else {\n y\n }\n}\n\ncompact <- function(x) {\n x[viapply(x, length) != 0]\n}\n\ntrim <- function(x) {\n rex::re_substitutes(x, rex::rex(list(start, spaces) %or% list(spaces, end)), \"\", global = TRUE)\n}\n\nlocal_branch <- function(dir = \".\") {\n withr::with_dir(dir,\n branch <- system_output(\"git\", c(\"rev-parse\", \"--abbrev-ref\", \"HEAD\"))\n )\n trim(branch)\n}\n\ncurrent_commit <- function(dir = \".\") {\n withr::with_dir(dir,\n commit <- system_output(\"git\", c(\"rev-parse\", \"HEAD\"))\n )\n trim(commit)\n}\n\n`[.coverage` <- function(x, i, ...) {\n attrs <- attributes(x)\n attrs$names <- attrs$names[i]\n res <- unclass(x)\n res <- res[i]\n attributes(res) <- attrs\n res\n}\n\nto_title <- function(x) {\n rex::re_substitutes(x,\n rex::rex(rex::regex(\"\\\\b\"), capture(any)),\n \"\\\\U\\\\1\",\n global = TRUE)\n}\n\nsrcfile_lines <- function(srcfile) {\n lines <- getSrcLines(srcfile, 1, Inf)\n matches <- rex::re_matches(lines,\n rex::rex(start, any_spaces, \"#line\", spaces,\n capture(name = \"line_number\", digit), spaces,\n quotes, capture(name = \"filename\", anything), quotes))\n\n matches <- na.omit(matches)\n\n filename_match <- which(matches$filename == srcfile$filename)\n\n if (length(filename_match) == 1) {\n\n # rownames(matches) is the line number of lines\n start <- as.numeric(rownames(matches)[filename_match]) + 1\n\n # If there is another directive we want to stop at that, otherwise stop at\n # the end\n end <- if (!is.na(rownames(matches)[filename_match + 1])) {\n as.numeric(rownames(matches)[filename_match + 1]) - 1\n } else {\n length(lines)\n }\n\n # If there are no line directives for the file just use the entire file\n } else {\n start <- 1\n end <- length(lines)\n }\n\n res <- lines[seq(start, end)]\n\n # Track blank or comment lines so they can be excluded from the result calculations, but only for R files\n if (rex::re_matches(srcfile$filename, rex::rex(\".\", one_of(\"r\", \"R\"), end))) {\n attr(res, \"blanks\") <- which(rex::re_matches(res, rex::rex(start, any_spaces, maybe(\"#\", anything), end)))\n }\n res\n}\n\n# Split lines into a list based on the line directives in the file.\nsplit_on_line_directives <- function(lines) {\n matches <- rex::re_matches(lines,\n rex::rex(start, any_spaces, \"#line\", spaces,\n capture(name = \"line_number\", digit), spaces,\n quotes, capture(name = \"filename\", anything), quotes))\n directive_lines <- which(!is.na(matches$line_number))\n if (!length(directive_lines)) {\n return(NULL)\n }\n\n file_starts <- directive_lines + 1\n file_ends <- c(directive_lines[-1] - 1, length(lines))\n res <- mapply(\n function(start, end) lines[start:end],\n file_starts,\n file_ends,\n SIMPLIFY = FALSE\n )\n names(res) <- na.omit(matches$filename)\n res\n}\n\ntraced_files <- function(x) {\n res <- list()\n filenames <- display_name(x)\n for (i in seq_along(x)) {\n src_file <- attr(x[[i]]$srcref, \"srcfile\")\n filename <- filenames[[i]]\n\n if (filename == \"\") next\n if (!is.null(res[[filename]])) next\n\n lines <- getSrcLines(src_file, 1, Inf)\n matches <- rex::re_matches(lines,\n rex::rex(start, any_spaces, \"#line\", spaces,\n capture(name = \"line_number\", digit), spaces,\n quotes, capture(name = \"filename\", anything), quotes))\n\n matches <- na.omit(matches)\n\n filename_match <- which(matches$filename == src_file$filename)\n\n if (length(filename_match) == 1) {\n start <- as.numeric(rownames(matches)[filename_match]) + 1\n end <- if (!is.na(rownames(matches)[filename_match + 1])) {\n as.numeric(rownames(matches)[filename_match + 1]) - 1\n } else {\n length(lines)\n }\n } else {\n start <- 1\n end <- length(lines)\n }\n src_file$file_lines <- lines[seq(start, end)]\n\n res[[filename]] <- src_file\n }\n res\n}\n\nper_line <- function(coverage) {\n df <- as.data.frame(coverage)\n\n # In rare cases the source reference such as generated code onload the source\n # reference will not exists, so the first_line will be NA\n df <- df[!is.na(df$first_line), ]\n\n files <- traced_files(coverage)\n\n # Lines with only spaces or only comments\n blank_lines <- lapply(files, function(file) {\n which(rex::re_matches(file$file_lines, rex::rex(start, any_spaces, maybe(\"#\", anything), end)))\n })\n\n # lines with only })], or an else block\n empty_lines <- lapply(files, function(file) {\n which(rex::re_matches(file$file_lines, \"^(?:[[:punct:][:space:]]|else)*$\"))\n })\n\n file_lengths <- lapply(files, function(file) {\n length(file$file_lines)\n })\n\n res <- lapply(file_lengths,\n function(x) {\n rep(NA_real_, length.out = x)\n })\n\n # df is sorted by file and first line ascending, so we store the maximum\n # last_line seen to detect if the previous expression contains the current\n # expression.\n max_last <- 0\n prev_filename <- \"\"\n\n for (i in seq_len(NROW(df))) {\n filename <- df[i, \"filename\"]\n for (line in seq(df[i, \"first_line\"], df[i, \"last_line\"])) {\n\n # if it is not a blank line or empty line\n if (!line %in% c(blank_lines[[filename]], empty_lines[[filename]])) {\n\n value <- df[i, \"value\"]\n # if current coverage is NA or last line < max last line\n if (is.na(res[[filename]][line]) || line < max_last || (line == max_last && res[[filename]][line] > value)) {\n res[[filename]][line] <- value\n }\n\n if (df[i, \"filename\"] != prev_filename) {\n prev_filename <- df[i, \"filename\"]\n max_last <- 0\n }\n if (df[i, \"last_line\"] > max_last) {\n max_last <- df[i, \"last_line\"]\n }\n }\n }\n }\n structure(\n Map(function(file, coverage) {\n structure(list(file = file, coverage = coverage), class = \"line_coverage\")\n },\n files, res),\n class = \"line_coverages\")\n}\n\nif (getRversion() < \"3.2.0\") {\n isNamespaceLoaded <- function(x) x %in% loadedNamespaces()\n}\n\nis_windows <- function() {\n .Platform$OS.type == \"windows\"\n}\n\nas_package <- function(path) {\n path <- normalize_path(path)\n if (!file.exists(path)) {\n stop(\"`path` is invalid: \", path, call. = FALSE)\n }\n root <- package_root(path)\n\n if (is.null(root)) {\n stop(sQuote(path), \" does not contain a package!\", call. = FALSE)\n }\n\n res <- read_description(file.path(root, \"DESCRIPTION\"))\n res$path <- root\n\n res\n}\n\npackage_root <- function(path) {\n stopifnot(is.character(path))\n\n has_description <- function(path) {\n file.exists(file.path(path, \"DESCRIPTION\"))\n }\n is_root <- function(path) {\n identical(path, dirname(path))\n }\n\n path <- normalize_path(path)\n while (!is_root(path) && !has_description(path)) {\n path <- dirname(path)\n }\n\n if (is_root(path)) {\n NULL\n } else {\n path\n }\n}\n\nread_description <- function(path) {\n if (!length(path) || !file.exists(path)) {\n stop(\"DESCRIPTION file not found at \", sQuote(path), call. = FALSE)\n }\n\n res <- as.list(read.dcf(path)[1, ])\n names(res) <- tolower(names(res))\n res\n}\n\nclean_objects <- function(path) {\n files <- list.files(file.path(path, \"src\"),\n pattern = rex::rex(\".\",\n or(\"o\", \"sl\", \"so\", \"dylib\",\n \"a\", \"dll\"), end),\n full.names = TRUE, recursive = TRUE)\n unlink(files)\n\n invisible(files)\n}\n\n# This is not actually an S3 method\n# From http://stackoverflow.com/a/34639237/2055486\nsetdiff.data.frame <- function(x, y,\n by = intersect(names(x), names(y)),\n by.x = by, by.y = by) {\n stopifnot(\n is.data.frame(x),\n is.data.frame(y),\n length(by.x) == length(by.y))\n\n !do.call(paste, c(x[by.x], sep = \"\\30\")) %in% do.call(paste, c(y[by.y], sep = \"\\30\"))\n}\n\n`%==%` <- function(x, y) identical(x, y)\n\n`%!=%` <- function(x, y) !identical(x, y)\n\nis_na <- function(x) {\n !is.null(x) && !is.symbol(x) && is.na(x)\n}\n\nis_brace <- function(x) {\n is.symbol(x) && as.character(x) == \"{\"\n}\n\nmodify_name <- function(expr, old, new) {\n replace <- function(e)\n if (is.name(e) && identical(e, as.name(old))) e <- as.name(new)\n else if (length(e) <= 1L) e\n else as.call(lapply(e, replace))\n replace(expr)\n}\n\n\n# This is the fix for https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16659\nmatch_arg <- base::match.arg\nbody(match_arg) <- modify_name(body(match_arg), \"all\", \"any\")\n\n# from https://github.com/wch/r-source/blob/2065bd3c09813949e9fa7236d167f1b7ed5c8ba3/src/library/tools/R/check.R#L4134-L4137\nenv_path <- function(...) {\n paths <- c(...)\n paste(paths[nzchar(paths)], collapse = .Platform$path.sep)\n}\n\nnormalize_path <- function(x) {\n path <- normalizePath(x, winslash = \"/\", mustWork = FALSE)\n # Strip any trailing slashes as they are invalid on windows\n sub(\"/*$\", \"\", path)\n}\n\ntemp_dir <- function() {\n normalize_path(tempdir())\n}\ntemp_file <- function(pattern = \"file\", tmpdir = temp_dir(), fileext = \"\") {\n normalize_path(tempfile(pattern, tmpdir, fileext))\n}\n\nget_package_name <- function(x) {\n attr(x, \"package\")$package %||% \"coverage\"\n}\n\nget_source_filename <- function(x, full.names = FALSE, unique = TRUE, normalize = FALSE) {\n res <- getSrcFilename(x, full.names, unique)\n if (length(res) == 0) {\n return(\"\")\n }\n if (normalize) {\n return(normalize_path(res))\n }\n res\n}\n\nvcapply <- function(X, FUN, ...) vapply(X, FUN, ..., FUN.VALUE = character(1))\nvdapply <- function(X, FUN, ...) vapply(X, FUN, ..., FUN.VALUE = numeric(1))\nviapply <- function(X, FUN, ...) vapply(X, FUN, ..., FUN.VALUE = integer(1))\nvlapply <- function(X, FUN, ...) vapply(X, FUN, ..., FUN.VALUE = logical(1))\n\ntrim_ws <- function(x) {\n x <- sub(\"^[ \\t\\r\\n]+\", \"\", x, perl = TRUE)\n sub(\"[ \\t\\r\\n]+$\", \"\", x, perl = TRUE)\n}\n" }, { "path": "R/value.R", "content": "#' Retrieve the value from an object\n#' @export\n#' @param x object from which to retrieve the value\n#' @param ... additional arguments passed to methods\nvalue <- function(x, ...) UseMethod(\"value\")\n\n#' @export\nvalue.coverage <- function(x, ...) {\n vdapply(x, value, ...)\n}\n\n#' @export\nvalue.expression_coverage <- function(x, ...) {\n x$value\n}\n\n#' @export\nvalue.expression_coverages <- value.coverage\n\n#' @export\nvalue.line_coverage <- value.expression_coverage\n\n#' @export\nvalue.line_coverages <- value.expression_coverages\n" }, { "path": "R/vectorized.R", "content": "# simple function to test if a function is Vectorized\nis_vectorized <- function(x) {\n is.function(x) && exists(\"FUN\", environment(x), mode = \"function\") && exists(\"vectorize.args\", environment(x))\n}\n" }, { "path": "R/zzz.R", "content": ".onLoad <- function(libname, pkgname) { # nolint\n rex::register_shortcuts(\"covr\")\n op <- options()\n op_covr <- list(\n covr.covrignore = Sys.getenv(\"COVR_COVRIGNORE\", \".covrignore\"),\n covr.gcov = Sys.which(\"gcov\"),\n covr.gcov_args = NULL,\n covr.gcov_additional_paths = NULL,\n covr.exclude_pattern = rex::rex(\"#\", any_spaces, \"nocov\"),\n covr.exclude_start = rex::rex(\"#\", any_spaces, \"nocov\", any_spaces, \"start\"),\n covr.exclude_end = rex::rex(\"#\", any_spaces, \"nocov\", any_spaces, \"end\"),\n covr.flags = c(CFLAGS = \"-O0 --coverage\",\n CXXFLAGS = \"-O0 --coverage\",\n CXX1XFLAGS = \"-O0 --coverage\",\n CXX11FLAGS = \"-O0 --coverage\",\n CXX14FLAGS = \"-O0 --coverage\",\n CXX17FLAGS = \"-O0 --coverage\",\n CXX20FLAGS = \"-O0 --coverage\",\n\n FFLAGS = \"-O0 --coverage\",\n FCFLAGS = \"-O0 --coverage\",\n FLIBS = \"-lgcov\",\n\n # LDFLAGS is ignored on windows and visa versa\n LDFLAGS = if (!is_windows()) \"--coverage\" else NULL,\n SHLIB_LIBADD = if (is_windows()) \"--coverage\" else NULL)\n )\n\n# add icc code coverage settings\n icov_flag <- \"-O0 -prof-gen=srcpos\"\n op_covr <- c(op_covr, list(\n covr.icov = Sys.which(\"codecov\"),\n covr.icov_args = NULL,\n covr.icov_prof = Sys.which(\"profmerge\"),\n covr.icov_flags = c(CFLAGS = icov_flag,\n CXXFLAGS = icov_flag,\n CXX1XFLAGS = icov_flag,\n CXX11FLAGS = icov_flag,\n CXX14FLAGS = icov_flag,\n CXX17FLAGS = icov_flag,\n CXX20FLAGS = icov_flag,\n\n FFLAGS = icov_flag,\n FCFLAGS = icov_flag,\n\n # LDFLAGS is ignored on windows and visa versa\n LDFLAGS = icov_flag,\n SHLIB_LIBADD = icov_flag)\n ))\n\n toset <- !(names(op_covr) %in% names(op))\n if (any(toset)) options(op_covr[toset])\n\n invisible()\n}\n" }, { "path": "README.md", "content": "# covr \n\n\n[![R-CMD-check](https://github.com/r-lib/covr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/covr/actions/workflows/R-CMD-check.yaml)\n[![Codecov test coverage](https://codecov.io/gh/r-lib/covr/branch/master/graph/badge.svg)](https://app.codecov.io/gh/r-lib/covr?branch=master)\n[![CRAN version](https://www.r-pkg.org/badges/version/covr)](https://cran.r-project.org/package=covr)\n\n\nTrack test coverage for your R package and view reports locally or (optionally)\nupload the results to [codecov](https://about.codecov.io/) or [coveralls](https://coveralls.io/).\n\n# Installation #\n\n```r\ninstall.packages(\"covr\")\n\n# For devel version\ndevtools::install_github(\"r-lib/covr\")\n```\n\nThe easiest way to setup covr on [Github Actions](https://github.com/r-lib/actions/tree/v2-branch/examples#test-coverage-workflow) \nis with [usethis](https://github.com/r-lib/usethis).\n\n```r\nusethis::use_github_action(\"test-coverage\")\n```\n\n# Usage #\n\nFor local development a coverage report can be used to inspect coverage for\neach line in your package. *Note* requires the\n[DT](https://github.com/rstudio/DT) package to be installed.\n\n```r\nlibrary(covr)\n\n# If run with no arguments implicitly calls `package_coverage()`\nreport()\n```\n\ncovr also defines an [RStudio Addin](https://rstudio.github.io/rstudioaddins/),\nwhich runs `report()` on the active project. This can be used via the Addin\nmenu or by binding the action to a\n[shortcut](https://rstudio.github.io/rstudioaddins/#keyboard-shorcuts), e.g.\n*Ctrl-Shift-C*.\n\n## Interactively ##\n```r\n# If run with the working directory within the package source.\npackage_coverage()\n\n# or a package in another directory\ncov <- package_coverage(\"/dir/lintr\")\n\n# view results as a data.frame\nas.data.frame(cov)\n\n# zero_coverage() shows only uncovered lines.\n# If run within RStudio, `zero_coverage()` will open a marker pane with the\n# uncovered lines.\nzero_coverage(cov)\n```\n\n# Exclusions #\n\n`covr` supports a few of different ways of excluding some or all of a file.\n\n## .covrignore file ##\n\nA `.covrignore` file located in your package's root directory can be used to\nexclude files or directories.\n\nThe lines in the `.covrignore` file are interpreted as a list of file globs to\nignore. It uses the globbing rules in `Sys.glob()`. Any directories listed will\nignore all the files in the directory.\n\nAlternative locations for the file can be set by the environment variable\n`COVR_COVRIGNORE` or the R option `covr.covrignore`.\n\nThe `.covrignore` file should be added to your `.RBuildignore` file unless you\nwant to distribute it with your package. If so it can be added to\n`inst/.covrignore` instead.\n\n\n## Function Exclusions ##\nThe `function_exclusions` argument to `package_coverage()` can be used to\nexclude functions by name. This argument takes a vector of regular expressions\nmatching functions to exclude.\n\n```r\n# exclude print functions\npackage_coverage(function_exclusions = \"print\\\\.\")\n\n# exclude `.onLoad` function\npackage_coverage(function_exclusions = \"\\\\.onLoad\")\n```\n\n## Line Exclusions ##\nThe `line_exclusions` argument to `package_coverage()` can be used to exclude some or\nall of a file. This argument takes a list of filenames or named ranges to\nexclude.\n\n```r\n# exclude whole file of R/test.R\npackage_coverage(line_exclusions = \"R/test.R\")\n\n# exclude lines 1 to 10 and 15 from R/test.R\npackage_coverage(line_exclusions = list(\"R/test.R\" = c(1:10, 15)))\n\n# exclude lines 1 to 10 from R/test.R, all of R/test2.R\npackage_coverage(line_exclusions = list(\"R/test.R\" = c(1, 10), \"R/test2.R\"))\n```\n\n## Exclusion Comments ##\n\nIn addition you can exclude lines from the coverage by putting special comments\nin your source code.\n\nThis can be done per line.\n```r\nf1 <- function(x) {\n x + 1 # nocov\n}\n```\n\nOr by specifying a range with a start and end.\n```r\nf2 <- function(x) { # nocov start\n x + 2\n} # nocov end\n```\n\nThe patterns used can be specified by setting the global options\n`covr.exclude_pattern`, `covr.exclude_start`, `covr.exclude_end`.\n\nNB: The same pattern applies to exclusions in the `src` folder, so skipped lines in, e.g., C code (where comments can start with `//`) should look like `// # nocov`.\n\n# FAQ #\n## Will covr work with testthat, RUnit, etc... ##\nCovr should be compatible with any testing package, it uses\n`tools::testInstalledPackage()` to run your packages tests.\n\n## Will covr work with alternative compilers such as ICC ##\nCovr now supports Intel's `icc` compiler, thanks to work contributed by Qin\nWang at Oracle.\n\nCovr is known to work with clang versions `3.5+` and gcc version `4.2+`.\n\nIf the appropriate gcov version is not on your path you can set the appropriate\nlocation with the `covr.gcov` options. If you set this path to \"\" it will turn\n_off_ coverage of compiled code.\n```r\noptions(covr.gcov = \"path/to/gcov\")\n```\n\n## How does covr work? ##\n`covr` tracks test coverage by modifying a package's code to add tracking calls\nto each call.\n\nThe vignette\n[vignettes/how_it_works.Rmd](https://github.com/r-lib/covr/blob/master/vignettes/how_it_works.Rmd)\ncontains a detailed explanation of the technique and the rationale behind it.\n\nYou can view the vignette from within `R` using\n\n```r\nvignette(\"how_it_works\", package = \"covr\")\n```\n\n## Why can't covr run during R CMD check ##\nBecause covr modifies the package code it is possible there are unknown edge\ncases where that modification affects the output. In addition when tracking\ncoverage for compiled code covr compiles the package without optimization,\nwhich _can_ modify behavior (usually due to package bugs which are masked with\nhigher optimization levels).\n\n# Alternative Coverage Tools #\n- (no longer supported)\n- [**R-coverage**](https://web.archive.org/web/20160611114452/http://r2d2.quartzbio.com/posts/r-coverage-docker.html) (no longer supported)\n\n## Code of Conduct\n\nPlease note that the covr project is released with a [Contributor Code of Conduct](https://github.com/r-lib/covr/blob/main/CODE_OF_CONDUCT.md). By contributing to this project, you agree to abide by its terms.\n" }, { "path": "SECURITY.md", "content": "# Security Policy\n\n## Reporting a Vulnerability\n\nSend an email to james.f.hester@gmail.com to report a vulnerability.\n" }, { "path": "_pkgdown.yml", "content": "url: https://covr.r-lib.org\n\nauthors:\n \"Jim Hester\":\n href: https://www.jimhester.com/\n\ndestination: docs\n\ndevelopment:\n mode: auto\n\ntemplate:\n bootstrap: 5\n params:\n ganalytics: UA-115082821-1\n" }, { "path": "codecov.yml", "content": "comment: false\n\ncoverage:\n status:\n project:\n default:\n target: auto\n threshold: 1%\n informational: true\n patch:\n default:\n target: auto\n threshold: 1%\n informational: true\n" }, { "path": "cran-comments.md", "content": "This is a patch release to fix a change made in R-devel\n\n## R CMD check results\nThere were no NOTEs, ERRORs or WARNINGs.\n" }, { "path": "docker_checker/Dockerfile", "content": "FROM rocker/hadleyverse\nMAINTAINER james.f.hester@gmail.com\n\n# install deps from current github master\nRUN Rscript -e 'devtools::install_github(\"jimhester/covr\", dependencies = TRUE)'\n\n# remove installed covr to be sure not to conflict with current source version\nRUN Rscript -e 'remove.packages(\"covr\")'\n\n# docker user setup\nRUN useradd -m docker && echo \"docker:docker\" | chpasswd && adduser docker sudo && \\\n\tchmod -R a+rwx /usr/local/lib/R/site-library\n\nUSER docker\nWORKDIR /home/docker\n" }, { "path": "inst/rstudio/addins.dcf", "content": "Name: Calculate package test coverage\nDescription: Calculates the package test coverage and opens a report, using `covr::report()`\nBinding: addin_report\nInteractive: false\n" }, { "path": "inst/www/report.css", "content": "table tr:hover td {\n font-weight:bold;text-decoration:none\n}\ntable tr.covered td{\n background-color:rgba(95,151,68,0.3)\n}\n\ntable tr:hover.covered .num{\n background-color:rgba(95,151,68,0.7)\n}\ntable tr.missed td{\n background-color:rgba(185,73,71,0.3)\n}\ntable tr:hover.missed .num{\n background-color:rgba(185,73,71,0.7)\n}\n\ntable tr.missed:hover td{\n -webkit-box-shadow:0 -2px 0 0 #b94947 inset;\n -moz-box-shadow:0 -2px 0 0 #b94947 inset;\n box-shadow:0 -2px 0 0 #b94947 inset\n}\ntable tr.covered:hover td{\n -webkit-box-shadow:0 -2px 0 0 #5f9744 inset;\n -moz-box-shadow:0 -2px 0 0 #5f9744 inset;\n box-shadow:0 -2px 0 0 #5f9744 inset\n}\n\ntable tr.never td{\n background-color:transparent\n}\n\ntable tbody {\n border-style: solid;\n border: 1px solid rgba(0,0,0,0.1)\n}\n\ntable .num {\n border-right: 1px solid rgba(0,0,0,0.1)\n}\n\ntd.coverage em {\n opacity: 0.5;\n}\n\ntable td.coverage {\n border-right: 1px solid rgba(0,0,0,0.1);\n font-weight: bold;\n text-align: center;\n}\ntable.table-condensed pre {\n background-color: transparent;\n margin: 0;\n padding: 0;\n border: 0;\n font-size: 11px;\n}\ndiv#files td {\n padding: 0;\n padding-left: 5px;\n}\n\ndiv#files td.num {\n padding-right: 5px;\n}\n\ntable.table-condensed {\n font-size: 11px;\n}\n" }, { "path": "inst/www/shared/highlight.js/LICENSE", "content": "Copyright (c) 2006, Ivan Sagalaev\nAll rights reserved.\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n * Neither the name of highlight.js nor the names of its contributors\n may be used to endorse or promote products derived from this software\n without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" }, { "path": "inst/www/shared/highlight.js/highlight.pack.js", "content": "var hljs=new function(){function m(p){return p.replace(/&/gm,\"&\").replace(/\"}while(y.length||w.length){var v=u().splice(0,1)[0];z+=m(x.substr(q,v.offset-q));q=v.offset;if(v.event==\"start\"){z+=t(v.node);s.push(v.node)}else{if(v.event==\"stop\"){var p,r=s.length;do{r--;p=s[r];z+=(\"\")}while(p!=v.node);s.splice(r,1);while(r'+M[0]+\"\"}else{r+=M[0]}O=P.lR.lastIndex;M=P.lR.exec(L)}return r+L.substr(O,L.length-O)}function J(L,M){if(M.sL&&e[M.sL]){var r=d(M.sL,L);x+=r.keyword_count;return r.value}else{return F(L,M)}}function I(M,r){var L=M.cN?'':\"\";if(M.rB){y+=L;M.buffer=\"\"}else{if(M.eB){y+=m(r)+L;M.buffer=\"\"}else{y+=L;M.buffer=r}}D.push(M);A+=M.r}function G(N,M,Q){var R=D[D.length-1];if(Q){y+=J(R.buffer+N,R);return false}var P=q(M,R);if(P){y+=J(R.buffer+N,R);I(P,M);return P.rB}var L=v(D.length-1,M);if(L){var O=R.cN?\"\":\"\";if(R.rE){y+=J(R.buffer+N,R)+O}else{if(R.eE){y+=J(R.buffer+N,R)+O+m(M)}else{y+=J(R.buffer+N+M,R)+O}}while(L>1){O=D[D.length-2].cN?\"\":\"\";y+=O;L--;D.length--}var r=D[D.length-1];D.length--;D[D.length-1].buffer=\"\";if(r.starts){I(r.starts,\"\")}return R.rE}if(w(M,R)){throw\"Illegal\"}}var E=e[B];var D=[E.dM];var A=0;var x=0;var y=\"\";try{var s,u=0;E.dM.buffer=\"\";do{s=p(C,u);var t=G(s[0],s[1],s[2]);u+=s[0].length;if(!t){u+=s[1].length}}while(!s[2]);if(D.length>1){throw\"Illegal\"}return{r:A,keyword_count:x,value:y}}catch(H){if(H==\"Illegal\"){return{r:0,keyword_count:0,value:m(C)}}else{throw H}}}function g(t){var p={keyword_count:0,r:0,value:m(t)};var r=p;for(var q in e){if(!e.hasOwnProperty(q)){continue}var s=d(q,t);s.language=q;if(s.keyword_count+s.r>r.keyword_count+r.r){r=s}if(s.keyword_count+s.r>p.keyword_count+p.r){r=p;p=s}}if(r.language){p.second_best=r}return p}function i(r,q,p){if(q){r=r.replace(/^((<[^>]+>|\\t)+)/gm,function(t,w,v,u){return w.replace(/\\t/g,q)})}if(p){r=r.replace(/\\n/g,\"
\")}return r}function n(t,w,r){var x=h(t,r);var v=a(t);var y,s;if(v){y=d(v,x)}else{return}var q=c(t);if(q.length){s=document.createElement(\"pre\");s.innerHTML=y.value;y.value=k(q,c(s),x)}y.value=i(y.value,w,r);var u=t.className;if(!u.match(\"(\\\\s|^)(language-)?\"+v+\"(\\\\s|$)\")){u=u?(u+\" \"+v):v}if(/MSIE [678]/.test(navigator.userAgent)&&t.tagName==\"CODE\"&&t.parentNode.tagName==\"PRE\"){s=t.parentNode;var p=document.createElement(\"div\");p.innerHTML=\"
\"+y.value+\"
\";t=p.firstChild.firstChild;p.firstChild.cN=s.cN;s.parentNode.replaceChild(p.firstChild,s)}else{t.innerHTML=y.value}t.className=u;t.result={language:v,kw:y.keyword_count,re:y.r};if(y.second_best){t.second_best={language:y.second_best.language,kw:y.second_best.keyword_count,re:y.second_best.r}}}function o(){if(o.called){return}o.called=true;var r=document.getElementsByTagName(\"pre\");for(var p=0;p|>=|>>|>>=|>>>|>>>=|\\\\?|\\\\[|\\\\{|\\\\(|\\\\^|\\\\^=|\\\\||\\\\|=|\\\\|\\\\||~\";this.ER=\"(?![\\\\s\\\\S])\";this.BE={b:\"\\\\\\\\.\",r:0};this.ASM={cN:\"string\",b:\"'\",e:\"'\",i:\"\\\\n\",c:[this.BE],r:0};this.QSM={cN:\"string\",b:'\"',e:'\"',i:\"\\\\n\",c:[this.BE],r:0};this.CLCM={cN:\"comment\",b:\"//\",e:\"$\"};this.CBLCLM={cN:\"comment\",b:\"/\\\\*\",e:\"\\\\*/\"};this.HCM={cN:\"comment\",b:\"#\",e:\"$\"};this.NM={cN:\"number\",b:this.NR,r:0};this.CNM={cN:\"number\",b:this.CNR,r:0};this.BNM={cN:\"number\",b:this.BNR,r:0};this.inherit=function(r,s){var p={};for(var q in r){p[q]=r[q]}if(s){for(var q in s){p[q]=s[q]}}return p}}();hljs.LANGUAGES.css=function(){var a={cN:\"function\",b:hljs.IR+\"\\\\(\",e:\"\\\\)\",c:[{eW:true,eE:true,c:[hljs.NM,hljs.ASM,hljs.QSM]}]};return{cI:true,dM:{i:\"[=/|']\",c:[hljs.CBLCLM,{cN:\"id\",b:\"\\\\#[A-Za-z0-9_-]+\"},{cN:\"class\",b:\"\\\\.[A-Za-z0-9_-]+\",r:0},{cN:\"attr_selector\",b:\"\\\\[\",e:\"\\\\]\",i:\"$\"},{cN:\"pseudo\",b:\":(:)?[a-zA-Z0-9\\\\_\\\\-\\\\+\\\\(\\\\)\\\\\\\"\\\\']+\"},{cN:\"at_rule\",b:\"@(font-face|page)\",l:\"[a-z-]+\",k:{\"font-face\":1,page:1}},{cN:\"at_rule\",b:\"@\",e:\"[{;]\",eE:true,k:{\"import\":1,page:1,media:1,charset:1},c:[a,hljs.ASM,hljs.QSM,hljs.NM]},{cN:\"tag\",b:hljs.IR,r:0},{cN:\"rules\",b:\"{\",e:\"}\",i:\"[^\\\\s]\",r:0,c:[hljs.CBLCLM,{cN:\"rule\",b:\"[^\\\\s]\",rB:true,e:\";\",eW:true,c:[{cN:\"attribute\",b:\"[A-Z\\\\_\\\\.\\\\-]+\",e:\":\",eE:true,i:\"[^\\\\s]\",starts:{cN:\"value\",eW:true,eE:true,c:[a,hljs.NM,hljs.QSM,hljs.ASM,hljs.CBLCLM,{cN:\"hexcolor\",b:\"\\\\#[0-9A-F]+\"},{cN:\"important\",b:\"!important\"}]}}]}]}]}}}();hljs.LANGUAGES.javascript={dM:{k:{keyword:{\"in\":1,\"if\":1,\"for\":1,\"while\":1,\"finally\":1,\"var\":1,\"new\":1,\"function\":1,\"do\":1,\"return\":1,\"void\":1,\"else\":1,\"break\":1,\"catch\":1,\"instanceof\":1,\"with\":1,\"throw\":1,\"case\":1,\"default\":1,\"try\":1,\"this\":1,\"switch\":1,\"continue\":1,\"typeof\":1,\"delete\":1},literal:{\"true\":1,\"false\":1,\"null\":1}},c:[hljs.ASM,hljs.QSM,hljs.CLCM,hljs.CBLCLM,hljs.CNM,{b:\"(\"+hljs.RSR+\"|\\\\b(case|return|throw)\\\\b)\\\\s*\",k:{\"return\":1,\"throw\":1,\"case\":1},c:[hljs.CLCM,hljs.CBLCLM,{cN:\"regexp\",b:\"/\",e:\"/[gim]*\",c:[{b:\"\\\\\\\\/\"}]}],r:0},{cN:\"function\",bWK:true,e:\"{\",k:{\"function\":1},c:[{cN:\"title\",b:\"[A-Za-z$_][0-9A-Za-z$_]*\"},{cN:\"params\",b:\"\\\\(\",e:\"\\\\)\",c:[hljs.ASM,hljs.QSM,hljs.CLCM,hljs.CBLCLM]}]}]}};hljs.LANGUAGES.r={dM:{c:[hljs.HCM,{cN:\"number\",b:\"\\\\b0[xX][0-9a-fA-F]+[Li]?\\\\b\",e:hljs.IMMEDIATE_RE,r:0},{cN:\"number\",b:\"\\\\b\\\\d+(?:[eE][+\\\\-]?\\\\d*)?L\\\\b\",e:hljs.IMMEDIATE_RE,r:0},{cN:\"number\",b:\"\\\\b\\\\d+\\\\.(?!\\\\d)(?:i\\\\b)?\",e:hljs.IMMEDIATE_RE,r:1},{cN:\"number\",b:\"\\\\b\\\\d+(?:\\\\.\\\\d*)?(?:[eE][+\\\\-]?\\\\d*)?i?\\\\b\",e:hljs.IMMEDIATE_RE,r:0},{cN:\"number\",b:\"\\\\.\\\\d+(?:[eE][+\\\\-]?\\\\d*)?i?\\\\b\",e:hljs.IMMEDIATE_RE,r:1},{cN:\"keyword\",b:\"(?:tryCatch|library|setGeneric|setGroupGeneric)\\\\b\",e:hljs.IMMEDIATE_RE,r:10},{cN:\"keyword\",b:\"\\\\.\\\\.\\\\.\",e:hljs.IMMEDIATE_RE,r:10},{cN:\"keyword\",b:\"\\\\.\\\\.\\\\d+(?![\\\\w.])\",e:hljs.IMMEDIATE_RE,r:10},{cN:\"keyword\",b:\"\\\\b(?:function)\",e:hljs.IMMEDIATE_RE,r:2},{cN:\"keyword\",b:\"(?:if|in|break|next|repeat|else|for|return|switch|while|try|stop|warning|require|attach|detach|source|setMethod|setClass)\\\\b\",e:hljs.IMMEDIATE_RE,r:1},{cN:\"literal\",b:\"(?:NA|NA_integer_|NA_real_|NA_character_|NA_complex_)\\\\b\",e:hljs.IMMEDIATE_RE,r:10},{cN:\"literal\",b:\"(?:NULL|TRUE|FALSE|T|F|Inf|NaN)\\\\b\",e:hljs.IMMEDIATE_RE,r:1},{cN:\"identifier\",b:\"[a-zA-Z.][a-zA-Z0-9._]*\\\\b\",e:hljs.IMMEDIATE_RE,r:0},{cN:\"operator\",b:\"<\\\\-(?!\\\\s*\\\\d)\",e:hljs.IMMEDIATE_RE,r:2},{cN:\"operator\",b:\"\\\\->|<\\\\-\",e:hljs.IMMEDIATE_RE,r:1},{cN:\"operator\",b:\"%%|~\",e:hljs.IMMEDIATE_RE},{cN:\"operator\",b:\">=|<=|==|!=|\\\\|\\\\||&&|=|\\\\+|\\\\-|\\\\*|/|\\\\^|>|<|!|&|\\\\||\\\\$|:\",e:hljs.IMMEDIATE_RE,r:0},{cN:\"operator\",b:\"%\",e:\"%\",i:\"\\\\n\",r:1},{cN:\"identifier\",b:\"`\",e:\"`\",r:0},{cN:\"string\",b:'\"',e:'\"',c:[hljs.BE],r:0},{cN:\"string\",b:\"'\",e:\"'\",c:[hljs.BE],r:0},{cN:\"paren\",b:\"[[({\\\\])}]\",e:hljs.IMMEDIATE_RE,r:0}]}};hljs.LANGUAGES.xml=function(){var b=\"[A-Za-z0-9\\\\._:-]+\";var a={eW:true,c:[{cN:\"attribute\",b:b,r:0},{b:'=\"',rB:true,e:'\"',c:[{cN:\"value\",b:'\"',eW:true}]},{b:\"='\",rB:true,e:\"'\",c:[{cN:\"value\",b:\"'\",eW:true}]},{b:\"=\",c:[{cN:\"value\",b:\"[^\\\\s/>]+\"}]}]};return{cI:true,dM:{c:[{cN:\"pi\",b:\"<\\\\?\",e:\"\\\\?>\",r:10},{cN:\"doctype\",b:\"\",r:10,c:[{b:\"\\\\[\",e:\"\\\\]\"}]},{cN:\"comment\",b:\"\",r:10},{cN:\"cdata\",b:\"<\\\\!\\\\[CDATA\\\\[\",e:\"\\\\]\\\\]>\",r:10},{cN:\"tag\",b:\"|$)\",e:\">\",k:{title:{style:1}},c:[a],starts:{cN:\"css\",e:\"\",rE:true,sL:\"css\"}},{cN:\"tag\",b:\"|$)\",e:\">\",k:{title:{script:1}},c:[a],starts:{cN:\"javascript\",e:\"<\\/script>\",rE:true,sL:\"javascript\"}},{cN:\"vbscript\",b:\"<%\",e:\"%>\",sL:\"vbscript\"},{cN:\"tag\",b:\"\",c:[{cN:\"title\",b:\"[^ />]+\"},a]}]}}}();\n" }, { "path": "inst/www/shared/highlight.js/rstudio.css", "content": "code {\n line-height: 150%;\n}\n\npre .operator,\npre .paren {\n color: rgb(104, 118, 135)\n}\n\npre .literal {\n color: rgb(88, 72, 246)\n}\n\npre .number {\n color: rgb(0, 0, 205);\n}\n\npre .comment {\n color: rgb(76, 136, 107);\n font-style: italic;\n}\n\npre .keyword,\npre .id {\n color: rgb(0, 0, 255);\n}\n\npre .identifier {\n color: rgb(0, 0, 0);\n}\n\npre .string,\npre .attribute {\n color: rgb(3, 106, 7);\n}\n\npre .doctype {\n color: rgb(104, 104, 92);\n}\n\npre .tag,\npre .title {\n color: rgb(4, 29, 140);\n}\n\npre .value {\n color: rgb(13, 105, 18);\n}\n\n.language-xml .attribute {\n color: rgb(0, 0, 0);\n}\n\n.language-css .attribute {\n color: rgb(110, 124, 219);\n}\n\n.language-css .value {\n color: rgb(23, 149, 30);\n}\n\n.language-css .number,\n.language-css .hexcolor {\n color: rgb(7, 27, 201);\n}\n\n.language-css .function {\n color: rgb(61, 77, 113);\n}\n\n.language-css .tag {\n color: rgb(195, 13, 25);\n}\n\n.language-css .class {\n color: rgb(53, 132, 148);\n}\n\n.language-css .pseudo {\n color: rgb(13, 105, 18);\n}\n" }, { "path": "man/as_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{as_coverage}\n\\alias{as_coverage}\n\\title{Convert a counters object to a coverage object}\n\\usage{\nas_coverage(counters = NULL, ...)\n}\n\\arguments{\n\\item{counters}{An environment of covr trace results to convert to a coverage\nobject. If \\code{counters} is not provided, the \\code{covr} namespace value\n\\code{.counters} is used.}\n\n\\item{...}{Additional attributes to include with the coverage object.}\n}\n\\description{\nConvert a counters object to a coverage object\n}\n" }, { "path": "man/as_coverage_with_tests.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{as_coverage_with_tests}\n\\alias{as_coverage_with_tests}\n\\title{Clean and restructure counter tests for a coverage object}\n\\usage{\nas_coverage_with_tests(counters)\n}\n\\arguments{\n\\item{counters}{An environment of covr trace results to convert to a coverage\nobject. If \\code{counters} is not provided, the \\code{covr} namespace value\n\\code{.counters} is used.}\n}\n\\description{\nFor tests produced with \\code{options(covr.record_tests)}, prune any unused\nrecords in the $tests$tally matrices of each trace and get rid of the\nwrapping $tests environment (reassigning with value of $tests$tally)\n}\n" }, { "path": "man/azure.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/azure.R\n\\name{azure}\n\\alias{azure}\n\\title{Run covr on a package and output the result so it is available on Azure Pipelines}\n\\usage{\nazure(\n ...,\n coverage = package_coverage(..., quiet = quiet),\n filename = \"coverage.xml\",\n quiet = TRUE\n)\n}\n\\arguments{\n\\item{...}{arguments passed to \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{coverage}{an existing coverage object to submit, if \\code{NULL},\n\\code{\\link[=package_coverage]{package_coverage()}} will be called with the arguments from\n\\code{...}}\n\n\\item{filename}{the name of the Cobertura XML file}\n\n\\item{quiet}{if \\code{FALSE}, print the coverage before submission.}\n}\n\\description{\nRun covr on a package and output the result so it is available on Azure Pipelines\n}\n" }, { "path": "man/clear_counters.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_calls.R\n\\name{clear_counters}\n\\alias{clear_counters}\n\\title{clear all previous counters}\n\\usage{\nclear_counters()\n}\n\\description{\nclear all previous counters\n}\n\\keyword{internal}\n" }, { "path": "man/code_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{code_coverage}\n\\alias{code_coverage}\n\\title{Calculate coverage of code directly}\n\\usage{\ncode_coverage(\n source_code,\n test_code,\n line_exclusions = NULL,\n function_exclusions = NULL,\n ...\n)\n}\n\\arguments{\n\\item{source_code}{A character vector of source code}\n\n\\item{test_code}{A character vector of test code}\n\n\\item{line_exclusions}{a named list of files with the lines to exclude from\neach file.}\n\n\\item{function_exclusions}{a vector of regular expressions matching function\nnames to exclude. Example \\verb{print\\\\\\\\\\\\.} to match print methods.}\n\n\\item{...}{Additional arguments passed to \\code{\\link[=file_coverage]{file_coverage()}}}\n}\n\\description{\nThis function is useful for testing, and is a thin wrapper around\n\\code{\\link[=file_coverage]{file_coverage()}} because parseData is not populated properly\nunless the functions are defined in a file.\n}\n\\examples{\nsource <- \"add <- function(x, y) { x + y }\"\ntest <- \"add(1, 2) == 3\"\ncode_coverage(source, test)\n}\n" }, { "path": "man/codecov.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/codecov.R\n\\name{codecov}\n\\alias{codecov}\n\\title{Run covr on a package and upload the result to codecov.io}\n\\usage{\ncodecov(\n ...,\n coverage = NULL,\n base_url = \"https://codecov.io\",\n token = NULL,\n commit = NULL,\n branch = NULL,\n pr = NULL,\n flags = NULL,\n quiet = TRUE\n)\n}\n\\arguments{\n\\item{...}{arguments passed to \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{coverage}{an existing coverage object to submit, if \\code{NULL},\n\\code{\\link[=package_coverage]{package_coverage()}} will be called with the arguments from\n\\code{...}}\n\n\\item{base_url}{Codecov url (change for Enterprise)}\n\n\\item{token}{a codecov upload token, if \\code{NULL} then following external\nsources will be checked in this order:\n\\enumerate{\n\\item the environment variable \\sQuote{CODECOV_TOKEN}. If it is empty, then\n\\item package will look at directory of the package for a file \\code{codecov.yml}.\nFile must have \\code{codecov} section where field \\code{token} is set to a token that\nwill be used.\n}}\n\n\\item{commit}{explicitly set the commit this coverage result object\ncorresponds to. Is looked up from the service or locally if it is\n\\code{NULL}.}\n\n\\item{branch}{explicitly set the branch this coverage result object\ncorresponds to, this is looked up from the service or locally if it is\n\\code{NULL}.}\n\n\\item{pr}{explicitly set the pr this coverage result object corresponds to,\nthis is looked up from the service if it is \\code{NULL}.}\n\n\\item{flags}{A flag to use for this coverage upload see\n\\url{https://docs.codecov.com/docs/flags} for details.}\n\n\\item{quiet}{if \\code{FALSE}, print the coverage before submission.}\n}\n\\description{\nRun covr on a package and upload the result to codecov.io\n}\n\\examples{\n\\dontrun{\ncodecov(path = \"test\")\n}\n}\n" }, { "path": "man/count.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_calls.R\n\\name{count}\n\\alias{count}\n\\title{increment a given counter}\n\\usage{\ncount(key)\n}\n\\arguments{\n\\item{key}{generated with \\code{\\link[=key]{key()}}}\n}\n\\description{\nincrement a given counter\n}\n\\keyword{internal}\n" }, { "path": "man/count_test.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{count_test}\n\\alias{count_test}\n\\title{Append a test trace to a counter, updating global current test}\n\\usage{\ncount_test(key)\n}\n\\arguments{\n\\item{key}{generated with \\code{\\link[=key]{key()}}}\n}\n\\description{\nAppend a test trace to a counter, updating global current test\n}\n\\keyword{internal}\n" }, { "path": "man/coverage_to_list.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{coverage_to_list}\n\\alias{coverage_to_list}\n\\title{Convert a coverage dataset to a list}\n\\usage{\ncoverage_to_list(x = package_coverage())\n}\n\\arguments{\n\\item{x}{a coverage dataset, defaults to running \\code{package_coverage()}.}\n}\n\\value{\nA list containing coverage result for each individual file and the whole package\n}\n\\description{\nConvert a coverage dataset to a list\n}\n" }, { "path": "man/coveralls.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/coveralls.R\n\\name{coveralls}\n\\alias{coveralls}\n\\title{Run covr on a package and upload the result to coveralls}\n\\usage{\ncoveralls(\n ...,\n coverage = NULL,\n repo_token = Sys.getenv(\"COVERALLS_TOKEN\"),\n service_name = Sys.getenv(\"CI_NAME\", \"travis-ci\"),\n quiet = TRUE\n)\n}\n\\arguments{\n\\item{...}{arguments passed to \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{coverage}{an existing coverage object to submit, if \\code{NULL},\n\\code{\\link[=package_coverage]{package_coverage()}} will be called with the arguments from\n\\code{...}}\n\n\\item{repo_token}{The secret repo token for your repository,\nfound at the bottom of your repository's page on Coveralls. This is useful\nif your job is running on a service Coveralls doesn't support out-of-the-box.\nIf set to NULL, it is assumed that the job is running on travis-ci}\n\n\\item{service_name}{the CI service to use, if environment variable\n\\sQuote{CI_NAME} is set that is used, otherwise \\sQuote{travis-ci} is used.}\n\n\\item{quiet}{if \\code{FALSE}, print the coverage before submission.}\n}\n\\description{\nRun covr on a package and upload the result to coveralls\n}\n" }, { "path": "man/covr-package.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\docType{package}\n\\name{covr-package}\n\\alias{covr}\n\\alias{covr-package}\n\\title{covr: Test coverage for packages}\n\\description{\ncovr tracks and reports code coverage for your package and (optionally)\nupload the results to a coverage service like 'Codecov' \\url{https://about.codecov.io} or\n'Coveralls' \\url{https://coveralls.io}. Code coverage is a measure of the amount of\ncode being exercised by a set of tests. It is an indirect measure of test\nquality and completeness. This package is compatible with any testing\nmethodology or framework and tracks coverage of both R code and compiled\nC/C++/FORTRAN code.\n}\n\\details{\nA coverage report can be used to inspect coverage for each line in your\npackage. Using \\code{report()} requires the additional dependencies \\code{DT} and \\code{htmltools}.\n\n\\if{html}{\\out{
}}\\preformatted{# If run with no arguments `report()` implicitly calls `package_coverage()`\nreport()\n}\\if{html}{\\out{
}}\n}\n\\section{Package options}{\n\n\n\\code{covr} uses the following \\code{\\link[=options]{options()}} to configure behaviour:\n\n\\itemize{\n\\item \\code{covr.covrignore}: A filename to use as an ignore file,\nlisting glob-style wildcarded paths of files to ignore for coverage\ncalculations. Defaults to the value of environment variable\n\\code{COVR_COVRIGNORE}, or \\code{\".covrignore\"} if the neither the option nor the\nenvironment variable are set.\n\n\\item \\code{covr.exclude_end}: Used along with \\code{covr.exclude_start}, an optional\nregular expression which ends a line-exclusion region. For more\ndetails, see \\code{?exclusions}.\n\n\\item \\code{covr.exclude_pattern}: An optional line-exclusion pattern. Lines\nwhich match the pattern will be excluded from coverage. For more details,\nsee \\code{?exclusions}.\n\n\\item \\code{covr.exclude_start}: Used along with \\code{covr.exclude_end}, an optional\nregular expression which starts a line-exclusion region. For more\ndetails, see \\code{?exclusions}.\n\n\\item \\code{covr.filter_non_package}: If \\code{TRUE} (the default behavior), coverage\nof files outside the target package are filtered from coverage output.\n\n\\item \\code{covr.fix_parallel_mcexit}:\n\n\\item \\code{covr.flags}:\n\n\\item \\code{covr.gcov}: If the appropriate gcov version is not on your path you\ncan use this option to set the appropriate location. If set to \"\" it will\nturn off coverage of compiled code.\n\n\\item \\code{covr.gcov_additional_paths}:\n\n\\item \\code{covr.gcov_args}:\n\n\\item \\code{covr.icov}:\n\n\\item \\code{covr.icov_args}:\n\n\\item \\code{covr.icov_flags}:\n\n\\item \\code{covr.icov_prof}:\n\n\\item \\code{covr.rstudio_source_markers}: A logical value. If \\code{TRUE} (the\ndefault behavior), source markers are displayed within the RStudio IDE\nwhen using \\code{zero_coverage}.\n\n\\item \\code{covr.record_tests}: If \\code{TRUE} (default \\code{NULL}), record a listing of\ntop level test expressions and associate tests with \\code{covr} traces\nevaluated during the test's execution. For more details, see\n\\code{?covr.record_tests}.\n\n\\item \\code{covr.showCfunctions}:\n}\n}\n\n\\seealso{\nUseful links:\n\\itemize{\n \\item \\url{https://covr.r-lib.org}\n \\item \\url{https://github.com/r-lib/covr}\n \\item Report bugs at \\url{https://github.com/r-lib/covr/issues}\n}\n\n}\n\\author{\n\\strong{Maintainer}: Jim Hester \\email{james.f.hester@gmail.com}\n\nOther contributors:\n\\itemize{\n \\item Willem Ligtenberg [contributor]\n \\item Kirill Müller [contributor]\n \\item Henrik Bengtsson [contributor]\n \\item Steve Peak [contributor]\n \\item Kirill Sevastyanenko [contributor]\n \\item Jon Clayden [contributor]\n \\item Robert Flight [contributor]\n \\item Eric Brown [contributor]\n \\item Brodie Gaslam [contributor]\n \\item Will Beasley [contributor]\n \\item Robert Krzyzanowski [contributor]\n \\item Markus Wamser [contributor]\n \\item Karl Forner [contributor]\n \\item Gergely Daróczi [contributor]\n \\item Jouni Helske [contributor]\n \\item Kun Ren [contributor]\n \\item Jeroen Ooms [contributor]\n \\item Ken Williams [contributor]\n \\item Chris Campbell [contributor]\n \\item David Hugh-Jones [contributor]\n \\item Qin Wang [contributor]\n \\item Doug Kelkhoff [contributor]\n \\item Ivan Sagalaev (highlight.js library) [contributor, copyright holder]\n \\item Mark Otto (Bootstrap library) [contributor]\n \\item Jacob Thornton (Bootstrap library) [contributor]\n \\item Bootstrap contributors (Bootstrap library) [contributor]\n \\item Twitter, Inc (Bootstrap library) [copyright holder]\n}\n\n}\n" }, { "path": "man/covr.record_tests.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{covr.record_tests}\n\\alias{covr.record_tests}\n\\title{Record Test Traces During Coverage Execution}\n\\description{\nBy setting \\code{options(covr.record_tests = TRUE)}, the result of covr coverage\ncollection functions will include additional data pertaining to the tests\nwhich are executed and an index of which tests, at what stack depth, trigger\nthe execution of each trace.\n}\n\\details{\nThis functionality requires that the package code and tests are installed and\nsourced with the source. For more details, refer to R options, \\code{keep.source},\n\\code{keep.source.pkgs} and \\code{keep.parse.data.pkgs}.\n}\n\\section{Additional fields}{\n\n\nWithin the \\code{covr} result, you can explore this information in two places:\n\n\\itemize{\n\\item \\code{attr(,\"tests\")}: A list of call stacks, which results in target code\nexecution.\n\n\\item \\verb{$$tests}: For each srcref count in the coverage object, a\n\\verb{$tests} field is now included which contains a matrix with three columns,\n\"test\", \"call\", \"depth\" and \"i\" which specify the test number\n(corresponding to the index of the test in \\code{attr(,\"tests\")}, the number\nof times the test expression was evaluated to produce the trace hit, the\nstack depth into the target code where the trace was executed, and the\norder of execution for each test.\n}\n}\n\n\\section{Test traces}{\n\n\nThe content of test traces are dependent on the unit testing framework that\nis used by the target package. The behavior is contingent on the available\ninformation in the sources kept for the testing files.\n\nTest traces are extracted by the following criteria:\n\\enumerate{\n\\item If any \\code{srcref} files are are provided by a file within \\link{covr}'s temporary\nlibrary, all calls from those files are kept as a test trace. This will\ncollect traces from tests run with common testing frameworks such as\n\\code{testthat} and \\code{RUnit}.\n\\item Otherwise, as a conservative fallback in situations where no source\nreferences are found, or when none are from within the temporary\ndirectory, the entire call stack is collected.\n}\n\nThese calls are subsequently subset for only those up until the call to\n\\link{covr}'s internal \\code{count} function, and will always include the last call in\nthe call stack prior to a call to \\code{count}.\n}\n\n\\examples{\nfcode <- '\nf <- function(x) {\n if (x)\n f(!x)\n else\n FALSE\n}'\n\noptions(covr.record_tests = TRUE)\ncov <- code_coverage(fcode, \"f(TRUE)\")\n\n# extract executed test code for the first test\ntail(attr(cov, \"tests\")[[1L]], 1L)\n# [[1]]\n# f(TRUE)\n\n# extract test itemization per trace\ncov[[3]][c(\"srcref\", \"tests\")]\n# $srcref\n# f(!x)\n#\n# $tests\n# test call depth i\n# [1,] 1 1 2 4\n\n# reconstruct the code path of a test by ordering test traces by [,\"i\"]\nlapply(cov, `[[`, \"tests\")\n# $`source.Ref2326138c55:4:6:4:10:6:10:4:4`\n# test call depth i\n# [1,] 1 1 1 2\n#\n# $`source.Ref2326138c55:3:8:3:8:8:8:3:3`\n# test call depth i\n# [1,] 1 1 1 1\n# [2,] 1 1 2 3\n#\n# $`source.Ref2326138c55:6:6:6:10:6:10:6:6`\n# test call depth i\n# [1,] 1 1 2 4\n\n}\n" }, { "path": "man/current_test_call_count.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{current_test_call_count}\n\\alias{current_test_call_count}\n\\title{Retrieve the number of times the test call was called}\n\\usage{\ncurrent_test_call_count()\n}\n\\value{\nAn integer value representing the number of calls of the current\ncall into the package from the testing suite.\n}\n\\description{\nA single test expression might be evaluated many times. Each time the same\nexpression is called, the call count is incremented.\n}\n" }, { "path": "man/current_test_index.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{current_test_index}\n\\alias{current_test_index}\n\\title{Retrieve the index for the test in \\code{.counters$tests}}\n\\usage{\ncurrent_test_index()\n}\n\\value{\nAn integer index for the test call\n}\n\\description{\nIf the test was encountered before, the index will be the index of the test\nin the logged tests list. Otherwise, the index will be the next index beyond\nthe length of the tests list.\n}\n\\keyword{internal}\n" }, { "path": "man/current_test_key.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{current_test_key}\n\\alias{current_test_key}\n\\title{Build key for the current test}\n\\usage{\ncurrent_test_key()\n}\n\\value{\nA unique character string if the test call has a srcref, or an empty\nstring otherwise.\n}\n\\description{\nIf the current test has a srcref, a unique character key is built from its\nsrcref. Otherwise, an empty string is returned.\n}\n\\keyword{internal}\n" }, { "path": "man/display_name.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/display_name.R\n\\name{display_name}\n\\alias{display_name}\n\\title{Retrieve the path name (filename) for each coverage object}\n\\usage{\ndisplay_name(x)\n}\n\\arguments{\n\\item{x}{A coverage object}\n}\n\\description{\nRetrieve the path name (filename) for each coverage object\n}\n\\keyword{internal}\n" }, { "path": "man/environment_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{environment_coverage}\n\\alias{environment_coverage}\n\\title{Calculate coverage of an environment}\n\\usage{\nenvironment_coverage(\n env = parent.frame(),\n test_files,\n line_exclusions = NULL,\n function_exclusions = NULL\n)\n}\n\\arguments{\n\\item{env}{The environment to be instrumented.}\n\n\\item{test_files}{Character vector of test files with code to test the\nfunctions}\n\n\\item{line_exclusions}{a named list of files with the lines to exclude from\neach file.}\n\n\\item{function_exclusions}{a vector of regular expressions matching function\nnames to exclude. Example \\verb{print\\\\\\\\\\\\.} to match print methods.}\n}\n\\description{\nCalculate coverage of an environment\n}\n" }, { "path": "man/exclusions.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/exclusions.R\n\\name{exclusions}\n\\alias{exclusions}\n\\title{Exclusions}\n\\description{\ncovr supports a couple of different ways of excluding some or all of a file.\n}\n\\section{Line Exclusions}{\n\n\nThe \\code{line_exclusions} argument to \\code{package_coverage()} can be used\nto exclude some or all of a file. This argument takes a list of filenames\nor named ranges to exclude.\n}\n\n\\section{Function Exclusions}{\n\n\nAlternatively \\code{function_exclusions} can be used to exclude R functions\nbased on regular expression(s). For example \\verb{print\\\\\\\\\\\\.*} can be used to\nexclude all the print methods defined in a package from coverage.\n}\n\n\\section{Exclusion Comments}{\n\n\nIn addition you can exclude lines from the coverage by putting special comments\nin your source code. This can be done per line or by specifying a range.\nThe patterns used can be specified by the \\code{exclude_pattern}, \\code{exclude_start},\n\\code{exclude_end} arguments to \\code{package_coverage()} or by setting the global\noptions \\code{covr.exclude_pattern}, \\code{covr.exclude_start}, \\code{covr.exclude_end}.\n}\n\n\\examples{\n\\dontrun{\n# exclude whole file of R/test.R\npackage_coverage(exclusions = \"R/test.R\")\n\n# exclude lines 1 to 10 and 15 from R/test.R\npackage_coverage(line_exclusions = list(\"R/test.R\" = c(1:10, 15)))\n\n# exclude lines 1 to 10 from R/test.R, all of R/test2.R\npackage_coverage(line_exclusions = list(\"R/test.R\" = 1:10, \"R/test2.R\"))\n\n# exclude all print and format methods from the package.\npackage_coverage(function_exclusions = c(\"print\\\\\\\\.\", \"format\\\\\\\\.\"))\n\n# single line exclusions\nf1 <- function(x) {\n x + 1 # nocov\n}\n\n# ranged exclusions\nf2 <- function(x) { # nocov start\n x + 2\n} # nocov end\n}\n}\n" }, { "path": "man/file_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{file_coverage}\n\\alias{file_coverage}\n\\title{Calculate test coverage for sets of files}\n\\usage{\nfile_coverage(\n source_files,\n test_files,\n line_exclusions = NULL,\n function_exclusions = NULL,\n parent_env = parent.frame()\n)\n}\n\\arguments{\n\\item{source_files}{Character vector of source files with function\ndefinitions to measure coverage}\n\n\\item{test_files}{Character vector of test files with code to test the\nfunctions}\n\n\\item{line_exclusions}{a named list of files with the lines to exclude from\neach file.}\n\n\\item{function_exclusions}{a vector of regular expressions matching function\nnames to exclude. Example \\verb{print\\\\\\\\\\\\.} to match print methods.}\n\n\\item{parent_env}{The parent environment to use when sourcing the files.}\n}\n\\description{\nThe files in \\code{source_files} are first sourced into a new environment\nto define functions to be checked. Then they are instrumented to track\ncoverage and the files in \\code{test_files} are sourced.\n}\n\\examples{\n# For the purpose of this example, save code containing code and tests to files\ncat(\"add <- function(x, y) { x + y }\", file=\"add.R\")\ncat(\"add(1, 2) == 3\", file=\"add_test.R\")\n\n# Use file_coverage() to calculate test coverage\nfile_coverage(source_files = \"add.R\", test_files = \"add_test.R\")\n\n# cleanup\nfile.remove(c(\"add.R\", \"add_test.R\"))\n}\n" }, { "path": "man/file_report.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/report.R\n\\name{file_report}\n\\alias{file_report}\n\\title{A coverage report for a specific file}\n\\usage{\nfile_report(\n x = package_coverage(),\n file = NULL,\n out_file = file.path(tempdir(), paste0(get_package_name(x), \"-file-report.html\")),\n browse = interactive()\n)\n}\n\\arguments{\n\\item{x}{a coverage dataset, defaults to running \\code{package_coverage()}.}\n\n\\item{file}{The file to report on, if \\code{NULL}, use the first file in the\ncoverage output.}\n\n\\item{out_file}{The output file}\n\n\\item{browse}{whether to open a browser to view the report.}\n}\n\\description{\nA coverage report for a specific file\n}\n" }, { "path": "man/function_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{function_coverage}\n\\alias{function_coverage}\n\\title{Calculate test coverage for a specific function.}\n\\usage{\nfunction_coverage(fun, code = NULL, env = NULL, enc = parent.frame())\n}\n\\arguments{\n\\item{fun}{name of the function.}\n\n\\item{code}{expressions to run.}\n\n\\item{env}{environment the function is defined in.}\n\n\\item{enc}{the enclosing environment which to run the expressions.}\n}\n\\description{\nCalculate test coverage for a specific function.\n}\n\\examples{\nadd <- function(x, y) { x + y }\nfunction_coverage(fun = add, code = NULL) # 0\\% coverage\nfunction_coverage(fun = add, code = add(1, 2) == 3) # 100\\% coverage\n}\n" }, { "path": "man/gitlab.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/gitlab.R\n\\name{gitlab}\n\\alias{gitlab}\n\\title{Run covr on package and create report for GitLab}\n\\usage{\ngitlab(..., coverage = NULL, file = \"public/coverage.html\", quiet = TRUE)\n}\n\\arguments{\n\\item{...}{arguments passed to \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{coverage}{an existing coverage object to submit, if \\code{NULL},\n\\code{\\link[=package_coverage]{package_coverage()}} will be called with the arguments from\n\\code{...}}\n\n\\item{file}{The report filename.}\n\n\\item{quiet}{if \\code{FALSE}, print the coverage before submission.}\n}\n\\description{\nUtilize internal GitLab static pages to publish package coverage.\nCreates local covr report in a package subdirectory.\nUses the \\href{https://docs.gitlab.com/user/project/pages/}{pages}\nGitLab job to publish the report.\n}\n" }, { "path": "man/has_srcref.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{has_srcref}\n\\alias{has_srcref}\n\\title{Is the source bound to the expression}\n\\usage{\nhas_srcref(expr)\n}\n\\arguments{\n\\item{expr}{A language object which may have a \\code{srcref} attribute}\n}\n\\value{\nA logical value indicating whether the language object has source\n}\n\\description{\nIs the source bound to the expression\n}\n" }, { "path": "man/in_covr.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{in_covr}\n\\alias{in_covr}\n\\title{Determine if code is being run in covr}\n\\usage{\nin_covr()\n}\n\\description{\ncovr functions set the environment variable \\code{R_COVR} when they are running.\n\\code{\\link[=in_covr]{in_covr()}} returns \\code{TRUE} if this environment variable is set and \\code{FALSE}\notherwise.\n}\n\\examples{\nif (require(testthat)) {\n testthat::skip_if(in_covr())\n}\n}\n" }, { "path": "man/is_covr_count_call.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{is_covr_count_call}\n\\alias{is_covr_count_call}\n\\title{Is the expression a call to covr:::count}\n\\usage{\nis_covr_count_call(expr)\n}\n\\arguments{\n\\item{expr}{A language object}\n}\n\\value{\nA logical value indicating whether the object is a call to\n\\code{covr:::count}.\n}\n\\description{\nIs the expression a call to covr:::count\n}\n" }, { "path": "man/is_current_test_finished.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{is_current_test_finished}\n\\alias{is_current_test_finished}\n\\title{Returns TRUE if we've moved on from test reflected in .current_test}\n\\usage{\nis_current_test_finished()\n}\n\\description{\nQuickly dismiss the need to update the current test if we can. To test if\nwe're still in the last test, check if the same srcref (or call, if source is\nnot kept) exists at the last recorded calling frame prior to entering a covr\ntrace. If this has changed, do a more comprehensive test to see if any of the\ntest call stack has changed, in which case we are onto a new test.\n}\n" }, { "path": "man/key.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_calls.R\n\\name{key}\n\\alias{key}\n\\title{Generate a key for a call}\n\\usage{\nkey(x)\n}\n\\arguments{\n\\item{x}{the srcref of the call to create a key for}\n}\n\\description{\nGenerate a key for a call\n}\n\\keyword{internal}\n" }, { "path": "man/new_counter.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_calls.R\n\\name{new_counter}\n\\alias{new_counter}\n\\title{initialize a new counter}\n\\usage{\nnew_counter(src_ref, parent_functions)\n}\n\\arguments{\n\\item{src_ref}{a \\code{\\link[base:srcfile]{base::srcref()}}}\n\n\\item{parent_functions}{the functions that this srcref is contained in.}\n}\n\\description{\ninitialize a new counter\n}\n\\keyword{internal}\n" }, { "path": "man/new_test_counter.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{new_test_counter}\n\\alias{new_test_counter}\n\\title{Initialize a new test counter for a coverage trace}\n\\usage{\nnew_test_counter(key)\n}\n\\arguments{\n\\item{key}{generated with \\code{\\link[=key]{key()}}}\n}\n\\description{\nInitialize a test counter, a matrix used to tally tests, their stack depth\nand the execution order as the trace associated with \\code{key} is hit. Each\ntest trace is an environment, which allows assignment into a pre-allocated\n\\code{tests} matrix with minimall reallocation.\n}\n\\details{\nThe \\code{tests} matrix has columns \\code{tests}, \\code{depth} and \\code{i},\ncorresponding to the test index (the index of the associated test in\n\\code{.counters$tests}), the stack depth when the trace is evaluated and the\nnumber of traces that have been hit so far during test evaluation.\n}\n" }, { "path": "man/package_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/covr.R\n\\name{package_coverage}\n\\alias{package_coverage}\n\\title{Calculate test coverage for a package}\n\\usage{\npackage_coverage(\n path = \".\",\n type = c(\"tests\", \"vignettes\", \"examples\", \"all\", \"none\"),\n combine_types = TRUE,\n relative_path = TRUE,\n quiet = TRUE,\n clean = TRUE,\n line_exclusions = NULL,\n function_exclusions = NULL,\n code = character(),\n install_path = temp_file(\"R_LIBS\"),\n ...,\n exclusions,\n pre_clean = TRUE\n)\n}\n\\arguments{\n\\item{path}{file path to the package.}\n\n\\item{type}{run the package \\sQuote{tests}, \\sQuote{vignettes},\n\\sQuote{examples}, \\sQuote{all}, or \\sQuote{none}. The default is\n\\sQuote{tests}.}\n\n\\item{combine_types}{If \\code{TRUE} (the default) the coverage for all types\nis simply summed into one coverage object. If \\code{FALSE} separate objects\nare used for each type of coverage.}\n\n\\item{relative_path}{whether to output the paths as relative or absolute\npaths. If a string, it is interpreted as a root path and all paths will be\nrelative to that root.}\n\n\\item{quiet}{whether to load and compile the package quietly, useful for\ndebugging errors.}\n\n\\item{clean}{whether to clean temporary output files after running, mainly\nuseful for debugging errors.}\n\n\\item{line_exclusions}{a named list of files with the lines to exclude from\neach file.}\n\n\\item{function_exclusions}{a vector of regular expressions matching function\nnames to exclude. Example \\verb{print\\\\\\\\\\\\.} to match print methods.}\n\n\\item{code}{A character vector of additional test code to run.}\n\n\\item{install_path}{The path the instrumented package will be installed to\nand tests run in. By default it is a path in the R sessions temporary\ndirectory. It can sometimes be useful to set this (along with \\code{clean = FALSE}) to help debug test failures.}\n\n\\item{...}{Additional arguments passed to \\code{\\link[tools:testInstalledPackage]{tools::testInstalledPackage()}}.}\n\n\\item{exclusions}{\\sQuote{Deprecated}, please use \\sQuote{line_exclusions} instead.}\n\n\\item{pre_clean}{whether to delete all objects present in the src directory before recompiling}\n}\n\\description{\nThis function calculates the test coverage for a development package on the\n\\code{path}. By default it runs only the package tests, but it can also run\nvignette and example code.\n}\n\\details{\nThis function uses \\code{\\link[tools:testInstalledPackage]{tools::testInstalledPackage()}} to run the\ncode, if you would like to test your package in another way you can set\n\\code{type = \"none\"} and pass the code to run as a character vector to the\n\\code{code} parameter.\n\n#ifdef unix\nParallelized code using \\pkg{parallel}'s \\code{\\link[=mcparallel]{mcparallel()}} needs to\nuse a patched \\code{parallel:::mcexit}. This is done automatically if the\npackage depends on \\pkg{parallel}, but can also be explicitly set using the\nenvironment variable \\code{COVR_FIX_PARALLEL_MCEXIT} or the global option\n\\code{covr.fix_parallel_mcexit}.\n#endif\n}\n\\seealso{\n\\code{\\link[=exclusions]{exclusions()}} For details on excluding parts of the\npackage from the coverage calculations.\n}\n" }, { "path": "man/percent_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/summary_functions.R\n\\name{percent_coverage}\n\\alias{percent_coverage}\n\\title{Provide percent coverage of package}\n\\usage{\npercent_coverage(x, ...)\n}\n\\arguments{\n\\item{x}{the coverage object returned from \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{...}{additional arguments passed to \\code{\\link[=tally_coverage]{tally_coverage()}}}\n}\n\\value{\nThe total percentage as a \\code{numeric(1)}.\n}\n\\description{\nCalculate the total percent coverage from a coverage result object.\n}\n" }, { "path": "man/print.coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/summary_functions.R\n\\name{print.coverage}\n\\alias{print.coverage}\n\\title{Print a coverage object}\n\\usage{\n\\method{print}{coverage}(x, group = c(\"filename\", \"functions\"), by = \"line\", ...)\n}\n\\arguments{\n\\item{x}{the coverage object to be printed}\n\n\\item{group}{whether to group coverage by filename or function}\n\n\\item{by}{whether to count coverage by line or expression}\n\n\\item{...}{additional arguments ignored}\n}\n\\value{\nThe coverage object (invisibly).\n}\n\\description{\nPrint a coverage object\n}\n" }, { "path": "man/report.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/report.R\n\\name{report}\n\\alias{report}\n\\title{Display covr results using a standalone report}\n\\usage{\nreport(\n x = package_coverage(),\n file = file.path(tempdir(), paste0(get_package_name(x), \"-report.html\")),\n browse = interactive()\n)\n}\n\\arguments{\n\\item{x}{a coverage dataset, defaults to running \\code{package_coverage()}.}\n\n\\item{file}{The report filename.}\n\n\\item{browse}{whether to open a browser to view the report.}\n}\n\\description{\nDisplay covr results using a standalone report\n}\n\\examples{\n\\dontrun{\nx <- package_coverage()\nreport(x)\n}\n}\n" }, { "path": "man/system_check.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/system.R\n\\name{system_check}\n\\alias{system_check}\n\\title{Run a system command and check if it succeeds.}\n\\usage{\nsystem_check(\n cmd,\n args = character(),\n env = character(),\n quiet = FALSE,\n echo = FALSE,\n ...\n)\n}\n\\arguments{\n\\item{cmd}{the command to run.}\n\n\\item{args}{a vector of command arguments.}\n\n\\item{env}{a named character vector of environment variables. Will be quoted}\n\n\\item{quiet}{if \\code{TRUE}, the command output will be echoed.}\n\n\\item{echo}{if \\code{TRUE}, the command to run will be echoed.}\n\n\\item{...}{additional arguments passed to \\code{\\link[base:system]{base::system()}}}\n}\n\\value{\n\\code{TRUE} if the command succeeds, an error will be thrown if the\ncommand fails.\n}\n\\description{\nThis function automatically quotes both the command and each\nargument so they are properly protected from shell expansion.\n}\n\\keyword{internal}\n" }, { "path": "man/system_output.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/system.R\n\\name{system_output}\n\\alias{system_output}\n\\title{Run a system command and capture the output.}\n\\usage{\nsystem_output(\n cmd,\n args = character(),\n env = character(),\n quiet = FALSE,\n echo = FALSE,\n ...\n)\n}\n\\arguments{\n\\item{cmd}{the command to run.}\n\n\\item{args}{a vector of command arguments.}\n\n\\item{env}{a named character vector of environment variables. Will be quoted}\n\n\\item{quiet}{if \\code{TRUE}, the command output will be echoed.}\n\n\\item{echo}{if \\code{TRUE}, the command to run will be echoed.}\n\n\\item{...}{additional arguments passed to \\code{\\link[base:system]{base::system()}}}\n}\n\\value{\ncommand output if the command succeeds, an error will be thrown if\nthe command fails.\n}\n\\description{\nThis function automatically quotes both the command and each\nargument so they are properly protected from shell expansion.\n}\n\\keyword{internal}\n" }, { "path": "man/tally_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/summary_functions.R\n\\name{tally_coverage}\n\\alias{tally_coverage}\n\\title{Tally coverage by line or expression}\n\\usage{\ntally_coverage(x, by = c(\"line\", \"expression\"))\n}\n\\arguments{\n\\item{x}{the coverage object returned from \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{by}{whether to tally coverage by line or expression}\n}\n\\value{\na \\code{data.frame} of coverage tallied by line or expression.\n}\n\\description{\nTally coverage by line or expression\n}\n" }, { "path": "man/to_cobertura.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/cobertura.R\n\\name{to_cobertura}\n\\alias{to_cobertura}\n\\title{Create a Cobertura XML file}\n\\usage{\nto_cobertura(cov, filename = \"cobertura.xml\")\n}\n\\arguments{\n\\item{cov}{the coverage object returned from \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{filename}{the name of the Cobertura XML file}\n}\n\\description{\nCreate a\ncobertura-compliant XML report following \\href{https://github.com/cobertura/cobertura/blob/master/cobertura/src/site/htdocs/xml/coverage-04.dtd}{this DTD}.\nBecause there are \\emph{two} DTDs called \\verb{coverage-04.dtd} and some tools do not seem to\nadhere to either of them, the parser you're using may balk at the file. Please see\n\\href{https://github.com/cobertura/cobertura/issues/425}{this github discussion} for\ncontext. Where \\code{covr} doesn't provide a coverage metric (branch coverage,\ncomplexity), a zero is reported.\n}\n\\details{\n\\emph{Note}: This functionality requires the xml2 package be installed.\n}\n" }, { "path": "man/to_sonarqube.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/sonarqube.R\n\\name{to_sonarqube}\n\\alias{to_sonarqube}\n\\title{Create a SonarQube Generic XML file for test coverage according to\nhttps://docs.sonarqube.org/latest/analysis/generic-test/\nBased on cobertura.R}\n\\usage{\nto_sonarqube(cov, filename = \"sonarqube.xml\")\n}\n\\arguments{\n\\item{cov}{the coverage object returned from \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{filename}{the name of the SonarQube Generic XML file}\n}\n\\description{\nThis functionality requires the xml2 package be installed.\n}\n\\author{\nTalkdesk Inc.\n}\n" }, { "path": "man/trace_calls.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_calls.R\n\\name{trace_calls}\n\\alias{trace_calls}\n\\title{trace each call with a srcref attribute}\n\\usage{\ntrace_calls(x, parent_functions = NULL, parent_ref = NULL)\n}\n\\arguments{\n\\item{x}{the call}\n\n\\item{parent_functions}{the functions which this call is a child of.}\n\n\\item{parent_ref}{argument used to set the srcref of the current call during\nthe recursion.}\n}\n\\value{\na modified expression with count calls inserted before each previous\ncall.\n}\n\\description{\nThis function calls itself recursively so it can properly traverse the AST.\n}\n\\seealso{\n\\url{http://adv-r.had.co.nz/Expressions.html}\n}\n\\keyword{internal}\n" }, { "path": "man/truncate_call.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{truncate_call}\n\\alias{truncate_call}\n\\title{Truncate call objects to limit the number of arguments}\n\\usage{\ntruncate_call(call_obj, limit = 10000)\n}\n\\arguments{\n\\item{call_obj}{A (possibly large) \\code{call} object}\n\n\\item{limit}{A \\code{call} length limit to impose}\n}\n\\value{\nThe \\code{call_obj} with arguments trimmed\n}\n\\description{\nA helper to circumvent R errors when deserializing large call objects from\nRds. Trims the number of arguments in a call object, and replaces the last\nargument with a \\verb{} symbol.\n}\n" }, { "path": "man/update_current_test.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trace_tests.R\n\\name{update_current_test}\n\\alias{update_current_test}\n\\title{Update current test if unit test expression has progressed}\n\\usage{\nupdate_current_test()\n}\n\\description{\nUpdating a test logs some metadata regarding the current call stack, noteably\ntrying to capture information about the call stack prior to the covr::count\ncall being traced.\n}\n\\details{\nThere are a couple patterns of behavior, which try to accommodate a variety\nof testing suites:\n\n\\itemize{\n\\item \\code{testthat}: During execution of \\code{testthat}'s \\verb{test_*} functions,\nfiles are sourced and the working directory is temporarily changed to the\npackage \\verb{/tests} directory. Knowing this, calls in the call stack which\nare relative to this directory are extracted and recorded.\n\\item \\code{RUnit}:\n\\item \\code{custom}: Any other custom test suites may not have source kept with\ntheir execution, in which case the entire test call stack is kept.\n}\n\nchecks to see if the current call stack has the same\n\\code{srcref} (or expression, if no source is available) at the same frame prior\nto entering into a package where \\code{covr:::count} is called.\n}\n\\keyword{internal}\n" }, { "path": "man/value.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/value.R\n\\name{value}\n\\alias{value}\n\\title{Retrieve the value from an object}\n\\usage{\nvalue(x, ...)\n}\n\\arguments{\n\\item{x}{object from which to retrieve the value}\n\n\\item{...}{additional arguments passed to methods}\n}\n\\description{\nRetrieve the value from an object\n}\n" }, { "path": "man/zero_coverage.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/summary_functions.R\n\\name{zero_coverage}\n\\alias{zero_coverage}\n\\title{Provide locations of zero coverage}\n\\usage{\nzero_coverage(x, ...)\n}\n\\arguments{\n\\item{x}{a coverage object returned \\code{\\link[=package_coverage]{package_coverage()}}}\n\n\\item{...}{additional arguments passed to\n\\code{\\link[=tally_coverage]{tally_coverage()}}}\n}\n\\value{\nA \\code{data.frame} with coverage data where the coverage is 0.\n}\n\\description{\nWhen examining the test coverage of a package, it is useful to know if there are\nany locations where there is \\strong{0} test coverage.\n}\n\\details{\nif used within RStudio this function outputs the results using the\nMarker API.\n}\n" }, { "path": "shim_package.sh", "content": "#!/usr/bin/env sh\n\nperl -i -pe 's/\\bcovr\\b/covrShim/g;s/\\bcovr_/covrShim_/g;s/_covr/_covrShim/g;' DESCRIPTION NAMESPACE R/* src/* tests/*R tests/testthat/*R\n" }, { "path": "src/reassign.c", "content": "#define USE_RINTERNALS\n#include \n#include \n#include \n#include \n#include \n#include // for NULL\n#include // for uint64_t\n\n\ninline static\nvoid CheckBody(SEXP x) {\n switch (TYPEOF(x)) {\n case NILSXP:\n case SYMSXP:\n case LISTSXP:\n // case CLOSXP:\n case ENVSXP:\n case PROMSXP:\n case LANGSXP:\n // case SPECIALSXP:\n // case BUILTINSXP:\n case CHARSXP:\n case LGLSXP:\n case INTSXP:\n case REALSXP:\n case CPLXSXP:\n case STRSXP:\n // case DOTSXP:\n // case ANYSXP:\n case VECSXP:\n case EXPRSXP:\n case BCODESXP:\n case EXTPTRSXP:\n case WEAKREFSXP:\n case RAWSXP:\n case S4SXP: // renamed to OBJSXP\n return;\n\n default:\n error(\"Unexpected closure body type\");\n }\n}\n\ninline static\nvoid CheckEnvironment(SEXP x) {\n if(TYPEOF(x) != ENVSXP)\n error(\"Unexpected closure env type\");\n}\n\ninline static\nvoid CheckFormals(SEXP ls) {\n // copied from R:\n // https://github.com/wch/r-source/blob/tags/R-4-4-2/src/main/eval.c#L3842-L3852\n if (isList(ls)) {\n for (; ls != R_NilValue; ls = CDR(ls))\n if (TYPEOF(TAG(ls)) != SYMSXP)\n goto err;\n return;\n }\n err:\n error(\"Unexpected closure formals\");\n}\n\nSEXP covr_reassign_function(SEXP old_fun, SEXP new_fun) {\n if (TYPEOF(old_fun) != CLOSXP) error(\"old_fun must be a function\");\n if (TYPEOF(new_fun) != CLOSXP) error(\"new_fun must be a function\");\n\n // The goal is to modify `old_fun` in place, so that all existing references\n // to `old_fun` call the tracing `new_fun` instead.\n // This used to be simply:\n // SET_FORMALS(old_fun, FORMALS(new_fun));\n // SET_BODY(old_fun, BODY(new_fun));\n // SET_CLOENV(old_fun, CLOENV(new_fun));\n // But those functions are now \"non-API\". So we comply with the letter of the\n // law and swap the fields manually, making some hard assumptions about the\n // underlying memory layout in the process.\n // Rather than using memcpy() with a hard-coded byte offset, we mirror the R\n // internals SEXPREC struct defs here, to hopefully match the alignment\n // behavior of R (e.g., on windows).\n\n // Mirror the exact structures of SEXPREC from R internals\n struct proxy_sxpinfo_struct {\n uint64_t bits; // guaranteed to be 64 bits\n };\n\n struct proxy_closxp_struct {\n struct SEXPREC *formals;\n struct SEXPREC *body;\n struct SEXPREC *env;\n };\n\n struct proxy_sexprec {\n struct proxy_sxpinfo_struct sxpinfo;\n struct SEXPREC *attrib;\n struct SEXPREC *gengc_next_node, *gengc_prev_node;\n union {\n struct proxy_closxp_struct closxp;\n // We could add other union members if needed\n } u;\n };\n\n typedef struct proxy_sexprec* proxy_sexp;\n\n proxy_sexp old = (proxy_sexp) old_fun;\n proxy_sexp new = (proxy_sexp) new_fun;\n\n // Sanity checks. If the closxp struct is not what we expect, then the\n // underlying internal memory layout of a CLOSXP has probably changed and we\n // need to update this code.\n // https://github.com/wch/r-source/blob/tags/R-4-4-2/src/include/Defn.h#L170-L174\n CheckFormals(old->u.closxp.formals);\n CheckFormals(new->u.closxp.formals);\n CheckBody(old->u.closxp.body);\n CheckBody(new->u.closxp.body);\n CheckEnvironment(old->u.closxp.env);\n CheckEnvironment(new->u.closxp.env);\n\n MARK_NOT_MUTABLE(old_fun);\n MARK_NOT_MUTABLE(old->u.closxp.body);\n MARK_NOT_MUTABLE(old->u.closxp.env);\n MARK_NOT_MUTABLE(old->u.closxp.formals);\n\n MARK_NOT_MUTABLE(new_fun);\n MARK_NOT_MUTABLE(new->u.closxp.body);\n MARK_NOT_MUTABLE(new->u.closxp.env);\n MARK_NOT_MUTABLE(new->u.closxp.formals);\n\n old->u.closxp = new->u.closxp;\n\n // Duplicate attributes is still not \"non-API\", thankfully.\n DUPLICATE_ATTRIB(old_fun, new_fun);\n\n return R_NilValue;\n}\n\n\nSEXP covr_duplicate_(SEXP x) { return duplicate(x); }\n\n/* .Call calls */\nextern SEXP covr_duplicate_(SEXP);\nextern SEXP covr_reassign_function(SEXP, SEXP);\n\nstatic const R_CallMethodDef CallEntries[] = {\n {\"covr_duplicate_\", (DL_FUNC)&covr_duplicate_, 1},\n {\"covr_reassign_function\", (DL_FUNC)&covr_reassign_function, 2},\n {NULL, NULL, 0}};\n\nvoid R_init_covr(DllInfo *dll) {\n R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);\n R_useDynamicSymbols(dll, FALSE);\n}\n" }, { "path": "tests/testthat/Test+Char/TestCompiled/DESCRIPTION", "content": "Package: TestCompiled\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nSuggests:\n testthat\nRoxygenNote: 7.1.1\n" }, { "path": "tests/testthat/Test+Char/TestCompiled/NAMESPACE", "content": "# Generated by roxygen2: do not edit by hand\n\nuseDynLib(TestCompiled,simple_)\n" }, { "path": "tests/testthat/Test+Char/TestCompiled/R/TestCompiled.R", "content": "#' an example function\n#'\n#' @useDynLib TestCompiled simple_\nsimple <- function(x) {\n .Call(simple_, x) # nolint\n}\n" }, { "path": "tests/testthat/Test+Char/TestCompiled/man/simple.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/TestCompiled.R\n\\name{simple}\n\\alias{simple}\n\\title{an example function}\n\\usage{\nsimple(x)\n}\n\\description{\nan example function\n}\n" }, { "path": "tests/testthat/Test+Char/TestCompiled/src/simple.cc", "content": "#define USE_RINTERNALS\n#include \n#include \n#include \n\nextern \"C\" SEXP simple_(SEXP x) {\n double *px, *pout;\n\n SEXP out = PROTECT(Rf_allocVector(REALSXP, 1));\n\n px = REAL(x);\n pout = REAL(out);\n\n if (px[0] >= 1) {\n pout[0] = 1;\n }\n else if (px[0] == 0) {\n pout[0] = 0;\n } else {\n pout[0] = -1;\n }\n UNPROTECT(1);\n\n return out;\n}\n" }, { "path": "tests/testthat/Test+Char/TestCompiled/tests/testthat/test-TestCompiled.R", "content": "test_that(\"compiled function simple works\", {\n expect_equal(simple(1), 1)\n expect_equal(simple(2), 1)\n expect_equal(simple(3), 1)\n expect_equal(simple(-1), -1)\n})\n" }, { "path": "tests/testthat/Test+Char/TestCompiled/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestCompiled\")\n\ntest_check(\"TestCompiled\")\n" }, { "path": "tests/testthat/TestCompiled/DESCRIPTION", "content": "Package: TestCompiled\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nSuggests:\n testthat\nRoxygenNote: 5.0.1\n" }, { "path": "tests/testthat/TestCompiled/NAMESPACE", "content": "# Generated by roxygen2: do not edit by hand\n\nuseDynLib(TestCompiled,simple_)\nuseDynLib(TestCompiled,simple3_)\nuseDynLib(TestCompiled,simple4_)\n" }, { "path": "tests/testthat/TestCompiled/R/TestCompiled.R", "content": "#' an example function\n#'\n#' @useDynLib TestCompiled simple_\nsimple <- function(x) {\n .Call(simple_, x) # nolint\n}\n\nsimple3 <- function(x) {\n .Call(simple3_, x) # nolint\n}\n\nsimple4 <- function(x) {\n .Call(simple4_, x) # nolint\n}\n" }, { "path": "tests/testthat/TestCompiled/man/simple.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/TestCompiled.R\n\\name{simple}\n\\alias{simple}\n\\title{an example function}\n\\usage{\nsimple(x)\n}\n\\description{\nan example function\n}\n\n" }, { "path": "tests/testthat/TestCompiled/src/simple-header.h", "content": "#pragma once\n\n#define USE_RINTERNALS\n#include \n#include \n#include \n\ntemplate \nSEXP simple2_(SEXP x) {\n R *px, *pout;\n\n SEXP out = PROTECT(Rf_allocVector(R_SXP, 1));\n\n px = (R *) DATAPTR(x);\n pout = (R *) DATAPTR(out);\n\n if (px[0] >= 1) {\n pout[0] = 1;\n }\n else if (px[0] == 0) {\n pout[0] = 0;\n } else {\n pout[0] = -1;\n }\n UNPROTECT(1);\n\n return out;\n}\n" }, { "path": "tests/testthat/TestCompiled/src/simple.cc", "content": "#define USE_RINTERNALS\n#include \n#include \n#include \n#include \"simple-header.h\"\n\nextern \"C\" SEXP simple_(SEXP x) {\n double *px, *pout;\n\n SEXP out = PROTECT(Rf_allocVector(REALSXP, 1));\n\n px = REAL(x);\n pout = REAL(out);\n\n if (px[0] >= 1) {\n pout[0] = 1;\n }\n else if (px[0] == 0) {\n pout[0] = 0;\n } else {\n pout[0] = -1;\n }\n UNPROTECT(1);\n\n return out;\n}\n\nextern \"C\" SEXP simple3_(SEXP x) {\n return simple2_(x);\n}\n" }, { "path": "tests/testthat/TestCompiled/src/simple4.cc", "content": "#define USE_RINTERNALS\n#include \n#include \n#include \n#include \"simple-header.h\"\n\nextern \"C\" SEXP simple4_(SEXP x) {\n return simple2_(x);\n}\n" }, { "path": "tests/testthat/TestCompiled/tests/testthat/test-TestCompiled.R", "content": "test_that(\"compiled function simple works\", {\n expect_equal(simple(1), 1)\n expect_equal(simple(2), 1)\n expect_equal(simple(3), 1)\n expect_equal(simple(-1), -1)\n})\n\ntest_that(\"compiled function simple3 works\", {\n expect_equal(simple3(1), 1)\n expect_equal(simple3(2), 1)\n})\n\ntest_that(\"compiled function simple4 works\", {\n expect_equal(simple4(3L), 1L)\n expect_equal(simple4(-1L), -1L)\n})\n" }, { "path": "tests/testthat/TestCompiled/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestCompiled\")\n\ntest_check(\"TestCompiled\")\n" }, { "path": "tests/testthat/TestCompiledSubdir/DESCRIPTION", "content": "Package: TestCompiledSubdir\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nSuggests:\n testthat\n" }, { "path": "tests/testthat/TestCompiledSubdir/NAMESPACE", "content": "# Generated by roxygen2 (4.1.1): do not edit by hand\n\nuseDynLib(TestCompiledSubdir,simple_)\n" }, { "path": "tests/testthat/TestCompiledSubdir/R/TestCompiledSubdir.R", "content": "#' an example function\n#'\n#' @useDynLib TestCompiledSubdir simple_\nsimple <- function(x) {\n .Call(simple_, x) # nolint\n}\n" }, { "path": "tests/testthat/TestCompiledSubdir/man/simple.Rd", "content": "% Generated by roxygen2 (4.1.1): do not edit by hand\n% Please edit documentation in R/TestCompiledSubdir.R\n\\name{simple}\n\\alias{simple}\n\\title{an example function}\n\\usage{\nsimple(x)\n}\n\\description{\nan example function\n}\n\n" }, { "path": "tests/testthat/TestCompiledSubdir/src/Makevars", "content": "OBJECTS = lib/simple.o\n" }, { "path": "tests/testthat/TestCompiledSubdir/src/lib/simple.c", "content": "#define USE_RINTERNALS\n#include \n#include \n#include \n\nSEXP simple_(SEXP x) {\n double *px, *pout;\n\n SEXP out = PROTECT(Rf_allocVector(REALSXP, 1));\n\n px = REAL(x);\n pout = REAL(out);\n\n if (px[0] >= 1) {\n pout[0] = 1;\n }\n else if (px[0] == 0) {\n pout[0] = 0;\n } else {\n pout[0] = -1;\n }\n UNPROTECT(1);\n\n return out;\n}\n" }, { "path": "tests/testthat/TestCompiledSubdir/tests/testthat/test-TestCompiledSubdir.R", "content": "test_that(\"compiled function simple works\", {\n expect_equal(simple(1), 1)\n expect_equal(simple(2), 1)\n expect_equal(simple(3), 1)\n expect_equal(simple(-1), -1)\n})\n" }, { "path": "tests/testthat/TestCompiledSubdir/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestCompiledSubdir\")\n\ntest_check(\"TestCompiledSubdir\")\n" }, { "path": "tests/testthat/TestExclusion/DESCRIPTION", "content": "Package: TestExclusion\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\n" }, { "path": "tests/testthat/TestExclusion/NAMESPACE", "content": "# Generated by roxygen2 (4.1.1): do not edit by hand\n\nexport(dont_test_me)\nexport(test_exclusion)\nexport(test_me)\n" }, { "path": "tests/testthat/TestExclusion/R/TestExclusion.R", "content": "#' an example function\n#'\n#' @export\ntest_me <- function(x, y){\n x + y\n}\n\n# nocov start\n#' @export\ndont_test_me <- function(x, y){\n x * y\n}\n# nocov end\n\n#' @export\ntest_exclusion <- function(x) {\n if (x > 5) {\n 1 # nocov\n } else {\n 2\n }\n}\n" }, { "path": "tests/testthat/TestExclusion/man/test_me.Rd", "content": "% Generated by roxygen2 (4.1.1): do not edit by hand\n% Please edit documentation in R/TestExclusion.R\n\\name{test_me}\n\\alias{test_me}\n\\title{an example function}\n\\usage{\ntest_me(x, y)\n}\n\\description{\nan example function\n}\n\n" }, { "path": "tests/testthat/TestExclusion/tests/testthat/test-TestExclusion.R", "content": "test_that(\"test_me works\", {\n expect_equal(test_me(2, 2), 4)\n expect_equal(test_exclusion(1), 2)\n})\n" }, { "path": "tests/testthat/TestExclusion/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestExclusion\")\n\ntest_check(\"TestExclusion\")\n" }, { "path": "tests/testthat/TestFunctional/DESCRIPTION", "content": "Package: TestFunctional\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nSuggests:\n testthat\nRoxygenNote: 6.1.1\n" }, { "path": "tests/testthat/TestFunctional/NAMESPACE", "content": "# Generated by roxygen2: do not edit by hand\n\nexport(a)\nexport(b)\n" }, { "path": "tests/testthat/TestFunctional/R/a.R", "content": "foo <- function(x) {\n force(x)\n function() {\n if (x < 1)\n {\n return(TRUE)\n } else {\n return(FALSE)\n }\n }\n}\n\n#' @export\na <- foo(0)\n\n#' @export\nb <- foo(1)\n" }, { "path": "tests/testthat/TestFunctional/tests/testthat/test-a.R", "content": "test_that(\"regular function `a` works as expected\", {\n expect_equal(a(), TRUE)\n expect_equal(b(), FALSE)\n})\n" }, { "path": "tests/testthat/TestFunctional/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestFunctional\")\n\ntest_check(\"TestFunctional\")\n" }, { "path": "tests/testthat/TestNestedTestDirs/DESCRIPTION", "content": "Package: TestNestedTestDirs\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nSuggests:\n testthat\nRoxygenNote: 6.1.1\n" }, { "path": "tests/testthat/TestNestedTestDirs/NAMESPACE", "content": "# Generated by roxygen2: do not edit by hand\n\nexport(a)\nexport(b)\n" }, { "path": "tests/testthat/TestNestedTestDirs/R/a.R", "content": "foo <- function(x) {\n force(x)\n function() {\n if (x < 1)\n {\n return(TRUE)\n } else {\n return(FALSE)\n }\n }\n}\n\n#' @export\na <- foo(0)\n\n#' @export\nb <- foo(1)\n" }, { "path": "tests/testthat/TestNestedTestDirs/tests/testthat/nested_tests/test-a.R", "content": "test_that(\"regular function `a` works as expected\", {\n expect_equal(a(), TRUE)\n expect_equal(b(), FALSE)\n})\n" }, { "path": "tests/testthat/TestNestedTestDirs/tests/testthat/test-a.R", "content": "test_that(\"regular function `a` works as expected\", {\n expect_equal(a(), TRUE)\n expect_equal(b(), FALSE)\n})\n" }, { "path": "tests/testthat/TestNestedTestDirs/tests/testthat/test-nested-dir.R", "content": "# used for testing the extraction of srcrefs pertaining to tests, which assumes \n# srcrefs within working directory\n\nif (Sys.getenv(\"COVR_TEST_NESTED\") == \"TRUE\") {\n test_dir(\"./nested_tests\")\n\n # keep.source needed to extract test trace\n source(\"./nested_tests/test-a.R\", keep.source = TRUE) \n}\n\n" }, { "path": "tests/testthat/TestNestedTestDirs/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestNestedTestDirs\")\n\ntest_check(\"TestNestedTestDirs\")\n" }, { "path": "tests/testthat/TestParallel/DESCRIPTION", "content": "Package: TestParallel\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nSuggests: parallel\nLicense: What license is it under?\nLazyData: true\n" }, { "path": "tests/testthat/TestParallel/NAMESPACE", "content": "# Generated by roxygen2 (4.1.1): do not edit by hand\n\nexport(test1)\nexport(test2)\nexport(test3)" }, { "path": "tests/testthat/TestParallel/R/TestParallel.R", "content": "#' an example function\n#'\n#' @export\ntest1 <- function(x, y){\n x + y\n}\n\n#' @export\ntest2 <- function(x, y){\n x * y\n}\n\n#' @export\ntest3 <- function(x, y){\n x - y\n}" }, { "path": "tests/testthat/TestParallel/man/test_me.Rd", "content": "% Generated by roxygen2 (4.1.1): do not edit by hand\n% Please edit documentation in R/TestSummary.R\n\\name{test_me}\n\\alias{test_me}\n\\title{an example function}\n\\usage{\ntest_me(x, y)\n}\n\\description{\nan example function\n}\n\n" }, { "path": "tests/testthat/TestParallel/tests/testthat/test-TestParallel.R", "content": "test_that(\"test_me works\", {\n library(parallel)\n\n mccollect(mcparallel(\n expect_equal(test1(2, 2), 4)\n ))\n\n mccollect(mcparallel(\n expect_equal(test2(2, 2), 4)\n ))\n\n expect_equal(test3(2, 2), 0)\n})\n" }, { "path": "tests/testthat/TestParallel/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestParallel\")\n\ntest_check(\"TestParallel\")\n" }, { "path": "tests/testthat/TestPrint/DESCRIPTION", "content": "Package: TestPrint\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\n" }, { "path": "tests/testthat/TestPrint/NAMESPACE", "content": "# Generated by roxygen2 (4.1.1): do not edit by hand\n\nexport(test_me)\n" }, { "path": "tests/testthat/TestPrint/R/TestPrint.R", "content": "#' an example function\n#'\n#' @export\ntest_me <- function(x, y) {\n if (TRUE) { x + y } else { 0 } # nolint\n}\n" }, { "path": "tests/testthat/TestPrint/man/test_me.Rd", "content": "% Generated by roxygen2 (4.1.1): do not edit by hand\n% Please edit documentation in R/TestPrint.R\n\\name{test_me}\n\\alias{test_me}\n\\title{an example function}\n\\usage{\ntest_me(x, y)\n}\n\\description{\nan example function\n}\n\n" }, { "path": "tests/testthat/TestPrint/tests/testthat/test-TestSummary.R", "content": "test_that(\"test_me works\", {\n expect_equal(test_me(2, 2), 4)\n})\n" }, { "path": "tests/testthat/TestPrint/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestPrint\")\n\ntest_check(\"TestPrint\")\n" }, { "path": "tests/testthat/TestR6/DESCRIPTION", "content": "Package: TestR6\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nImports:\n R6\nSuggests:\n testthat\n" }, { "path": "tests/testthat/TestR6/NAMESPACE", "content": "# Generated by roxygen2 (4.1.1): do not edit by hand\n\nexport(TestR6)\nexport(a)\n" }, { "path": "tests/testthat/TestR6/R/TestR6.R", "content": "#' an example function\n#'\n#' @export\na <- function(x) {\n if (x <= 1) {\n 1\n } else {\n 2\n }\n}\n\n#' @export\nTestR6 <- R6::R6Class(\"TestR6\", # nolint\n public = list(\n show = function(x) {\n 1 + 3\n },\n print2 = function(x) {\n 1 + 2\n }\n )\n)\n\n.InternalTestR6 <- R6::R6Class(\"InternalTestR6\", # nolint\n public = list(\n some_method = function(x){\n 1 + 2\n }\n )\n)\n" }, { "path": "tests/testthat/TestR6/man/a.Rd", "content": "% Generated by roxygen2 (4.1.1): do not edit by hand\n% Please edit documentation in R/TestR6.R\n\\name{a}\n\\alias{a}\n\\title{an example function}\n\\usage{\na(x)\n}\n\\description{\nan example function\n}\n\n" }, { "path": "tests/testthat/TestR6/tests/testthat/test-TestR6.R", "content": "test_that(\"regular function `a` works as expected\", {\n expect_equal(a(1), 1)\n expect_equal(a(2), 2)\n expect_equal(a(3), 2)\n expect_equal(a(4), 2)\n expect_equal(a(0), 1)\n})\n\ntest_that(\"TestR6 class can be instantiated\", {\n t1 <- TestR6$new() # nolint\n})\n\ntest_that(\"TestR6 Methods can be evaluated\", {\n t1 <- TestR6$new() # nolint\n\n t1$show()\n print(t1$print2())\n})\n" }, { "path": "tests/testthat/TestR6/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestR6\")\n\ntest_check(\"TestR6\")\n" }, { "path": "tests/testthat/TestRC/DESCRIPTION", "content": "Package: TestRC\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nSuggests:\n testthat\n" }, { "path": "tests/testthat/TestRC/NAMESPACE", "content": "# Generated by roxygen2 (4.1.1): do not edit by hand\n\nexport(a)\nexportClasses(TestRC)\n" }, { "path": "tests/testthat/TestRC/R/TestRC.R", "content": "#' an example function\n#'\n#' @export\na <- function(x) {\n if (x <= 1) {\n 1\n } else {\n 2\n }\n}\n\n#' @export\nTestRC <- setRefClass(\"TestRC\", # nolint\n fields = list(name = \"character\", enabled = \"logical\"),\n methods = list(\n show = function(x) {\n 1 + 3\n },\n print2 = function(x) {\n 1 + 2\n }\n )\n)\n" }, { "path": "tests/testthat/TestRC/man/a.Rd", "content": "% Generated by roxygen2 (4.1.1): do not edit by hand\n% Please edit documentation in R/TestRC.R\n\\name{a}\n\\alias{a}\n\\title{an example function}\n\\usage{\na(x)\n}\n\\description{\nan example function\n}\n\n" }, { "path": "tests/testthat/TestRC/tests/testthat/test-TestRC.R", "content": "test_that(\"regular function `a` works as expected\", {\n expect_equal(a(1), 1)\n expect_equal(a(2), 2)\n expect_equal(a(3), 2)\n expect_equal(a(4), 2)\n expect_equal(a(0), 1)\n})\n\ntest_that(\"TestRC class can be instantiated\", {\n t1 <- TestRC() # nolint\n})\n\ntest_that(\"TestRC Methods can be evaluated\", {\n t1 <- TestRC() # nolint\n\n t1$show()\n print(t1$print2())\n})\n" }, { "path": "tests/testthat/TestRC/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestRC\")\n\ntest_check(\"TestRC\")\n" }, { "path": "tests/testthat/TestS4/DESCRIPTION", "content": "Package: TestS4\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nRoxygenNote: 5.0.1\n" }, { "path": "tests/testthat/TestS4/NAMESPACE", "content": "# Generated by roxygen2: do not edit by hand\n\nexport(a)\nexport(print2)\nexportClasses(TestS4)\n" }, { "path": "tests/testthat/TestS4/R/TestS4.R", "content": "#' an example function\n#'\n#' @export\n#' @examples\n#' a(1)\na <- function(x) {\n if (x <= 1) {\n 1\n } else {\n 2\n }\n}\n\n#' @export\nTestS4 <- setClass(\"TestS4\", # nolint\n slots = list(name = \"character\", enabled = \"logical\"))\n\n#' @export\nsetGeneric(\"print2\", function(x, y) {\n})\n\nsetMethod(\"print2\",\n c(x = \"TestS4\"),\n function(x) {\n 1 + 1\n })\n\nsetMethod(\"print2\",\n c(x = \"TestS4\", y = \"character\"),\n function(x, y) {\n 1 + 2\n })\n\nsetMethod(\"show\",\n c(object = \"TestS4\"),\n function(object) {\n 1 + 3\n })\n" }, { "path": "tests/testthat/TestS4/codecov.yml", "content": "codecov:\n token: codecov_token_from_yaml\n" }, { "path": "tests/testthat/TestS4/man/a.Rd", "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/TestS4.R\n\\name{a}\n\\alias{a}\n\\title{an example function}\n\\usage{\na(x)\n}\n\\description{\nan example function\n}\n\\examples{\na(1)\n}\n\n" }, { "path": "tests/testthat/TestS4/tests/testthat/test-TestS4.R", "content": "test_that(\"regular function `a` works as expected\", {\n expect_equal(a(1), 1)\n expect_equal(a(2), 2)\n expect_equal(a(3), 2)\n expect_equal(a(4), 2)\n expect_equal(a(0), 1)\n})\n\ntest_that(\"TestS4 class can be instantiated\", {\n t1 <- TestS4() # nolint\n})\n\ntest_that(\"TestS4 Methods can be evaluated\", {\n t1 <- TestS4() # nolint\n\n show(t1)\n print(print2(t1))\n\n print(print2(t1, \"hi\"))\n})\n" }, { "path": "tests/testthat/TestS4/tests/testthat.R", "content": "library(testthat)\n\nsuppressPackageStartupMessages(test_check(\"TestS4\"))\n" }, { "path": "tests/testthat/TestS7/DESCRIPTION", "content": "Package: TestS7\nTitle: What the Package Does (One Line, Title Case)\nVersion: 0.0.0.9000\nAuthors@R: c(\n person(\"Jim\", \"Hester\", , \"james.f.hester@gmail.com\", role = c(\"aut\", \"cre\"),\n comment = c(ORCID = \"0000-0002-2739-7082\")),\n person(\"RStudio\", role = c(\"cph\", \"fnd\"))\n )\nDescription: What the package does (one paragraph).\nLicense: MIT + file LICENSE\nEncoding: UTF-8\nRoxygen: list(markdown = TRUE)\nRoxygenNote: 7.3.2\nImports: S7\nSuggests: \n testthat (>= 3.0.0)\nConfig/testthat/edition: 3\n" }, { "path": "tests/testthat/TestS7/NAMESPACE", "content": "# Generated by roxygen2: do not edit by hand\n\nexport(Range)\nexport(inside)\nif (getRversion() < \"4.3.0\") importFrom(\"S7\", \"@\")\nimport(S7)\n" }, { "path": "tests/testthat/TestS7/R/foo.R", "content": "#' @import S7\n#' @export\nRange <- new_class(\"Range\",\n properties = list(\n start = class_double,\n end = class_double,\n length = new_property(\n class = class_double,\n getter = function(self) self@end - self@start,\n setter = function(self, value) {\n self@end <- self@start + value\n self\n }\n )\n ),\n constructor = function(x) {\n new_object(S7_object(), start = as.double(min(x, na.rm = TRUE)), end = as.double(max(x, na.rm = TRUE)))\n },\n validator = function(self) {\n if (length(self@start) != 1) {\n \"@start must be length 1\"\n } else if (length(self@end) != 1) {\n \"@end must be length 1\"\n } else if (self@end < self@start) {\n \"@end must be greater than or equal to @start\"\n }\n }\n)\n\n#' @export\ninside <- new_generic(\"inside\", \"x\")\n\nmethod(inside, Range) <- function(x, y) {\n y >= x@start & y <= x@end\n}\n\n# enable usage of @name in package code\n#' @rawNamespace if (getRversion() < \"4.3.0\") importFrom(\"S7\", \"@\")\nNULL\n\n# test external S3 generics\nmethod(format, Range) <- function(x) {\n sprintf(\"Range(%s, %s)\", x@start, x@end)\n}\n\ntestthat_print <- new_external_generic(\"testthat\", \"testthat_print\", \"x\")\nmethod(testthat_print, Range) <- function(x, ...) {\n cat(format(x))\n invisible(x)\n}\n\n.onLoad <- function(libname, pkgname) {\n S7::methods_register()\n}\n" }, { "path": "tests/testthat/TestS7/tests/testthat/test-foo.R", "content": "test_that(\"Range works\", {\n x <- Range(1:10)\n\n x@end <- 20\n\n expect_error(x@end <- \"x\", \"must be \")\n\n expect_error(x@end <- -1, \"greater than or equal\")\n\n expect_equal(inside(x, c(0, 5, 10, 15)), c(FALSE, TRUE, TRUE, TRUE))\n\n x@length <- 5\n\n expect_equal(x@length, 5)\n expect_equal(x@end, 6)\n})\n\ntest_that(\"Range methods work\", {\n x <- Range(1:10)\n expect_equal(base::format(x), \"Range(1, 10)\")\n\n # Test external generic method for testthat::testthat_print()\n expect_equal(testthat::capture_output(x, print = TRUE), \"Range(1, 10)\")\n})\n" }, { "path": "tests/testthat/TestS7/tests/testthat.R", "content": "# This file is part of the standard setup for testthat.\n# It is recommended that you do not modify it.\n#\n# Where should you do additional test configuration?\n# Learn more about the roles of various files in:\n# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview\n# * https://testthat.r-lib.org/articles/special-files.html\n\nlibrary(testthat)\nlibrary(TestS7)\n\ntest_check(\"TestS7\")\n" }, { "path": "tests/testthat/TestSummary/DESCRIPTION", "content": "Package: TestSummary\nTitle: What the Package Does (one line, title case)\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\n" }, { "path": "tests/testthat/TestSummary/NAMESPACE", "content": "# Generated by roxygen2 (4.1.1): do not edit by hand\n\nexport(dont_test_me)\nexport(test_me)\n" }, { "path": "tests/testthat/TestSummary/R/TestSummary.R", "content": "#' an example function\n#'\n#' @export\ntest_me <- function(x, y){\n if (TRUE)\n x + y\n else\n x - y\n}\n\n#' @export\ndont_test_me <- function(x, y){\n x * y\n}\n" }, { "path": "tests/testthat/TestSummary/man/test_me.Rd", "content": "% Generated by roxygen2 (4.1.1): do not edit by hand\n% Please edit documentation in R/TestSummary.R\n\\name{test_me}\n\\alias{test_me}\n\\title{an example function}\n\\usage{\ntest_me(x, y)\n}\n\\description{\nan example function\n}\n\n" }, { "path": "tests/testthat/TestSummary/tests/testthat/test-TestSummary.R", "content": "test_that(\"test_me works\", {\n expect_equal(test_me(2, 2), 4)\n})\n" }, { "path": "tests/testthat/TestSummary/tests/testthat.R", "content": "library(testthat)\nlibrary(\"TestSummary\")\n\ntest_check(\"TestSummary\")\n" }, { "path": "tests/testthat/TestUseTry/DESCRIPTION", "content": "Package: TestUseTry\nTitle: Test That `use_try` Parameter works\nVersion: 0.0.0.9000\nAuthors@R: \"First Last [aut, cre]\"\nDescription: What the package does (one paragraph)\nDepends:\n R (>= 3.1.2)\nLicense: What license is it under?\nLazyData: true\nSuggests:\n testthat\n" }, { "path": "tests/testthat/TestUseTry/NAMESPACE", "content": "# Generated by roxygen2 (4.1.1): do not edit by hand\n\nexport(fun)\n" }, { "path": "tests/testthat/TestUseTry/R/notry.R", "content": "#' @export\n\nfun <- function() {\n withCallingHandlers(\n signalCondition(simpleError(\"This Will Exit if `!isTRUE(use_try)`\")),\n error = function(e) TRUE\n )\n 1 + 1\n 2 + 2\n \"hello\"\n \"welcome\"\n TRUE\n}\n" }, { "path": "tests/testthat/TestUseTry/tests/tests.R", "content": "TestUseTry::fun()\n" }, { "path": "tests/testthat/TestUseTry/tests/testthat/test-notry.R", "content": "expect_true(TestUseTry::fun())\n" }, { "path": "tests/testthat/Testbox/app/app.R", "content": "options(box.path = file.path(getwd()))\n# remove box cache\nloaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\nbox::use(\n app/modules/module\n)\n" }, { "path": "tests/testthat/Testbox/app/modules/module.R", "content": "#' an example function\n#'\n#' @export\na <- function(x) {\n if (x <= 1) {\n 1\n } else {\n 2\n }\n}\n\nprivate_function <- function(x) {\n x ^ 2\n}\n" }, { "path": "tests/testthat/Testbox/tests/testthat/test-module.R", "content": "box::use(\n testthat[test_that, expect_equal]\n)\n\nbox::use(\n app/modules/module\n)\n\nimpl <- attr(module, \"namespace\")\n\ntest_that(\"regular function `a` works as expected\", {\n expect_equal(module$a(1), 1)\n expect_equal(module$a(2), 2)\n expect_equal(module$a(3), 2)\n expect_equal(module$a(4), 2)\n expect_equal(module$a(0), 1)\n})\n\ntest_that(\"private function works as expected\", {\n expect_equal(impl$private_function(2), 4)\n expect_equal(impl$private_function(3), 9)\n expect_equal(impl$private_function(4), 16)\n})\n" }, { "path": "tests/testthat/Testbox/tests/testthat.R", "content": "options(box.path = file.path(getwd()))\n# remove box cache\nloaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\nlibrary(testthat)\n\ntest_dir(\"tests/testthat\")\n" }, { "path": "tests/testthat/Testbox_R6/app/app.R", "content": "options(box.path = file.path(getwd()))\n# remove box cache\nloaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\nbox::use(\n app/modules/moduleR6\n)\n" }, { "path": "tests/testthat/Testbox_R6/app/modules/moduleR6.R", "content": "#' @export\nTestR6 <- R6::R6Class(\"TestR6\", # nolint\n public = list(\n show = function(x) {\n 1 + 3\n },\n print2 = function(x) {\n 1 + 2\n }\n )\n)\n" }, { "path": "tests/testthat/Testbox_R6/tests/testthat/test-moduleR6.R", "content": "box::use(\n testthat[test_that, expect_equal, expect_s3_class]\n)\n\nbox::use(\n app/modules/moduleR6\n)\n\ntest_that(\"TestR6 class can be instantiated\", {\n skip_if(is_r_devel())\n t1 <- moduleR6$TestR6$new() # nolint\n\n expect_s3_class(t1, \"R6\")\n expect_s3_class(t1, \"TestR6\")\n })\n\ntest_that(\"TestR6 Methods can be evaluated\", {\n skip_if(is_r_devel())\n t1 <- moduleR6$TestR6$new() # nolint\n\n expect_equal(t1$show(), 4)\n expect_equal(print(t1$print2()), 3)\n})\n" }, { "path": "tests/testthat/Testbox_R6/tests/testthat.R", "content": "options(box.path = file.path(getwd()))\n# remove box cache\nloaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\nlibrary(testthat)\n\ntest_dir(\"tests/testthat\")\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions/app/app.R", "content": "options(box.path = file.path(getwd()))\n# remove box cache\nloaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\nbox::use(\n app/modules/module\n)\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions/app/modules/module.R", "content": "#' an example function\n#'\n#' @export\na <- function(x) {\n if (x <= 1) {\n 1\n } else {\n 2\n }\n}\n\n#' @export\nb <- function(x) {\n return(x * 2)\n}\n\nprivate_function <- function(x) {\n x ^ 2\n}\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions/tests/testthat/test-aliased_functions.R", "content": "box::use(\n testthat[test_that, expect_equal]\n)\n\nbox::use(\n app/modules/module[x = a]\n)\n\ntest_that(\"attached regular function `a` works as expected\", {\n expect_equal(x(1), 1)\n expect_equal(x(2), 2)\n expect_equal(x(3), 2)\n expect_equal(x(4), 2)\n expect_equal(x(0), 1)\n})\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions/tests/testthat/test-aliased_modules.R", "content": "box::use(\n testthat[test_that, expect_equal]\n)\n\nbox::use(\n x = app/modules/module\n)\n\ntest_that(\"attached regular function `a` works as expected\", {\n expect_equal(x$a(1), 1)\n expect_equal(x$a(2), 2)\n expect_equal(x$a(3), 2)\n expect_equal(x$a(4), 2)\n expect_equal(x$a(0), 1)\n})\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions/tests/testthat/test-attached_functions.R", "content": "box::use(\n testthat[test_that, expect_equal]\n)\n\nbox::use(\n app/modules/module[a]\n)\n\ntest_that(\"attached regular function `a` works as expected\", {\n expect_equal(a(1), 1)\n expect_equal(a(2), 2)\n expect_equal(a(3), 2)\n expect_equal(a(4), 2)\n expect_equal(a(0), 1)\n})\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions/tests/testthat/test-three_dots.R", "content": "box::use(\n testthat[test_that, expect_equal]\n)\n\nbox::use(\n app/modules/module[...]\n)\n\ntest_that(\"attached regular function `a` works as expected\", {\n expect_equal(a(1), 1)\n expect_equal(a(2), 2)\n expect_equal(a(3), 2)\n expect_equal(a(4), 2)\n expect_equal(a(0), 1)\n})\n\ntest_that(\"attached regular function `b` works as expected\", {\n expect_equal(b(1), 2)\n expect_equal(b(2), 4)\n expect_equal(b(3), 6)\n})\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions/tests/testthat.R", "content": "options(box.path = file.path(getwd()))\n# remove box cache\nloaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\nlibrary(testthat)\n\ntest_dir(\"tests/testthat\")\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions_R6/app/app.R", "content": "options(box.path = file.path(getwd()))\n# remove box cache\nloaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\nbox::use(\n app/modules/moduleR6\n)\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions_R6/app/modules/moduleR6.R", "content": "#' @export\nTestR6 <- R6::R6Class(\"TestR6\", # nolint\n public = list(\n show = function(x) {\n 1 + 3\n },\n print2 = function(x) {\n 1 + 2\n }\n )\n)\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions_R6/tests/testthat/test-attached_R6.R", "content": "box::use(\n testthat[test_that, expect_equal, expect_s3_class]\n)\n\nbox::use(\n app/modules/moduleR6[TestR6]\n)\n\ntest_that(\"TestR6 class can be instantiated\", {\n skip_if(is_r_devel())\n t1 <- TestR6$new() # nolint\n\n expect_s3_class(t1, \"R6\")\n expect_s3_class(t1, \"TestR6\")\n})\n\ntest_that(\"TestR6 Methods can be evaluated\", {\n skip_if(is_r_devel())\n t1 <- TestR6$new() # nolint\n\n expect_equal(t1$show(), 4)\n expect_equal(t1$print2(), 3)\n})\n" }, { "path": "tests/testthat/Testbox_attached_modules_functions_R6/tests/testthat.R", "content": "options(box.path = file.path(getwd()))\n# remove box cache\nloaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\nlibrary(testthat)\n\ntest_dir(\"tests/testthat\")\n" }, { "path": "tests/testthat/_snaps/Compiled.md", "content": "# Error thrown for missing gcov\n\n Code\n package_coverage(\"TestCompiled\", relative_path = TRUE)\n Condition\n Error in `run_gcov()`:\n ! gcov not found\n\n# Warning thrown for empty gcov output\n\n Code\n . <- package_coverage(\"TestCompiled\", relative_path = TRUE)\n Condition\n Warning in `run_gcov()`:\n parsed gcov output was empty\n\n" }, { "path": "tests/testthat/_snaps/S7.md", "content": "# S7 coverage is reported\n\n Code\n cov[, c(\"functions\", \"first_line\", \"last_line\", \"value\")]\n Output\n functions first_line last_line value\n 1 Range@properties$length$getter 9 9 1\n 2 Range@properties$length$setter 11 11 1\n 3 Range@properties$length$setter 12 12 1\n 4 Range 17 17 2\n 5 Range@validator 20 20 5\n 6 Range@validator 21 21 0\n 7 Range@validator 22 22 5\n 8 Range@validator 23 23 0\n 9 Range@validator 24 24 5\n 10 Range@validator 25 25 1\n 11 method(inside, TestS7::Range) 34 34 1\n 12 method(base::format, TestS7::Range) 43 43 2\n 13 method(testthat::testthat_print, TestS7::Range) 48 48 1\n 14 method(testthat::testthat_print, TestS7::Range) 49 49 1\n 15 .onLoad 53 53 0\n\n" }, { "path": "tests/testthat/a", "content": "" }, { "path": "tests/testthat/b", "content": "" }, { "path": "tests/testthat/cobertura.xml", "content": "\n\n\n \n /dummy/directory\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n" }, { "path": "tests/testthat/corner-cases-test.R", "content": "fun1()\nfun2()\nfun3()\nfun4(1)\nfun4(1L)\n" }, { "path": "tests/testthat/corner-cases.R", "content": "make_fun_1 <- function() {\n function(x) {\n 2 + 2\n 1 + 1\n cat(\"fun1\\n\")\n }\n}\nmake_fun_2 <- function() {\n function(x) {\n 3 + 3\n 4 + 4\n cat(\"fun2\\n\")\n }\n}\n#' @export\n\nfun1 <- make_fun_1()\n\n#' @export\n\nfun2 <- function(x) {\n 2 + 2\n 1 + 1\n cat(\"fun2\\n\")\n}\n#' @export\n\nfun3 <- function() {\n\n if(FALSE)\n 1\n else\n 2\n\n1 +\n1; if(TRUE) 1 else 2\n\n if(FALSE) 3 else 4\n if(FALSE) {3} else {4}\n\n if(TRUE) 3 else {1 + 1\n 2 + 2\n }\n {1 + 1; 2 + 2}; if(FALSE) 1 else 2; {TRUE}\n {1 + 1; 2 + 2}; \"hello\"; {TRUE}\n if(TRUE) {\n {1 + 1; 2 + 2}; \"hello\"; {TRUE}\n {1 + 1; 2 + 2}; if(FALSE) 1 else 2; {TRUE}\n } else {\n {1 + 1; 2 + 2}; \"hello\"; {TRUE}\n {1 + 1; 2 + 2}; if(FALSE) 1 else 2; {TRUE}\n }\n}\n#' @export\n\nsetGeneric(\"fun4\", function(x) StandardGeneric(\"fun2\"))\n\nsetMethod(\"fun4\", \"integer\", make_fun_2())\nsetMethod(\"fun4\", \"numeric\", make_fun_1())\n" }, { "path": "tests/testthat/helper.R", "content": "is_r_devel <- function() {\n startsWith(R.version$status, \"Under development\")\n}\n\nis_win_r41 <- function() {\n x <- getRversion()\n is_windows() && x$major == 4 && x$minor == 1\n}\n" }, { "path": "tests/testthat/sonarqube.xml", "content": "\n\n \n \n \n \n \n \n\n" }, { "path": "tests/testthat/test-Compiled.R", "content": "test_that(\"Compiled code coverage is reported including code in headers\", {\n skip_on_cran()\n skip_if(is_win_r41())\n\n cov <- as.data.frame(package_coverage(\"TestCompiled\", relative_path = TRUE))\n\n simple_cc <- cov[cov$filename == \"src/simple.cc\", ]\n expect_equal(simple_cc[simple_cc$first_line == \"10\", \"value\"], 4)\n\n expect_equal(simple_cc[simple_cc$first_line == \"16\", \"value\"], 3)\n\n expect_equal(simple_cc[simple_cc$first_line == \"19\", \"value\"], 0)\n\n expect_equal(simple_cc[simple_cc$first_line == \"21\", \"value\"], 1)\n\n expect_equal(simple_cc[simple_cc$first_line == \"23\", \"value\"], 4)\n\n # This header contains a C++ template, which requires you to run gcov for\n # each object file separately and merge the results together.\n simple_h <- cov[cov$filename == \"src/simple-header.h\", ]\n expect_equal(simple_h[simple_h$first_line == \"12\", \"value\"], 4)\n\n expect_equal(simple_h[simple_h$first_line == \"18\", \"value\"], 3)\n\n expect_equal(simple_h[simple_h$first_line == \"21\", \"value\"], 0)\n\n expect_equal(simple_h[simple_h$first_line == \"23\", \"value\"], 1)\n\n expect_equal(simple_h[simple_h$first_line == \"25\", \"value\"], 4)\n\n expect_true(all(unique(cov$filename) %in% c(\"R/TestCompiled.R\", \"src/simple-header.h\", \"src/simple.cc\", \"src/simple4.cc\")))\n})\n\ntest_that(\"Can pass path to relative_path argument\", {\n skip_on_cran()\n skip_if(is_win_r41())\n cov <- as.data.frame(package_coverage(\"TestCompiled\", relative_path = \".\"))\n\n expect_true(all(unique(cov$filename) %in% c(\n \"TestCompiled/R/TestCompiled.R\",\n \"TestCompiled/src/simple-header.h\",\n \"TestCompiled/src/simple.cc\",\n \"TestCompiled/src/simple4.cc\"\n )))\n})\n\ntest_that(\"Source code subdirectories are found\", {\n skip_on_cran()\n skip_if(is_win_r41())\n cov <- as.data.frame(package_coverage(\"TestCompiledSubdir\", relative_path = TRUE))\n\n expect_equal(cov[cov$first_line == \"9\", \"value\"], 4)\n\n expect_equal(cov[cov$first_line == \"15\", \"value\"], 3)\n\n expect_equal(cov[cov$first_line == \"18\", \"value\"], 0)\n\n expect_equal(cov[cov$first_line == \"20\", \"value\"], 1)\n\n expect_equal(cov[cov$first_line == \"22\", \"value\"], 4)\n})\n\ntest_that(\"Compiled code coverage is reported under non-standard char's\", {\n skip_on_cran()\n skip_if(is_win_r41())\n cov <- as.data.frame(package_coverage(\"Test+Char/TestCompiled\", relative_path = TRUE))\n\n expect_equal(cov[cov$first_line == \"9\", \"value\"], 4)\n\n expect_equal(cov[cov$first_line == \"15\", \"value\"], 3)\n\n expect_equal(cov[cov$first_line == \"18\", \"value\"], 0)\n\n expect_equal(cov[cov$first_line == \"20\", \"value\"], 1)\n\n expect_equal(cov[cov$first_line == \"22\", \"value\"], 4)\n})\n\ntest_that(\"Error thrown for missing gcov\", {\n skip_on_cran()\n\n withr::local_options(covr.gcov='')\n expect_snapshot(package_coverage(\"TestCompiled\", relative_path=TRUE), error = TRUE)\n})\n\ntest_that(\"Warning thrown for empty gcov output\", {\n skip_on_cran()\n\n withr::local_options(covr.gcov_args='-n')\n expect_snapshot(\n . <- package_coverage(\"TestCompiled\", relative_path=TRUE),\n transform = function(x) gsub(getwd(), \"\", x)\n )\n})\n\ntest_that(\"tally_coverage includes compiled code\", {\n skip_on_cran()\n skip_if(is_win_r41())\n\n cov <- package_coverage(test_path(\"TestCompiled\"))\n tall <- tally_coverage(cov)\n\n expect_named(tall, c(\"filename\", \"functions\", \"line\", \"value\"))\n\n expect_equal(\n unique(tall$filename),\n c(\"R/TestCompiled.R\", \"src/simple-header.h\", \"src/simple.cc\", \"src/simple4.cc\"))\n})\n" }, { "path": "tests/testthat/test-R6.R", "content": "test_that(\"R6 methods coverage is reported\", {\n # There is some sort of bug that causes this test to fail during R CMD check\n # in R-devel, not sure why, and can't reproduce it interactively\n skip_if(is_r_devel())\n cov <- as.data.frame(package_coverage(test_path(\"TestR6\")))\n\n expect_equal(cov$value, c(5, 2, 3, 1, 1, 0))\n expect_equal(cov$first_line, c(5, 6, 8, 16, 19, 27))\n expect_equal(cov$last_line, c(5, 6, 8, 16, 19, 27))\n expect_true(\"some_method\" %in% cov$functions)\n})\n" }, { "path": "tests/testthat/test-RC.R", "content": "test_that(\"RC methods coverage is reported\", {\n cov <- as.data.frame(package_coverage(\"TestRC\"))\n\n expect_equal(cov$value, c(5, 2, 3, 1, 1))\n expect_equal(cov$first_line, c(5, 6, 8, 17, 20))\n expect_equal(cov$last_line, c(5, 6, 8, 17, 20))\n})\n" }, { "path": "tests/testthat/test-S4.R", "content": "test_that(\"S4 methods coverage is reported\", {\n cov <- as.data.frame(package_coverage(\"TestS4\"))\n\n expect_equal(cov$first_line, c(7, 8, 10, 25, 31, 37))\n\n expect_equal(cov$value, c(5, 2, 3, 1, 1, 1))\n})\n" }, { "path": "tests/testthat/test-S7.R", "content": "test_that(\"S7 coverage is reported\", {\n skip_if_not_installed(\"S7\")\n cov <- as.data.frame(package_coverage(test_path(\"TestS7\")))\n\n expect_equal(cov$value, c(1, 1, 1, 2, 5, 0, 5, 0, 5, 1, 1, 2, 1, 1, 0))\n expect_snapshot(cov[, c(\"functions\", \"first_line\", \"last_line\", \"value\")])\n})\n" }, { "path": "tests/testthat/test-azure.R", "content": "test_that(\"azure_pipelines calls package_coverage and to_cobertura\", {\n\n tf <- tempfile()\n on.exit(unlink(tf))\n\n azure(test_path(\"TestS4\"), filename = tf)\n\n expect_true(file.exists(tf))\n})\n" }, { "path": "tests/testthat/test-box-R6.R", "content": "loaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\ntest_that(\"R6 box module coverage is reported\", {\n # Similar to test-R6.R, there is some sort of bug that causes this test\n # to fail during R CMD check in R-devel, not sure why, and can't reproduce\n # it interactively\n skip_if(is_r_devel())\n withr::with_dir(\"Testbox_R6\", {\n cov <- as.data.frame(file_coverage(\n source_files = \"app/app.R\",\n test_files = list.files(\"tests/testthat\", full.names = TRUE)))\n\n expect_equal(cov$value, c(1, 1))\n expect_equal(cov$first_line, c(5, 8))\n expect_equal(cov$last_line, c(5, 8))\n expect_true(\"show\" %in% cov$functions)\n })\n})\n" }, { "path": "tests/testthat/test-box.R", "content": "loaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\ntest_that(\"box module coverage is reported\", {\n withr::with_dir(\"Testbox\", {\n cov <- as.data.frame(file_coverage(\n source_files = \"app/app.R\",\n test_files = list.files(\"tests/testthat\", full.names = TRUE)))\n\n expect_equal(cov$value, c(5, 2, 3, 3))\n expect_equal(cov$first_line, c(5, 6, 8, 13))\n expect_equal(cov$last_line, c(5, 6, 8, 13))\n expect_true(\"a\" %in% cov$functions)\n expect_true(\"private_function\" %in% cov$functions)\n })\n})\n" }, { "path": "tests/testthat/test-box_attached_modules_functions-R6.R", "content": "loaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\ntest_that(\"R6 box attached module coverage is reported\", {\n # Similar to test-R6.R, there is some sort of bug that causes this test\n # to fail during R CMD check in R-devel, not sure why, and can't reproduce\n # it interactively\n skip_if(is_r_devel())\n withr::with_dir(\"Testbox_attached_modules_functions_R6\", {\n cov <- as.data.frame(file_coverage(\n source_files = \"app/app.R\",\n test_files = list.files(\"tests/testthat\", full.names = TRUE)))\n\n expect_equal(cov$value, c(1, 1))\n expect_equal(cov$first_line, c(5, 8))\n expect_equal(cov$last_line, c(5, 8))\n expect_true(\"show\" %in% cov$functions)\n })\n\n})\n" }, { "path": "tests/testthat/test-box_attached_modules_functions.R", "content": "loaded_mods <- loadNamespace(\"box\")$loaded_mods\nrm(list = ls(loaded_mods), envir = loaded_mods)\n\ntest_that(\"box attached module coverage is reported\", {\n withr::with_dir(\"Testbox_attached_modules_functions\", {\n cov <- as.data.frame(file_coverage(\n source_files = \"app/app.R\",\n test_files = list.files(\"tests/testthat\", full.names = TRUE)))\n\n expect_equal(cov$value, c(20, 8, 12, 3, 0))\n expect_equal(cov$first_line, c(5, 6, 8, 14, 18))\n expect_equal(cov$last_line, c(5, 6, 8, 14, 18))\n expect_true(\"a\" %in% cov$functions)\n expect_true(\"private_function\" %in% cov$functions)\n })\n\n})\n" }, { "path": "tests/testthat/test-braceless.R", "content": "test_that(\"if\", {\n f <-\n'f <- function(x) {\n if (FALSE)\n FALSE # never covered, used as anchor\n if (x)\n TRUE\n else\n FALSE\n}'\n\ncov <- code_coverage(f, \"f(TRUE)\")\n expect_equal(zero_coverage(code_coverage(f, \"f(TRUE)\"))$line, c(3, 7))\n expect_equal(zero_coverage(code_coverage(f, \"f(FALSE)\"))$line, c(3, 5))\n expect_equal(zero_coverage(code_coverage(f, \"f(TRUE);f(FALSE)\"))$line, 3)\n})\ntest_that(\"nested if else\", {\n f <-\n'f <- function(x) {\n if (FALSE)\n FALSE # never covered, used as anchor\n else if (x)\n TRUE\n else\n FALSE\n}'\n\ncov <- code_coverage(f, \"f(TRUE)\")\n expect_equal(zero_coverage(code_coverage(f, \"f(TRUE)\"))$line, c(3, 7))\n expect_equal(zero_coverage(code_coverage(f, \"f(FALSE)\"))$line, c(3, 5))\n expect_equal(zero_coverage(code_coverage(f, \"f(TRUE);f(FALSE)\"))$line, 3)\n})\n\ntest_that(\"switch\", {\n f <-\n'f <- function(x) {\n switch(x,\n a = 1,\n b = 2,\n c = d <- 1\n )\n}'\n\n expect_equal(length(zero_coverage(code_coverage(f, \"f(\\\"a\\\"); f(\\\"b\\\")\"))$line),\n 1)\n expect_equal(length(zero_coverage(code_coverage(f, \"f(\\\"a\\\"); f(\\\"c\\\")\"))$line),\n 1)\n expect_equal(diff(zero_coverage(code_coverage(f, \"f(\\\"a\\\"); f(\\\"d\\\")\"))$line),\n 1)\n})\n\ntest_that(\"switch with default value\", {\n f <-\n'f <- function(x) {\n switch(x,\n a = 1,\n b = 2,\n c = d <- 1,\n NULL\n )\n}'\n\n expect_equal(length(zero_coverage(code_coverage(f, \"f(\\\"a\\\"); f(\\\"b\\\"); f(\\\"c\\\")\"))$line),\n 1)\n\n expect_equal(length(zero_coverage(code_coverage(f, \"f(\\\"a\\\"); f(\\\"c\\\")\"))$line),\n 2)\n})\n\ntest_that(\"switch with drop through\", {\n f <-\n'f <- function(x) {\n switch(x,\n a = ,\n b = 2,\n c = d <- 1,\n NULL\n )\n}'\n\n res <- as.data.frame(code_coverage(f, 'f(\"a\");f(\"b\");f(\"c\")'))\n expect_equal(res$first_line, c(2, 4, 5, 6))\n expect_equal(res$value, c(3, 2, 1, 0))\n\n})\n\ntest_that(\"switch with ellipses\", {\n f <-\n'f <- function(x, ...) {\n switch(typeof(x), ...)\n}'\n\n res <- as.data.frame(code_coverage(f, \"f(\\\"a\\\", character = TRUE)\"))\n expect_equal(res$first_line, 2)\n expect_equal(res$value, 1)\n\n f <-\n'f <- function(x, ...) {\n switch(typeof(x),\n ...,\n character = TRUE)\n}'\n\n res <- as.data.frame(code_coverage(f, \"f(\\\"a\\\")\"))\n expect_equal(res$first_line, c(2, 4))\n expect_equal(res$value, c(1, 1))\n})\n" }, { "path": "tests/testthat/test-cobertura.R", "content": "test_that(\"it works with coverage objects\", {\n tmp <- tempfile()\n cov <- package_coverage(test_path(\"TestSummary\"))\n\n attr(cov, \"package\")$path <- \"/dummy/directory\"\n to_cobertura(cov, filename = tmp)\n\n expect_equal(\n readLines(tmp)[c(-1, -2, -3)],\n readLines(test_path(\"cobertura.xml\"))[c(-1, -2, -3)]\n )\n})\n" }, { "path": "tests/testthat/test-codecov.R", "content": "ci_vars <- c(\n \"APPVEYOR\" = NA,\n \"APPVEYOR_ACCOUNT_NAME\" = NA,\n \"APPVEYOR_PROJECT_SLUG\" = NA,\n \"APPVEYOR_BUILD_VERSION\" = NA,\n \"APPVEYOR_JOB_ID\" = NA,\n \"APPVEYOR_REPO_BRANCH\" = NA,\n \"APPVEYOR_REPO_COMMIT\" = NA,\n \"APPVEYOR_REPO_NAME\" = NA,\n \"BRANCH_NAME\" = NA,\n \"BUILD_NUMBER\" = NA,\n \"BUILD_URL\" = NA,\n \"CI\" = NA,\n \"CIRCLECI\" = NA,\n \"CIRCLE_BRANCH\" = NA,\n \"CIRCLE_BUILD_NUM\" = NA,\n \"CIRCLE_PROJECT_REPONAME\" = NA,\n \"CIRCLE_PROJECT_USERNAME\" = NA,\n \"CIRCLE_SHA1\" = NA,\n \"CI_BRANCH\" = NA,\n \"CI_BUILD_NUMBER\" = NA,\n \"CI_BUILD_URL\" = NA,\n \"CI_COMMIT_ID\" = NA,\n \"CI_NAME\" = NA,\n \"CODECOV_TOKEN\" = NA,\n \"DRONE\" = NA,\n \"DRONE_BRANCH\" = NA,\n \"DRONE_BUILD_NUMBER\" = NA,\n \"DRONE_BUILD_URL\" = NA,\n \"DRONE_COMMIT\" = NA,\n \"GIT_BRANCH\" = NA,\n \"GIT_COMMIT\" = NA,\n \"GITHUB_ACTION\" = NA,\n \"GITHUB_REPOSTIORY\" = NA,\n \"JENKINS_URL\" = NA,\n \"REVISION\" = NA,\n \"SEMAPHORE\" = NA,\n \"SEMAPHORE_BUILD_NUMBER\" = NA,\n \"SEMAPHORE_REPO_SLUG\" = NA,\n \"TRAVIS\" = NA,\n \"TRAVIS_BRANCH\" = NA,\n \"TRAVIS_COMMIT\" = NA,\n \"TRAVIS_JOB_ID\" = NA,\n \"TRAVIS_JOB_NUMBER\" = NA,\n \"TRAVIS_PULL_REQUEST\" = NA,\n \"TRAVIS_REPO_SLUG\" = NA,\n \"WERCKER_GIT_BRANCH\" = NA,\n \"WERCKER_GIT_COMMIT\" = NA,\n \"WERCKER_GIT_OWNER\" = NA,\n \"WERCKER_GIT_REPOSITORY\" = NA,\n \"WERCKER_MAIN_PIPELINE_STARTED\" = NA\n)\n\ncov <- package_coverage(test_path(\"TestS4\"))\n\ntest_that(\"it generates a properly formatted json file\", {\n withr::local_envvar(ci_vars)\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity,\n local_branch = function(dir) \"master\",\n current_commit = function(dir) \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n )\n res <- codecov(coverage = cov)\n json <- jsonlite::fromJSON(res$body)\n\n expect_match(json$files$name, \"R/TestS4.R\")\n expect_equal(\n json$files$coverage[[1]],\n c(\n NA, NA, NA, NA, NA, NA, NA, 5, 2, NA, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,\n NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA\n )\n )\n expect_equal(json$uploader, \"R\")\n})\n\ntest_that(\"it adds a flags argument to the query if specified\", {\n withr::local_envvar(ci_vars)\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity,\n local_branch = function(dir) \"master\",\n current_commit = function(dir) \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n )\n res <- codecov(coverage = cov, flags = \"R\")\n expect_equal(res$query$flags, \"R\")\n})\n\ntest_that(\"it works with local repos\", {\n withr::local_envvar(ci_vars)\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity,\n local_branch = function(dir) \"master\",\n current_commit = function(dir) \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$url, \"2\") # nolint\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\ntest_that(\"it works with local repos and explicit branch and commit\", {\n withr::local_envvar(ci_vars)\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov, branch = \"master\", commit = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n\n expect_match(res$url, \"/upload/v2\") # nolint\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\ntest_that(\"it adds the token to the query if available\", {\n withr::local_envvar(c(ci_vars, \"CODECOV_TOKEN\" = \"codecov_test\"))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity,\n local_branch = function(dir) \"master\",\n current_commit = function(dir) \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$url, \"/upload/v2\") # nolint\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n expect_match(res$query$token, \"codecov_test\")\n})\ntest_that(\"it looks for token in a .yml file\", {\n withr::local_envvar(ci_vars)\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity,\n local_branch = function(dir) \"master\",\n current_commit = function(dir) \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$url, \"/upload/v2\") # nolint\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n expect_match(res$query$token, \"codecov_token_from_yaml\")\n})\n\ntest_that(\"it works with jenkins\", {\n withr::local_envvar(c(\n ci_vars,\n \"JENKINS_URL\" = \"jenkins.com\",\n \"GIT_BRANCH\" = \"test\",\n \"GIT_COMMIT\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\",\n \"BUILD_NUMBER\" = \"1\",\n \"BUILD_URL\" = \"http://test.com/tester/test\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"jenkins\")\n expect_match(res$query$branch, \"test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n expect_match(res$query$build, \"1\")\n expect_match(res$query$build_url, \"http://test.com/tester/test\")\n})\n\ntest_that(\"it works with travis normal builds\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"true\",\n \"TRAVIS\" = \"true\",\n \"TRAVIS_PULL_REQUEST\" = \"false\",\n \"TRAVIS_REPO_SLUG\" = \"tester/test\",\n \"TRAVIS_BRANCH\" = \"master\",\n \"TRAVIS_JOB_NUMBER\" = \"100\",\n \"TRAVIS_JOB_ID\" = \"10\",\n \"TRAVIS_COMMIT\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"travis\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$job, \"10\")\n expect_match(res$query$pr, \"\")\n expect_match(res$query$slug, \"tester/test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n expect_match(res$query$build, \"100\")\n})\n\ntest_that(\"it works with travis pull requests\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"true\",\n \"TRAVIS\" = \"true\",\n \"TRAVIS_PULL_REQUEST\" = \"5\",\n \"TRAVIS_REPO_SLUG\" = \"tester/test\",\n \"TRAVIS_BRANCH\" = \"master\",\n \"TRAVIS_JOB_NUMBER\" = \"100\",\n \"TRAVIS_JOB_ID\" = \"10\",\n \"TRAVIS_COMMIT\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"travis\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$job, \"10\")\n expect_match(res$query$pr, \"5\")\n expect_match(res$query$slug, \"tester/test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n expect_match(res$query$build, \"100\")\n})\n\ntest_that(\"it works with codeship\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"true\",\n \"CI_NAME\" = \"codeship\",\n \"CI_BRANCH\" = \"master\",\n \"CI_BUILD_NUMBER\" = \"5\",\n \"CI_BUILD_URL\" = \"http://test.com/tester/test\",\n \"CI_COMMIT_ID\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"codeship\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$build, \"5\")\n expect_match(res$query$build_url, \"http://test.com/tester/test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\ntest_that(\"it works with circleci\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"true\",\n \"CIRCLECI\" = \"true\",\n \"CIRCLE_BRANCH\" = \"master\",\n \"CIRCLE_BUILD_NUM\" = \"5\",\n \"CIRCLE_PROJECT_USERNAME\" = \"tester\",\n \"CIRCLE_PROJECT_REPONAME\" = \"test\",\n \"CIRCLE_SHA1\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"circleci\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$build, \"5\")\n expect_match(res$query$owner, \"tester\")\n expect_match(res$query$repo, \"test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\ntest_that(\"it works with semaphore\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"true\",\n \"SEMAPHORE\" = \"true\",\n \"BRANCH_NAME\" = \"master\",\n \"SEMAPHORE_BUILD_NUMBER\" = \"5\",\n \"SEMAPHORE_REPO_SLUG\" = \"tester/test\",\n \"REVISION\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"semaphore\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$build, \"5\")\n expect_match(res$query$owner, \"tester\")\n expect_match(res$query$repo, \"test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\ntest_that(\"it works with drone\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"true\",\n \"DRONE\" = \"true\",\n \"DRONE_BRANCH\" = \"master\",\n \"DRONE_BUILD_NUMBER\" = \"5\",\n \"DRONE_BUILD_URL\" = \"http://test.com/tester/test\",\n \"DRONE_COMMIT\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"drone.io\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$build, \"5\")\n expect_match(res$query$build_url, \"http://test.com/tester/test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\ntest_that(\"it works with AppVeyor\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"True\",\n \"APPVEYOR\" = \"True\",\n \"APPVEYOR_REPO_NAME\" = \"testspace/test\",\n \"APPVEYOR_REPO_BRANCH\" = \"master\",\n \"APPVEYOR_ACCOUNT_NAME\" = \"testuser\", # not necessarily the same as testspace above\n \"APPVEYOR_PROJECT_SLUG\" = \"test\",\n \"APPVEYOR_BUILD_VERSION\" = \"1.0.5\",\n \"APPVEYOR_JOB_ID\" = \"225apqggpmlkn5pr\",\n \"APPVEYOR_REPO_COMMIT\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"appveyor\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$job, \"testuser/test/1.0.5\")\n expect_match(res$query$build, \"225apqggpmlkn5pr\")\n expect_match(res$query$slug, \"testspace/test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\ntest_that(\"it works with Wercker\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"true\",\n \"WERCKER_GIT_BRANCH\" = \"master\",\n \"WERCKER_MAIN_PIPELINE_STARTED\" = \"5\",\n \"WERCKER_GIT_OWNER\" = \"tester\",\n \"WERCKER_GIT_REPOSITORY\" = \"test\",\n \"WERCKER_GIT_COMMIT\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"wercker\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$build, \"5\")\n expect_match(res$query$owner, \"tester\")\n expect_match(res$query$repo, \"test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\n\ntest_that(\"it works with GitLab\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI\" = \"true\",\n \"CI_SERVER_NAME\" = \"GitLab CI\",\n \"CI_BUILD_ID\" = \"5\",\n \"CI_BUILD_REPO\" = \"https://gitlab.com/tester/test.git\",\n \"CI_BUILD_REF_NAME\" = \"master\",\n \"CI_BUILD_REF\" = \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity\n )\n res <- codecov(coverage = cov)\n\n expect_match(res$query$service, \"gitlab\")\n expect_match(res$query$branch, \"master\")\n expect_match(res$query$build, \"5\")\n expect_match(res$query$slug, \"tester/test\")\n expect_match(res$query$commit, \"a94a8fe5ccb19ba61c4c0873d391e987982fbbd3\")\n})\n" }, { "path": "tests/testthat/test-corner-cases.R", "content": "test_that(\"corner-cases are handled as expected\", {\n expect_warning(withr::with_output_sink(tempfile(), {\n cov <- file_coverage(\"corner-cases.R\", \"corner-cases-test.R\")\n }))\n\n expect_equal(as.data.frame(cov), readRDS(\"corner-cases.Rds\"))\n})\n" }, { "path": "tests/testthat/test-coveralls.R", "content": "ci_vars <- c(\n \"APPVEYOR\" = NA,\n \"APPVEYOR_BUILD_NUMBER\" = NA,\n \"APPVEYOR_REPO_BRANCH\" = NA,\n \"APPVEYOR_REPO_COMMIT\" = NA,\n \"APPVEYOR_REPO_NAME\" = NA,\n \"BRANCH_NAME\" = NA,\n \"BUILD_NUMBER\" = NA,\n \"BUILD_URL\" = NA,\n \"CI\" = NA,\n \"CIRCLECI\" = NA,\n \"CIRCLE_BRANCH\" = NA,\n \"CIRCLE_BUILD_NUM\" = NA,\n \"CIRCLE_PROJECT_REPONAME\" = NA,\n \"CIRCLE_PROJECT_USERNAME\" = NA,\n \"CIRCLE_SHA1\" = NA,\n \"CI_BRANCH\" = NA,\n \"CI_BUILD_NUMBER\" = NA,\n \"CI_BUILD_URL\" = NA,\n \"CI_COMMIT_ID\" = NA,\n \"CI_NAME\" = NA,\n \"CODECOV_TOKEN\" = NA,\n \"DRONE\" = NA,\n \"DRONE_BRANCH\" = NA,\n \"DRONE_BUILD_NUMBER\" = NA,\n \"DRONE_BUILD_URL\" = NA,\n \"DRONE_COMMIT\" = NA,\n \"GIT_BRANCH\" = NA,\n \"GIT_COMMIT\" = NA,\n \"JENKINS_URL\" = NA,\n \"REVISION\" = NA,\n \"SEMAPHORE\" = NA,\n \"SEMAPHORE_BUILD_NUMBER\" = NA,\n \"SEMAPHORE_REPO_SLUG\" = NA,\n \"TRAVIS\" = NA,\n \"TRAVIS_BRANCH\" = NA,\n \"TRAVIS_COMMIT\" = NA,\n \"TRAVIS_JOB_ID\" = NA,\n \"TRAVIS_JOB_NUMBER\" = NA,\n \"TRAVIS_PULL_REQUEST\" = NA,\n \"TRAVIS_REPO_SLUG\" = NA,\n \"WERCKER_GIT_BRANCH\" = NA,\n \"WERCKER_GIT_COMMIT\" = NA,\n \"WERCKER_GIT_OWNER\" = NA,\n \"WERCKER_GIT_REPOSITORY\" = NA,\n \"WERCKER_MAIN_PIPELINE_STARTED\" = NA\n)\n\nread_file <- function(file) paste(collapse = \"\\n\", readLines(file))\n\ncov <- package_coverage(test_path(\"TestS4\"))\n\ntest_that(\"coveralls generates a properly formatted json file\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI_NAME\" = \"FAKECI\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity,\n upload_file = function(file) readChar(file, file.info(file)$size)\n )\n res <- coveralls(coverage = cov)\n json <- jsonlite::fromJSON(res$body$json_file)\n\n expect_equal(nrow(json$source_files), 1)\n expect_equal(json$service_name, \"fakeci\")\n expect_match(json$source_files$name, rex::rex(\"R\", one_of(\"/\", \"\\\\\"), \"TestS4.R\"))\n expect_equal(json$source_files$source, read_file(\"TestS4/R/TestS4.R\"))\n expect_equal(json$source_files$source_digest, \"1233f2eca5d84704101cb9d9b928f2e9\")\n expect_equal(\n json$source_files$coverage[[1]],\n c(\n NA, NA, NA, NA, NA, NA, 5, 2, NA, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,\n NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA\n )\n )\n})\n\ntest_that(\"coveralls can spawn a job using repo_token\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI_NAME\" = \"DRONE\"\n ))\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity,\n upload_file = function(file) readChar(file, file.info(file)$size),\n system_output = function(...) paste0(c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\"), collapse = \"\\n\")\n )\n res <- coveralls(coverage = cov, repo_token = \"mytoken\")\n json <- jsonlite::fromJSON(res$body$json_file)\n\n expect_equal(is.null(json$git), FALSE)\n expect_equal(nrow(json$source_files), 1)\n # service_name set #285\n expect_equal(json$service_name, \"drone\")\n expect_equal(json$repo_token, \"mytoken\")\n expect_match(json$source_files$name, rex::rex(\"R\", one_of(\"/\", \"\\\\\"), \"TestS4.R\"))\n expect_equal(json$source_files$source, read_file(\"TestS4/R/TestS4.R\"))\n expect_equal(json$source_files$source_digest, \"1233f2eca5d84704101cb9d9b928f2e9\")\n expect_equal(\n json$source_files$coverage[[1]],\n c(\n NA, NA, NA, NA, NA, NA, 5, 2, NA, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,\n NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA\n )\n )\n})\n\ntest_that(\"generates correct payload for Drone and Jenkins\", {\n withr::local_envvar(c(\n ci_vars,\n \"CI_NAME\" = \"FAKECI\", \"CI_BRANCH\" = \"fakebranch\", \"CI_REMOTE\" = \"covr\"\n ))\n local_mocked_bindings(\n system_output = function(...) paste0(c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\"), collapse = \"\\n\")\n )\n git <- jenkins_git_info()\n\n expect_equal(git$head$id, jsonlite::unbox(\"a\"))\n expect_equal(git$head$author_name, jsonlite::unbox(\"b\"))\n expect_equal(git$head$author_email, jsonlite::unbox(\"c\"))\n expect_equal(git$head$commiter_name, jsonlite::unbox(\"d\"))\n expect_equal(git$head$commiter_email, jsonlite::unbox(\"e\"))\n expect_equal(git$head$message, jsonlite::unbox(\"f\"))\n expect_equal(git$branch, jsonlite::unbox(\"fakebranch\"))\n expect_equal(git$remotes[[1]]$name, jsonlite::unbox(\"origin\"))\n expect_equal(git$remotes[[1]]$url, jsonlite::unbox(\"covr\"))\n})\n\ntest_that(\"coveralls can spawn a job using repo_token - travis-pro #285\", {\n withr::local_envvar(\n c(ci_vars, \"CI_NAME\" = \"travis-pro\")\n )\n local_mocked_bindings(\n RETRY = function(...) list(...),\n content = identity,\n upload_file = function(file) readChar(file, file.info(file)$size),\n system_output = function(...) paste0(c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\"), collapse = \"\\n\")\n )\n res <- coveralls(coverage = cov, repo_token = \"mytoken\")\n json <- jsonlite::fromJSON(res$body$json_file)\n\n expect_equal(is.null(json$git), FALSE)\n expect_equal(nrow(json$source_files), 1)\n expect_equal(json$service_name, \"travis-pro\")\n expect_equal(json$repo_token, \"mytoken\")\n expect_match(json$source_files$name, rex::rex(\"R\", one_of(\"/\", \"\\\\\"), \"TestS4.R\"))\n expect_equal(json$source_files$source, read_file(\"TestS4/R/TestS4.R\"))\n expect_equal(json$source_files$source_digest, \"1233f2eca5d84704101cb9d9b928f2e9\")\n expect_equal(\n json$source_files$coverage[[1]],\n c(\n NA, NA, NA, NA, NA, NA, 5, 2, NA, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,\n NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA\n )\n )\n # git correct #285\n expect_equal(json$git$head$id, \"a\")\n expect_equal(json$git$head$author_name, \"b\")\n expect_equal(json$git$head$author_email, \"c\")\n expect_equal(json$git$head$commiter_name, \"d\")\n expect_equal(json$git$head$commiter_email, \"e\")\n expect_equal(json$git$head$message, \"f\")\n})\n" }, { "path": "tests/testthat/test-covr.R", "content": "test_that(\"function_coverage\", {\n\n withr::with_options(c(keep.source = TRUE), {\n f <- function(x) {\n x + 1\n }\n expect_equal(as.numeric(function_coverage(\"f\", env = environment(f))[[1]]$value), 0)\n\n expect_equal(as.numeric(function_coverage(\"f\", env = environment(f), f(1))[[1]]$value), 1)\n\n expect_equal(as.numeric(function_coverage(\"f\", env = environment(f), f(1), f(1))[[1]]$value), 2)\n })\n})\n\ntest_that(\"function_coverage identity function\", {\n\n withr::with_options(c(keep.source = TRUE), {\n fun <- function(x) {\n x\n }\n\n cov_num <- function(...) {\n as.numeric(function_coverage(\"fun\", env = environment(fun), ...)[[1]]$value)\n }\n\n expect_equal(cov_num(), 0)\n expect_equal(cov_num(fun(1)), 1)\n })\n})\n\ntest_that(\"function_coverage return last expr\", {\n\n withr::with_options(c(keep.source = TRUE), {\n fun <- function(x = 1) {\n x\n x <- 1\n }\n\n cov_fun <- function(...) {\n vdapply(function_coverage(\"fun\", env = environment(fun), ...), \"[[\", \"value\")\n }\n\n expect_equal(as.numeric(cov_fun()), c(0L, 0L))\n expect_equal(as.numeric(cov_fun(fun())), c(1L, 1L))\n })\n})\n\ntest_that(\"duplicated first_line\", {\n withr::with_options(c(keep.source = TRUE), {\n\n fun <- function() {\n res <- lapply(1:2, function(x) { x + 1 }) # nolint\n }\n cov <- function_coverage(\"fun\", env = environment(fun))\n first_lines <- as.data.frame(cov)$first_line\n expect_equal(length(first_lines), 2)\n expect_equal(first_lines[1], first_lines[2])\n })\n})\n\ntest_that(\"trace calls handles all possibilities\", {\n expr <- expression(y <- x * 10)\n\n expect_equal(trace_calls(expr), expr)\n\n expect_equal(trace_calls(list(expr)), list(expr))\n})\n\ntest_that(\"show_failures shows as much text as it can from the end\", {\n withr::with_options(c(warning.length = 300), {\n td <- tempfile()\n dir.create(td)\n\n out <- file.path(td, \"test.Rout.fail\")\n on.exit(unlink(td, recursive = TRUE))\n writeLines(\n \"Lorem ipsum dolor sit amet, at erat praesent est mi ultrices. Eget in platea ac auctor et eu et venenatis. Tellus volutpat pellentesque. Dis nulla sem dignissim venenatis. Consequat montes maecenas congue donec ac himenaeos sed sed tempus. Ipsum risus lacus? Malesuada lectus, lacus egestas et lacus, in in ut sed. Tempus ligula dignissim a elementum semper maecenas eu. Enim pellentesque turpis at et ligula in est ut. Accumsan quis fermentum convallis proin ligula primis ut, curabitur. Sociosqu, fringilla, eu lacus eleifend conubia pellentesque viverra.\",\n out\n )\n\n # Expect the error to contain the end of the file\n expect_error(show_failures(td), \"eleifend conubia pellentesque viverra.\", fixed = TRUE, class = \"covr_error\")\n })\n})\n" }, { "path": "tests/testthat/test-exclusions.R", "content": "exclude_ops <- list(exclude_pattern = \"#TeSt_NoLiNt\",\n exclude_start = \"#TeSt_NoLiNt_StArT\",\n exclude_end = \"#TeSt_NoLiNt_EnD\")\n\ntest_that(\"it returns an empty vector if there are no exclusions\", {\n t1 <- c(\"this\",\n \"is\",\n \"a\",\n \"test\")\n expect_equal(do.call(parse_exclusions, c(list(t1), exclude_ops, recursive = F)), numeric(0))\n})\n\ntest_that(\"it returns the line if one line is excluded\", {\n\n t1 <- c(\"this\",\n \"is #TeSt_NoLiNt\",\n \"a\",\n \"test\")\n expect_equal(do.call(parse_exclusions, c(list(t1), exclude_ops)), c(2))\n\n t2 <- c(\"this\",\n \"is #TeSt_NoLiNt\",\n \"a\",\n \"test #TeSt_NoLiNt\")\n expect_equal(do.call(parse_exclusions, c(list(t2), exclude_ops)), c(2, 4))\n})\n\ntest_that(\"it returns all lines between start and end\", {\n\n t1 <- c(\"this #TeSt_NoLiNt_StArT\",\n \"is\",\n \"a #TeSt_NoLiNt_EnD\",\n \"test\")\n expect_equal(do.call(parse_exclusions, c(list(t1), exclude_ops)), c(1, 2, 3))\n\n t2 <- c(\"this #TeSt_NoLiNt_StArT\",\n \"is\",\n \"a #TeSt_NoLiNt_EnD\",\n \"test\",\n \"of\",\n \"the #TeSt_NoLiNt_StArT\",\n \"emergency #TeSt_NoLiNt_EnD\",\n \"broadcast\",\n \"system\")\n expect_equal(do.call(parse_exclusions, c(list(t2), exclude_ops)), c(1, 2, 3, 6, 7))\n})\n\ntest_that(\"it ignores exclude coverage lines within start and end\", {\n\n t1 <- c(\"this #TeSt_NoLiNt_StArT\",\n \"is #TeSt_NoLiNt\",\n \"a #TeSt_NoLiNt_EnD\",\n \"test\")\n expect_equal(do.call(parse_exclusions, c(list(t1), exclude_ops)), c(1, 2, 3))\n})\n\ntest_that(\"it throws an error if start and end are unpaired\", {\n\n t1 <- c(\"this #TeSt_NoLiNt_StArT\",\n \"is #TeSt_NoLiNt\",\n \"a\",\n \"test\")\n expect_error(do.call(parse_exclusions, c(list(t1), exclude_ops)), \"but only\")\n})\n\nexpect_equal_vals <- function(x, y) {\n testthat::expect_equal(unname(x), unname(y))\n}\ntest_that(\"it merges two NULL or empty objects as an empty list\", {\n expect_equal(normalize_exclusions(c(NULL, NULL)), list())\n expect_equal(normalize_exclusions(c(NULL, list())), list())\n expect_equal(normalize_exclusions(c(list(), NULL)), list())\n expect_equal(normalize_exclusions(c(list(), list())), list())\n})\n\ntest_that(\"it returns the object if the other is NULL\", {\n t1 <- list(a = 1:10)\n\n expect_equal_vals(normalize_exclusions(c(t1, NULL)), t1)\n expect_equal_vals(normalize_exclusions(c(NULL, t1)), t1)\n})\n\ntest_that(\"it returns the union of two non-overlapping lists\", {\n t1 <- list(a = 1:10)\n t2 <- list(a = 20:30)\n\n expect_equal_vals(normalize_exclusions(c(t1, t2)), list(a = c(1:10, 20:30)))\n})\n\ntest_that(\"it returns the union of two overlapping lists\", {\n t1 <- list(a = 1:10)\n t2 <- list(a = 5:15)\n\n expect_equal_vals(normalize_exclusions(c(t1, t2)), list(a = 1:15))\n})\n\ntest_that(\"it adds names if needed\", {\n t1 <- list(a = 1:10)\n t2 <- list(b = 5:15)\n\n expect_equal_vals(normalize_exclusions(c(t1, t2)), list(a = 1:10, b = 5:15))\n})\n\ntest_that(\"it handles full file exclusions\", {\n\n expect_equal_vals(normalize_exclusions(list(\"a\")), list(a = Inf))\n\n expect_equal_vals(normalize_exclusions(list(\"a\", b = 1)), list(a = Inf, b = 1))\n})\n\ntest_that(\"it handles redundant lines\", {\n\n expect_equal_vals(normalize_exclusions(list(a = c(1, 1, 1:10))), list(a = 1:10))\n\n expect_equal_vals(normalize_exclusions(list(a = c(1, 1, 1:10), b = 1:10)), list(a = 1:10, b = 1:10))\n})\n\ntest_that(\"it handles redundant files\", {\n\n expect_equal_vals(normalize_exclusions(list(a = c(1:10), a = c(10:20))), list(a = 1:20))\n})\n\ncov <- package_coverage(\"TestSummary\")\n\ntest_that(\"it excludes lines\", {\n expect_equal(length(cov), 4)\n expect_equal(length(exclude(cov, list(\"R/TestSummary.R\" = 5), path = \"TestSummary\")), 3)\n expect_equal(length(exclude(cov, list(\"R/TestSummary.R\" = 13), path = \"TestSummary\")), 3)\n})\ntest_that(\"it preserves the class\", {\n expect_equal(class(exclude(cov, NULL, path = \"TestSummary\")), class(cov))\n expect_equal(class(exclude(cov, list(\"R/TestSummary.R\" = 3), path = \"TestSummary\")), class(cov))\n})\ntest_that(\"function exclusions work\", {\n expect_equal(length(exclude(cov, NULL, \"^test\")), 1)\n expect_equal(length(exclude(cov, NULL, c(\"^test\", \"dont\"))), 0)\n})\n\ntest_that(\"it excludes properly\", {\n t1 <- package_coverage(\"TestExclusion\")\n\n expect_equal(length(t1), 3)\n\n t1 <- package_coverage(\"TestExclusion\", line_exclusions = \"R/TestExclusion.R\")\n\n expect_equal(length(t1), 0)\n})\n\ntest_that(\"it returns NULL if empty or no file exclusions\", {\n expect_equal(file_exclusions(NULL, \"\"), NULL)\n\n expect_equal(file_exclusions(list(\"a\" = c(1, 2))), NULL)\n\n expect_equal(file_exclusions(list(\"a\" = c(1, 2), \"b\" = c(3, 4))), NULL)\n})\ntest_that(\"it returns a normalizedPath if the file can be found\", {\n expect_match(file_exclusions(list(\"test-exclusions.R\"), \".\"), \"test-exclusions.R\")\n\n expect_match(\n file_exclusions(list(\"testthat/test-exclusions.R\", \"testthat.R\"), \"..\"),\n rex::rex(or(\"test-exclusions.R\", \"testthat.R\")))\n})\n\ndescribe(\"covrignore\", {\n it(\"returns NULL if empty or no file exclusions\", {\n withr::with_options(list(covr.covrignore = \"\"),\n expect_equal(parse_covr_ignore(), NULL)\n )\n withr::with_envvar(list(\"COVR_COVRIGNORE\" = \"\"),\n expect_equal(parse_covr_ignore(), NULL)\n )\n tf <- tempfile()\n on.exit(unlink(tf))\n writeLines(\"\", tf)\n withr::with_options(list(covr.covrignore = tf),\n expect_equal(parse_covr_ignore(), NULL)\n )\n withr::with_envvar(list(\"COVR_COVRIGNORE\" = tf),\n expect_equal(parse_covr_ignore(), NULL)\n )\n })\n it(\"returns the file if file exists\", {\n td <- tempfile()\n on.exit(unlink(td, recursive = TRUE))\n dir.create(td)\n writeLines(\"foo.c\", file.path(td, \".covrignore\"))\n writeLines(\"\", file.path(td, \"foo.c\"))\n withr::with_dir(td, {\n expect_equal(parse_covr_ignore(), \"foo.c\")\n })\n })\n it(\"handles globs correctly\", {\n td <- tempfile()\n on.exit(unlink(td, recursive = TRUE))\n dir.create(td)\n writeLines(\"foo.*\", file.path(td, \".covrignore\"))\n writeLines(\"\", file.path(td, \"foo.c\"))\n writeLines(\"\", file.path(td, \"foo.o\"))\n withr::with_dir(td, {\n expect_equal(parse_covr_ignore(), c(\"foo.c\", \"foo.o\"))\n })\n })\n it(\"handles directories correctly\", {\n td <- tempfile()\n on.exit(unlink(td, recursive = TRUE))\n dir.create(td)\n dir.create(file.path(td, \"src\"))\n writeLines(\"src\", file.path(td, \".covrignore\"))\n writeLines(\"\", file.path(td, \"src\", \"foo.c\"))\n writeLines(\"\", file.path(td, \"src\", \"foo.o\"))\n withr::with_dir(td, {\n expect_equal(gsub(\"//\", \"/\", parse_covr_ignore()), c(\"src/foo.c\", \"src/foo.o\"))\n })\n })\n})\n" }, { "path": "tests/testthat/test-file_coverage.R", "content": "s1 <- tempfile()\nt1 <- tempfile()\nwriteLines(con = s1,\n\"a <- function(x) {\n x + 1\n}\n\nb <- function(x) {\n if (x > 1) TRUE\n else FALSE\n}\")\n\nwriteLines(con = t1,\n\"a(1)\na(2)\na(3)\nb(0)\nb(1)\nb(2)\")\n\non.exit(unlink(c(s1, t1)))\n\ntest_that(\"it works on single files\", {\n cov <- file_coverage(s1, t1)\n cov_d <- as.data.frame(cov)\n\n expect_equal(cov_d$functions, c(\"a\", \"b\", \"b\", \"b\"))\n expect_equal(cov_d$value, c(3, 3, 1, 2))\n})\n" }, { "path": "tests/testthat/test-functions.R", "content": "test_that(\"function_coverage generates output\", {\n env <- new.env()\n withr::with_options(c(\"keep.source\" = TRUE), {\n eval(parse(text =\n\"fun <- function(x) {\n if (isTRUE(x)) {\n 1\n } else {\n 2\n }\n}\"), envir = env)\n })\n\n t1 <- function_coverage(\"fun\", env = env)\n\n expect_equal(length(t1), 3)\n\n expect_equal(length(exclude(t1)), 3)\n\n expect_equal(length(exclude(t1, \"\")), 0)\n\n expect_equal(length(exclude(t1, list(\"\" = 3))), 2)\n})\n" }, { "path": "tests/testthat/test-gcov.R", "content": "test_that(\"parse_gcov parses files properly\", {\n local_mocked_bindings(\n # functions called within parse_gcov\n file.exists = function(path) TRUE,\n normalize_path = function(path) \"simple.c\",\n line_coverages = function(source_file, matches, values, ...) values\n )\n\n with_mocked_bindings(\n readLines = function(x) {\n \" -: 0:Source:simple.c\"\n },\n expect_equal(parse_gcov(\"hi.c.gcov\"), numeric())\n )\n\n with_mocked_bindings(\n readLines = function(x) {\n c(\n \" -: 0:Source:simple.c\",\n \" -: 1:#define USE_RINTERNALS\"\n )\n },\n expect_equal(parse_gcov(\"hi.c.gcov\"), numeric())\n )\n\n with_mocked_bindings(\n readLines = function(x) {\n c(\n \" -: 0:Source:simple.c\",\n \" -: 0:Graph:simple.gcno\",\n \" -: 0:Data:simple.gcda\",\n \" -: 0:Runs:1\",\n \" -: 0:Programs:1\",\n \" -: 1:#define USE_RINTERNALS\",\n \" -: 2:#include \",\n \" -: 3:#include \",\n \" -: 4:#include \",\n \" -: 5:\",\n \" 4: 6:SEXP simple_(SEXP x) {\"\n )\n },\n expect_equal(parse_gcov(\"hi.c.gcov\"), 4)\n )\n with_mocked_bindings(\n readLines = function(x) {\n c(\n \" -: 0:Source:simple.c\",\n \" -: 0:Graph:simple.gcno\",\n \" -: 0:Data:simple.gcda\",\n \" -: 0:Runs:1\",\n \" -: 0:Programs:1\",\n \" -: 1:#define USE_RINTERNALS\",\n \" -: 2:#include \",\n \" -: 3:#include \",\n \" -: 4:#include \",\n \" -: 5:\",\n \" 4: 6:SEXP simple_(SEXP x) {\",\n \" -: 7: }\",\n \" #####: 8: pout[0] = 0;\"\n )\n },\n expect_equal(parse_gcov(\"hi.c.gcov\"), c(4, 0))\n )\n})\n\ntest_that(\"clean_gcov correctly clears files\", {\n\n dir <- file.path(tempfile(), \"src\")\n\n dir.create(dir, recursive = TRUE)\n file.create(file.path(dir, c(\"simple.c\", \"Makevars\", \"simple.c.gcov\", \"simple.gcda\", \"simple.gcno\")))\n expect_identical(list.files(dir), sort(c(\"simple.c\", \"Makevars\", \"simple.c.gcov\", \"simple.gcda\", \"simple.gcno\")))\n\n clean_gcov(dirname(dir))\n expect_identical(list.files(dir), sort(c(\"simple.c\", \"Makevars\")))\n})\n" }, { "path": "tests/testthat/test-gitlab.R", "content": "test_that(\"gitlab\", {\n cov <- package_coverage(\"TestS4\")\n\n on.exit(unlink(\"TestS4/public\", recursive = TRUE), add = TRUE)\n\n expect_error(gitlab(coverage = cov), NA)\n\n expect_true(file.exists(\"TestS4/public/coverage.html\"))\n})\n" }, { "path": "tests/testthat/test-memoised.R", "content": "s1 <- tempfile()\nt1 <- tempfile()\nwriteLines(con = s1,\n\"a <- memoise::memoise(function(x) {\n x + 1\n})\")\n\nwriteLines(con = t1,\n\"\na(1)\na(1)\na(1)\na(1)\na(2)\na(3)\")\n\non.exit(unlink(c(s1, t1)))\n\ntest_that(\"it works on Vectorized functions\", {\n cov <- file_coverage(s1, t1)\n cov_d <- as.data.frame(cov)\n\n expect_equal(cov_d$functions, \"a\")\n expect_equal(cov_d$value, 3)\n})\n" }, { "path": "tests/testthat/test-null.R", "content": "test_that(\"coverage of functions with NULL constructs\", {\n f1 <- function() NULL\n f2 <- function() {\n NULL\n }\n f3 <- function() {\n if (FALSE) {\n NULL\n }\n }\n f4 <- function() {\n if (FALSE)\n NULL\n }\n\n cv1 <- function_coverage(f1, f1())\n expect_equal(percent_coverage(cv1), 100)\n cv2 <- function_coverage(f2, f2())\n expect_equal(percent_coverage(cv2), 100)\n cv3 <- function_coverage(f3, f3())\n expect_equal(percent_coverage(cv3), 50)\n cv4 <- function_coverage(f4, f4())\n expect_equal(percent_coverage(cv4), 50)\n})\n" }, { "path": "tests/testthat/test-package_coverage.R", "content": "test_that(\"package_coverage returns an error if the path does not exist\", {\n expect_error(package_coverage(\"blah\"))\n})\n\ntest_that(\"package_coverage returns an error if the type is incorrect\", {\n expect_error(\n package_coverage(\"TestPrint\", type = \"blah\"),\n \"'arg' should be one of\")\n\n expect_error(package_coverage(\"TestPrint\", type = c(\"blah\", \"test\")),\n \"'arg' should be one of\")\n})\n\ntest_that(\"package_coverage can return just tests and vignettes\", {\n cov <- package_coverage(\"TestPrint\", type = c(\"tests\", \"vignettes\"), combine_types = FALSE)\n\n expect_equal(names(cov), c(\"tests\", \"vignettes\"))\n})\n\ntest_that(\"package_coverage with type == 'all' returns test, vignette and example coverage\", {\n cov <- package_coverage(\"TestPrint\", type = \"all\", combine_types = FALSE)\n\n expect_equal(names(cov), c(\"tests\", \"vignettes\", \"examples\"))\n})\n\ntest_that(\"package_coverage with type == 'none' runs no test code\", {\n cov <- package_coverage(\"TestS4\", type = \"none\")\n\n expect_equal(percent_coverage(cov), 0.00)\n})\n\ntest_that(\"package_coverage runs additional test code\", {\n cov <- package_coverage(\"TestS4\", type = \"none\", code = c(\"a(1)\", \"a(2)\"))\n\n expect_gt(percent_coverage(cov), 0.00)\n})\n" }, { "path": "tests/testthat/test-parallel.R", "content": "test_that(\"mcparallel without the fix\", {\n skip_on_os(\"windows\")\n\n cov <- withr::with_options(list(covr.fix_parallel_mcexit = FALSE),\n package_coverage(\"TestParallel\", type = \"test\"))\n # only the non parallel code is covered\n expect_equal(floor(percent_coverage(cov)), 33)\n})\n\n\n\ntest_that(\"mcparallel with the fix\", {\n skip_on_os(\"windows\")\n\n # using auto detection\n cov <- package_coverage(test_path(\"TestParallel\"), type = \"test\")\n # only the non parallel code is covered\n expect_equal(percent_coverage(cov), 100)\n})\n\n\n\ntest_that(\"uses_parallel\", {\n pkg <- covr:::as_package(\"TestParallel\")\n expect_true(covr:::uses_parallel(pkg))\n\n pkg <- covr:::as_package(\"TestSummary\")\n expect_false(covr:::uses_parallel(pkg))\n})\n\n\n\ntest_that(\"should_enable_parallel_mcexit_fix\", {\n skip_on_os(\"windows\")\n on.exit({\n Sys.unsetenv('COVR_FIX_PARALLEL_MCEXIT')\n options(covr.fix_parallel_mcexit = NULL)\n }, add = TRUE\n )\n\n grid <- expand.grid(\n var = c(NA, TRUE, FALSE),\n option = c(NA, TRUE, FALSE),\n pkg = c(\"TestParallel\", \"TestSummary\"), stringsAsFactors = FALSE)\n\n grid$res <- with(grid, ifelse(!is.na(var),\n var,\n ifelse(!is.na(option), option, pkg == \"TestParallel\")\n ))\n\n .test_config <- function(var, option, pkgname) {\n if (is.na(var))\n Sys.unsetenv('COVR_FIX_PARALLEL_MCEXIT')\n else\n Sys.setenv(COVR_FIX_PARALLEL_MCEXIT = var)\n\n\n if (is.na(option))\n options(covr.fix_parallel_mcexit = NULL)\n else\n options(covr.fix_parallel_mcexit = option)\n\n pkg <- covr:::as_package(pkgname)\n covr:::should_enable_parallel_mcexit_fix(pkg)\n }\n\n res <- with(grid, vapply(1:nrow(grid),\n function(i) .test_config(var[i], option[i], pkg[i]), TRUE))\n\n expect_identical(res, grid$res)\n\n})\n" }, { "path": "tests/testthat/test-print.R", "content": "test_that(\"format_percentage works as expected\", {\n expect_equal(format_percentage(0), cli::col_red(\"0.00%\"))\n\n expect_equal(format_percentage(25), cli::col_red(\"25.00%\"))\n\n expect_equal(format_percentage(51), cli::col_red(\"51.00%\"))\n\n expect_equal(format_percentage(76.5), cli::col_yellow(\"76.50%\"))\n\n expect_equal(format_percentage(86.5), cli::col_yellow(\"86.50%\"))\n\n expect_equal(format_percentage(96.5), cli::col_green(\"96.50%\"))\n})\n\ntest_that(\"print.coverage prints by = \\\"line\\\" by default\", {\n cov <- package_coverage(test_path(\"TestPrint\"))\n\n expect_message(print(cov, by = \"expression\"),\n rex::rex(\"R/TestPrint.R: \", anything, \"66.67%\"))\n\n expect_message(print(cov, by = \"line\"),\n rex::rex(\"TestPrint Coverage: \", anything, \"0.00%\"))\n\n expect_message(print(cov, by = \"line\"),\n rex::rex(\"R/TestPrint.R: \", anything, \"0.00%\"))\n\n # test default\n expect_message(print(cov),\n rex::rex(\"TestPrint Coverage: \", anything, \"0.00%\"))\n\n expect_message(print(cov),\n rex::rex(\"R/TestPrint.R: \", anything, \"0.00%\"))\n\n expect_message(print(cov, group = \"functions\"),\n rex::rex(\"test_me\", anything, \"0.00%\"))\n\n expect_message(print(cov, group = \"functions\", by = \"expression\"),\n rex::rex(\"test_me\", anything, \"66.67%\"))\n})\n" }, { "path": "tests/testthat/test-record_tests.R", "content": "cov_func <- withr::with_options(\n list(covr.record_tests = TRUE),\n package_coverage(test_path(\"TestFunctional\")))\n\ncov_tests_not_recorded <- withr::with_options(\n list(covr.record_tests = NULL),\n package_coverage(test_path(\"TestFunctional\")))\n\n\ntest_that(\"covr.record_tests causes test traces to be recorded\", {\n expect_gt(length(attr(cov_func, \"tests\")), 0L)\n expect_gt(length(attr(cov_func, \"tests\")[[1]]), 0L)\n})\n\n\ntest_that(\"covr.record_tests records test indices and depth for each trace\", {\n expect_equal(ncol(cov_func[[1]]$tests), 4L)\n expect_equal(colnames(cov_func[[1]]$tests), c(\"test\", \"call\", \"depth\", \"i\"))\n})\n\n\ntest_that(\"covr.record_tests test traces list uses srcref key names\", {\n expect_match(names(attr(cov_func, \"tests\")), \"\\\\w+(:\\\\d+){4,8}\")\n})\n\n\ntest_that(\"covr.record_tests=NULL does not record tests\", {\n expect_null(attr(cov_tests_not_recorded, \"tests\"))\n expect_null(cov_tests_not_recorded[[1]]$tests$tally)\n})\n\n\ntest_that(\"covr.record_tests traces to tests nested within test directory\", {\n cov_top_level <- withr::with_envvar(\n list(COVR_TEST_NESTED = \"FALSE\"),\n package_coverage(test_path(\"TestNestedTestDirs\")))\n\n cov_nested <- withr::with_envvar(\n list(COVR_TEST_NESTED = \"TRUE\"),\n cov_nested <- package_coverage(test_path(\"TestNestedTestDirs\")))\n\n # same test file is evaluated twice more in a nested directory\n expect_equal(length(attr(cov_top_level, \"tests\")) * 3L, length(attr(cov_nested, \"tests\")))\n})\n\n\ntest_that(\"covr.record_tests: merging coverage objects appends tests\", {\n # recreate some \".counters\" objects for testing\n .counter_1 <- list(\n tests = list(\n `./test1:1:2:3:4:5:6:7:8` = list(\n quote(test_that(\"test1\", { expect_true(a()) })),\n quote(expect_true(a())),\n quote(a())\n ),\n `./test2:1:2:3:4:5:6:7:8` = list(\n quote(test_that(\"test2\", { expect_true(a()) })),\n quote(expect_true(a())),\n quote(a())\n )\n ),\n `a:1:2:3:4:5:6:7:8` = list(\n value = 2L,\n tests = as.environment(list(tally = cbind(test = c(1, 2), depth = c(0, 1), i = c(1, 3))))\n ),\n `b:1:2:3:4:5:6:7:8` = list(\n value = 1L,\n tests = as.environment(list(tally = cbind(test = c(2), depth = c(0), i = c(2))))\n )\n )\n\n .counter_2 <- list(\n tests = list(\n `./test1:1:2:3:4:5:6:7:8` = list(\n quote(test_that(\"test1\", { expect_true(a()) })),\n quote(expect_true(a())),\n quote(a())\n ),\n `./test3:1:2:3:4:5:6:7:8` = list(\n quote(test_that(\"test3\", { expect_true(a()) })),\n quote(expect_true(a())),\n quote(a())\n )\n ),\n `a:1:2:3:4:5:6:7:8` = list(\n value = 1L,\n tests = as.environment(list(tally = cbind(test = c(2), depth = c(0), i = c(1))))\n ),\n `c:1:2:3:4:5:6:7:8` = list(\n value = 1L,\n tests = as.environment(list(tally = cbind(test = c(2), depth = c(0), i = c(2))))\n )\n )\n\n # store sum total of individual counters. store before merge, as the first\n # will be modified in-place during merging.\n counter_total <-\n nrow(.counter_1$`a:1:2:3:4:5:6:7:8`$tests$tally) +\n nrow(.counter_2$`a:1:2:3:4:5:6:7:8`$tests$tally)\n\n expect_silent(cov_merged <- merge_coverage.list(list(.counter_1, .counter_2)))\n expect_equal(nrow(cov_merged$`a:1:2:3:4:5:6:7:8`$tests$tally), counter_total)\n expect_equal(length(cov_merged$tests), 3L)\n expect_equal(cov_merged$`a:1:2:3:4:5:6:7:8`$tests$tally[[3L,1L]], 3L)\n})\n\n\ntest_that(\"covr.record_tests: tests tally is pruned even when no tests are hit\", {\n # \"test\" a function, but no code is executed and therefore no tests are logged\n fcode <- 'f <- function(x) { if (x) f(!x) else FALSE }'\n withr::with_options(c(\"covr.record_tests\" = TRUE), cov <- code_coverage(fcode, \"{ }\"))\n\n # expect that no tests were recorded, as no expressions evaluated f\n expect_null(attr(cov, \"tests\"))\n\n # expect that a matrix was still produced by a counter and pruned to 0 rows\n expect_true(is.matrix(cov[[1L]]$tests))\n expect_equal(cov[[1L]]$value, 0L)\n expect_equal(nrow(cov[[1L]]$tests), 0L)\n})\n\n\ntest_that(\"covr.record_tests: merging coverage test objects doesn't break default tests\", {\n # recreate some \".counters\" objects for testing\n .counter_1 <- list(\n `a:1:2:3:4:5:6:7:8` = list(value = 2L),\n `b:1:2:3:4:5:6:7:8` = list(value = 2L)\n )\n\n .counter_2 <- list(\n `a:1:2:3:4:5:6:7:8` = list(value = 2L),\n `c:1:2:3:4:5:6:7:8` = list(value = 2L)\n )\n\n expect_silent(cov_merged <- merge_coverage(list(.counter_1, .counter_2)))\n expect_equal(cov_merged$`a:1:2:3:4:5:6:7:8`$value, 4L)\n})\n\n\ntest_that(\"covr.record_tests: test that coverage objects contain expected test data\", {\n fcode <- '\n f <- function(x) {\n if (x)\n f(!x)\n else\n FALSE\n }'\n\n withr::with_options(c(\"covr.record_tests\" = TRUE), cov <- code_coverage(fcode, \"f(TRUE)\"))\n\n # expect 4 covr traces due to test\n expect_equal(sum(unlist(lapply(cov, function(i) nrow(i[[\"tests\"]])))), 4L)\n\n # expect that all tests have the same index\n expect_equal(unique(unlist(lapply(cov, function(i) i[[\"tests\"]][,\"test\"]))), 1L)\n\n # expect execution order index to be the same length as the number of traces\n expect_equal(length(unique(unlist(lapply(cov, function(i) i[[\"tests\"]][,\"i\"])))), 4L)\n\n # expect that there are two distinct stack depths (`if (x)` (@1), `TRUE` (@2), `FALSE` (@2))\n expect_equal(length(unique(unlist(lapply(cov, function(i) i[[\"tests\"]][,\"depth\"])))), 2L)\n})\n\ntest_that(\"covr.record_tests: safely handles extremely large calls\", {\n skip_on_cran()\n skip_if(is_r_devel())\n\n fcode <- 'f <- function(...) { sum(...) }'\n\n expect_warning(\n withr::with_options(c(\"covr.record_tests\" = TRUE), {\n cov <- code_coverage(fcode, \"do.call('f', as.list(rep_len(1L, 1e6)))\")\n }),\n \"large call .* truncated\"\n )\n\n # expect that all calls in recorded test call stacks are under call length limit\n expect_true(all(vapply(attr(cov, \"tests\")[[1L]], length, numeric(1L)) < 1e5))\n\n # add a canary to test for R updates that handle large call deserialization\n # more gracefully\n suppressWarnings({\n code <- deparse(quote({\n x <- as.call(c(list(\"f\"), as.list(rep_len(1L, 1e6))))\n f <- tempfile(\"test_rds\", fileext = \".Rds\")\n saveRDS(x, f)\n readRDS(f)\n }))\n\n r_script <- tempfile(\"test_rds_script\", fileext = \".R\")\n writeLines(code, r_script)\n res <- system2(file.path(R.home(\"bin\"), \"R\"), list(\"-q\", \"-s\", \"--vanilla\", \"-f\", r_script), stdout = TRUE, stderr = TRUE)\n })\n\n if (identical(attr(res, \"status\"), 0L)) {\n warning(paste0(collapse = \"\\n\", strwrap(paste0(\n \"Looks like R was updated and the work-around for Rds \",\n \"deserialization segfaults can now be made to apply conditionally to only \",\n \"legacy R versions. Search for 'NOTE: r-bugs 18348' in the covr \",\n \"codebase to find and add necessary R version condition to the affected \",\n \"code\"\n ))))\n }\n\n})\n\ntest_that(\"covr.record_tests: records multiple calls to the same test expr\", {\n fcode <- 'f1 <- function(...) \"hello, world\"; f2 <- function() c(1, 2, 3)'\n\n withr::with_options(c(\"covr.record_tests\" = TRUE), {\n cov <- code_coverage(fcode, \"for (i in 1:3) with(new.env(), { f1(); f2() })\")\n })\n\n trace_f1 <- which(vapply(cov, `[[`, character(1L), \"functions\") == \"f1\")\n expect_equal(cov[[trace_f1]]$tests[, \"test\"], c(1, 1, 1))\n expect_equal(cov[[trace_f1]]$tests[, \"call\"], c(1, 2, 3))\n\n trace_f2 <- which(vapply(cov, `[[`, character(1L), \"functions\") == \"f2\")\n expect_equal(cov[[trace_f2]]$tests[, \"test\"], c(2, 2, 2))\n expect_equal(cov[[trace_f2]]$tests[, \"call\"], c(1, 2, 3))\n})\n" }, { "path": "tests/testthat/test-report.R", "content": "skip_on_ci <- function() {\n if (!identical(Sys.getenv(\"CI\"), \"true\")) {\n return(invisible(TRUE))\n }\n\n skip(\"On CI\")\n}\n\n#test_that(\"it works with coverage objects\", {\n #skip_on_cran()\n #skip_on_ci()\n\n #tmp <- tempfile()\n #set.seed(42)\n #cov <- package_coverage(test_path(\"TestS4\"))\n ## Shiny uses its own seed which is not affected by set.seed, so we need to\n ## set that as well to have reproducibility\n #g <- shiny:::.globals\n #g$ownSeed <- .Random.seed\n #htmlwidgets::setWidgetIdSeed(42)\n #report(cov, file = tmp, browse = FALSE)\n #simplify_link <- function(x) {\n #rex::re_substitutes(x,\n #rex::rex(capture(or(\"src\", \"href\")), \"=\", quote, non_quotes, quote), \"\\\\1=\\\"\\\">\")\n #}\n #expect_equal(simplify_link(readLines(tmp)), simplify_link(readLines(\"test-report.htm\")))\n#})\n" }, { "path": "tests/testthat/test-report.htm", "content": "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n TestS4 Coverage\n\n\n
\n \n
\n
\n \n
\n
\n
\n \n
\n
\n
\n
\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
1\n 
#' an example function
\n
2\n 
#'
\n
3\n 
#' @export
\n
4\n 
#' @examples
\n
5\n 
#' a(1)
\n
6\n 
a <- function(x) {
\n
7\n 
  if (x <= 1) {
\n 		5x
8\n 
    1
\n 		2x
9\n 
  } else {
\n
10\n 
    2
\n 		3x
11\n 
  }
\n
12\n 
}
\n
13\n 
\n                    
14\n                      
#' @export
\n                    
15\n                      
TestS4 <- setClass(\"TestS4\", # nolint
\n                    
16\n                      
  slots = list(name = \"character\", enabled = \"logical\"))
\n                    
17\n                      
\n                    
18\n                      
#' @export
\n                    
19\n                      
setGeneric(\"print2\", function(x, y) {
\n                    
20\n                      
})
\n                    
21\n                      
\n                    
22\n                      
setMethod(\"print2\",
\n                    
23\n                      
  c(x = \"TestS4\"),
\n                    
24\n                      
  function(x) {
\n                    
25\n                      
    1 + 1
\n                    		1x
26\n                      
  })
\n                    
27\n                      
\n                    
28\n                      
setMethod(\"print2\",
\n                    
29\n                      
  c(x = \"TestS4\", y = \"character\"),
\n                    
30\n                      
  function(x, y) {
\n                    
31\n                      
    1 + 2
\n                    		1x
32\n                      
  })
\n                    
33\n                      
\n                    
34\n                      
setMethod(\"show\",
\n                    
35\n                      
  c(object = \"TestS4\"),
\n                    
36\n                      
  function(object) {
\n                    
37\n                      
    1 + 3
\n                    		1x
38\n                      
  })
\n                    
\n            
\n            \n          
\n        
\n      
\n    
\n  
\n
\n\n\n"
  },
  {
    "path": "tests/testthat/test-sonarqube.R",
    "content": "test_that(\"it works with coverage objects\", {\n  tmp <- tempfile()\n  cov <- package_coverage(test_path(\"TestSummary\"))\n  to_sonarqube(cov, filename = tmp)\n  expect_equal(readLines(tmp), readLines(test_path(\"sonarqube.xml\")))\n})\n"
  },
  {
    "path": "tests/testthat/test-summary.R",
    "content": "test_that(\"Summary gives 50% coverage and two lines with zero coverage\", {\n  cv <- package_coverage(test_path(\"TestSummary\"))\n  expect_equal(percent_coverage(cv), 50)\n  expect_equal(nrow(zero_coverage(cv)), 2)\n})\n\ntest_that(\"percent_coverage\", {\n  old <- getOption(\"keep.source\")\n  options(keep.source = TRUE)\n  on.exit(options(keep.source = old), add = TRUE)\n\n  fun <- function() {\n     x <- 1\n     if (x > 2) {\n       print(x)\n     }\n     res <- lapply(1:2, function(x) {\n                          x + 1\n                        })\n  }\n  cov <- function_coverage(\"fun\", env = environment(fun), fun())\n\n  res <- percent_coverage(cov)\n  expect_equal(res, 83.333333, tolerance = .01)\n})\n"
  },
  {
    "path": "tests/testthat/test-trace_calls.R",
    "content": "test_that(\"one-line functions are traced correctly\", {\n  old <- getOption(\"keep.source\")\n  options(keep.source = TRUE)\n  on.exit(options(keep.source = old))\n\n  fun <- function(x) x + 1\n\n  expect_equal(as.character(body(trace_calls(fun))[[3]][[2]][[1]]),\n      c(\":::\", \"covr\", \"count\"))\n\n  fun <- function() 1\n\n  expect_equal(as.character(body(trace_calls(fun))[[3]][[2]][[1]]),\n      c(\":::\", \"covr\", \"count\"))\n\n  expect_equal(body(trace_calls(fun))[[3]][[3]], body(fun))\n})\ntest_that(\"one-line functions with no calls are traced correctly\", {\n  old <- getOption(\"keep.source\")\n  options(keep.source = TRUE)\n  on.exit(options(keep.source = old))\n\n  fun <- function(x) x\n\n  expect_equal(as.character(body(trace_calls(fun))[[3]][[2]][[1]]),\n      c(\":::\", \"covr\", \"count\"))\n\n  expect_equal(body(trace_calls(fun))[[3]][[3]], body(fun))\n})\ntest_that(\"one-line functions with braces are traced correctly\", {\n  old <- getOption(\"keep.source\")\n  options(keep.source = TRUE)\n  on.exit(options(keep.source = old))\n\n  fun <- function(x) {\n    x + 1\n  }\n\n  expect_equal(as.character(body(trace_calls(fun))[[2]][[3]][[2]][[1]]),\n      c(\":::\", \"covr\", \"count\"))\n\n  expect_equal(body(trace_calls(fun))[[2]][[3]][[3]], body(fun)[[2]])\n})\n\ntest_that(\"one-line functions with no calls and braces are traced correctly\", {\n  old <- getOption(\"keep.source\")\n  options(keep.source = TRUE)\n  on.exit(options(keep.source = old))\n\n  fun <- function() {\n    1\n  }\n\n  e2 <- body(trace_calls(fun))[[2]][[3]]\n  expect_true(length(e2) > 1 &&\n              identical(as.character(e2[[2]][[1]]), c(\":::\", \"covr\", \"count\")))\n\n  fun <- function(x) {\n    x\n  }\n\n  e2 <- body(trace_calls(fun))[[2]][[3]]\n\n  # the second expr should be a block\n  expect_true(length(e2) > 1 &&\n    identical(as.character(e2[[2]][[1]]), c(\":::\", \"covr\", \"count\")))\n})\n\n\ntest_that(\"last evaled expression is traced\", {\n  old <- getOption(\"keep.source\")\n  options(keep.source = TRUE)\n  on.exit(options(keep.source = old))\n\n  fun <- function() {\n    x <- 1\n    x\n  }\n\n  body <- body(trace_calls(fun))\n\n  expect_equal(length(body), 3)\n\n  # last expression: the implicit return expression\n  e3 <- body[[3]][[3]]\n  expect_true(length(e3) > 1 &&\n    identical(as.character(e3[[2]][[1]]), c(\":::\", \"covr\", \"count\")))\n\n})\n\ntest_that(\"functions with NULL bodies are traced correctly\", {\n  old <- options(keep.source = TRUE)\n  on.exit(options(old))\n\n  fun <- function() NULL\n\n  expect_null(trace_calls(fun)())\n})\n\ntest_that(\"functions with curly curly syntax are traced correctly\", {\n  my_capture <- function(x) {\n    rlang::expr({{ x }})\n  }\n  expect_equal(my_capture(5 == 1), rlang::quo(5 == 1))\n\n  # behavior not changed by covr\n  my_capture2 <- trace_calls(my_capture)\n  expect_equal(my_capture2(5 == 1), rlang::quo(5 == 1))\n\n  # outer code traced traced with ({  })\n  expect_equal(as.character(body(my_capture2)[[2]][[1]]), \"if\")\n  expect_equal(as.character(body(my_capture2)[[2]][[3]][[1]]), \"{\")\n  expect_equal(as.character(body(my_capture2)[[2]][[3]][[2]][[1]]), c(\":::\", \"covr\", \"count\"))\n\n  # no trace in the internal {{  }}\n  expect_equal(as.character(body(my_capture2)[[2]][[3]][[3]][[2]][[1]]), \"{\")\n  expect_equal(as.character(body(my_capture2)[[2]][[3]][[3]][[2]][[2]][[1]]), \"{\")\n})\n\n\ntest_that(\"functions that rely on implicit invisibility work the same\", {\n  f <- function(x) {\n    x <- 1\n  }\n\n  f2 <- trace_calls(f)\n\n  expect_equal(withVisible(f2(1)), withVisible(f(1)))\n\n  f3 <- function(x) {\n    x + 1\n  }\n\n  f4 <- trace_calls(f3)\n\n  expect_equal(withVisible(f3(1)), withVisible(f4(1)))\n})\n\n\ntest_that(\"functions that use S3 dispatch work\", {\n  cov <- code_coverage( source_code = '\nfoo <- function(x) {\n  UseMethod(\"foo\")\n}\n\nfoo.bar <- function(x) { x[[1]] + 1 }\n\nbar <- function(x) {\n  structure(list(x), class = \"bar\")\n}\n', test_code = '\nstopifnot(foo(bar(1)) == 2)\n')\n  expect_equal(percent_coverage(cov), 100)\n})\n"
  },
  {
    "path": "tests/testthat/test-utils.R",
    "content": "test_that(\"it throws error if no package\", {\n  expect_error(as_package(\"arst11234\"), \"`path` is invalid:.*arst11234\")\n})\n\ntest_that(\"it returns the package if given the root or child directory\", {\n\n  expect_equal(as_package(\"TestS4\")$package, \"TestS4\")\n  expect_equal(as_package(\"TestS4/\")$package, \"TestS4\")\n\n  expect_equal(as_package(\"TestS4/R\")$package, \"TestS4\")\n\n  expect_equal(as_package(\"TestS4/tests\")$package, \"TestS4\")\n\n  expect_equal(as_package(\"TestS4/tests/testthat\")$package, \"TestS4\")\n})\n\ntest_that(\"it works as expected\", {\n  with_mocked_bindings(\n    system_output = function(...) {\"test_branch \"},\n    expect_equal(local_branch(\"TestSummary\"), \"test_branch\")\n  )\n})\n\ntest_that(\"it works as expected\", {\n  with_mocked_bindings(\n    system_output = function(...) {\" test_hash\"},\n    expect_equal(current_commit(\"TestSummary\"), \"test_hash\")\n  )\n})\n\ntest_that(\"it works\", {\n  # R 4.0.0 changes this behavior so `getSrcFilename()` will actually return\n  # \"test-utils.R\"\n\n  skip_if(getRversion() >= \"4.0.0\")\n\n  x <- eval(bquote(function() 1))\n\n  expect_identical(getSrcFilename(x), character())\n  expect_identical(get_source_filename(x), \"\")\n})\n\ntest_that(\"per_line removes blank lines and lines with only punctuation (#387)\", {\n  skip_on_cran()\n\n  cov <- package_coverage(test_path(\"TestFunctional\"))\n\n  line_cov <- per_line(cov)\n\n  expect_equal(line_cov[[1]]$coverage, c(NA, 0, 0, 2, NA, 1, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA))\n})\n\ntest_that(\"split_on_line_directives returns NULL for input without directive (#588)\", {\n  expect_identical(\n    split_on_line_directives(NULL),\n    NULL\n  )\n  expect_identical(\n    split_on_line_directives(character()),\n    NULL\n  )\n  expect_identical(\n    split_on_line_directives(\"aa\"),\n    NULL\n  )\n  expect_identical(\n    split_on_line_directives(c(\"abc\", \"def\")),\n    NULL\n  )\n})\n\ntest_that(\"split_on_line_directives does not simplify the result (#588)\", {\n  expect_identical(\n    split_on_line_directives(\n      c(\n        '#line 1 \"foo.R\"',\n        \"abc\",\n        \"def\"\n      )\n    ),\n    list(\n      \"foo.R\" = c(\"abc\", \"def\")\n    )\n  )\n  expect_identical(\n    split_on_line_directives(\n      c(\n        '#line 1 \"foo.R\"',\n        \"abc\",\n        \"def\",\n        '#line 4 \"bar.R\"',\n        \"ghi\",\n        \"jkl\"\n      )\n    ),\n    list(\n      \"foo.R\" = c(\"abc\", \"def\"),\n      \"bar.R\" = c(\"ghi\", \"jkl\")\n    )\n  )\n})\n"
  },
  {
    "path": "tests/testthat/test-vectorized.R",
    "content": "s1 = tempfile()\nt1 = tempfile()\nwriteLines(con = s1,\n'scalar_func <- function(x,y) {\n  z <- x + y\n}\n\nvector_func <- Vectorize(scalar_func,vectorize.args=c(\"x\",\"y\"),SIMPLIFY=TRUE)')\n\nwriteLines(con = t1,\n\"vector_func(1:10, 2)\")\n\non.exit(unlink(c(s1, t1)))\n\ntest_that(\"it works on Vectorized functions\", {\n  cov <- file_coverage(s1, t1)\n  cov_d <- as.data.frame(cov)\n\n  expect_equal(cov_d$functions, \"vector_func\")\n  expect_equal(cov_d$value, 10)\n})\n"
  },
  {
    "path": "tests/testthat.R",
    "content": "# This file is part of the standard setup for testthat.\n# It is recommended that you do not modify it.\n#\n# Where should you do additional test configuration?\n# Learn more about the roles of various files in:\n# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview\n# * https://testthat.r-lib.org/articles/special-files.html\n\nlibrary(testthat)\nlibrary(covr)\n\ntest_check(\"covr\")\n"
  },
  {
    "path": "unshim_package.sh",
    "content": "#!/usr/bin/env sh\n\nperl -i -pe 's/\\bcovrShim\\b/covr/g;s/\\bcovrShim_/covr_/g;s/_covrShim/_covr/g;' DESCRIPTION NAMESPACE R/* src/* tests/*R tests/testthat/*R\n"
  },
  {
    "path": "vignettes/how_it_works.Rmd",
    "content": "---\ntitle: \"How does covr work anyway?\"\nauthor: \"Jim Hester\"\ndate: \"`r Sys.Date()`\"\noutput: rmarkdown::html_vignette\nvignette: >\n %\\VignetteIndexEntry{How does covr work anyway}\n %\\VignetteEngine{knitr::rmarkdown}\n \\usepackage[utf8]{inputenc}\n---\n\n```{r setup, include = FALSE}\nlibrary(covr)\n```\n\n# Introduction #\n\nThe **covr** package provides a framework for measuring unit test coverage.\nUnit testing is one of the cornerstones of software development.\nAny piece of R code can be thought of as a software application with a certain set of behaviors.\nUnit testing means creating examples of how the code should behave _with a definition of the expected output_.\nThis could include normal use, edge cases, and expected error cases.\nUnit testing is commonly facilitated by frameworks such as **testthat** and **RUnit**.\nTest _coverage_ is the _proportion_ of the source code that is executed when running these tests.\nCode coverage consists of:\n\n* instrumenting the source code so that it reports when it is run,\n* executing the unit test code to exercise the source code.\n\nMeasuring code coverage allows developers to asses their progress in quality checking their own (or their collaborators) code.\nMeasuring code coverage allows code consumers to have confidence in the measures taken by the package authors to verify high code quality.\n**covr** provides three functions to calculate test coverage.\n\n- `package_coverage()` performs coverage calculation on an R package. (Unit tests must be contained in the `\"tests\"` directory.)\n- `file_coverage()` performs coverage calculation on one or more R scripts by executing one or more R scripts.\n- `function_coverage()` performs coverage calculation on a single named function, using an expression provided.\n\nIn addition to providing an objective metric of test suite extensiveness, it is often advantageous for developers to have a code level view of their unit tests.\nAn interface for visually marking code with test coverage results allows a clear box view of the unit test suite.\nThe clear box view can be accessed using online tools or a local report can be generated using `report()`.\n\n# Instrumenting R Source Code #\n\n## Modifying the call tree ##\n\nThe core function in **covr** is `trace_calls()`.\nThis function was adapted from ideas in [_Advanced R - Walking the Abstract Syntax Tree with\nrecursive functions_](http://adv-r.had.co.nz/Expressions.html#ast-funs).\nThis recursive function modifies each of the leaves (atomic or name objects) of\nan R expression by applying a given function to them.\nIf the expression is not a leaf the walker function calls itself recursively on elements of the expression instead.\n\nWe can use this same framework to instead insert a trace statement before each\ncall by replacing each call with a call to a counting function followed by the previous call.\nBraces (`{`) in R may seem like language syntax, but\nthey are actually a Primitive function and you can call them like any other\nfunction.\n\n```{r}\nidentical(x = { 1 + 2; 3 + 4 },\n    y = `{`(1 + 2, 3 + 4))\n```\nRemembering that braces always return the value of the last evaluated expression, we can call a counting function followed by the previous function\nsubstituting `as.call(recurse(x))` in our function above with.\n\n```{r, eval = FALSE}\n`{`(count(), as.call(recurse(x)))\n```\n\n## Source References ##\n\nNow that we have a way to add a counting function to any call in the Abstract Syntax Tree\nwithout changing the output we need a way to determine where in the code source\nthat function came from.\nLuckily R has a built-in method to provide this\ninformation in the form of source references.\nWhen `option(keep.source = TRUE)` (the default for interactive sessions), a reference to the source code\nfor functions is stored along with the function definition.\nThis reference is used to provide the original formatting and comments for the given function source.\nIn particular each call in a function contains a `srcref` attribute, which can then be used as a key to count just that call.\n\nThe actual source for `trace_calls` is slightly more complicated because we\nwant to initialize the counter for each call while we are walking the Abstract Syntax Tree and\nthere are a few non-calls we also want to count.\n\n## Refining Source References ##\n\nEach statement comes with a source reference. Unfortunately, the following is\ncounted as one statement:\n\n```r\nif (x)\n y()\n```\n\nTo work around this, detailed parse data (obtained from a refined version of\n`getParseData`) is analyzed to impute source references at sub-statement level for `if`, `for`, `while` and `switch` constructs.\n\n## Replacing Source In Place ##\n\nAfter we have our modified function definition, how do we re-define the function\nto use the updated definition, and ensure that all other functions which call\nthe old function also use the new definition? You might try redefining the function directly.\n\n```{r}\nf1 <- function() 1\n\nf1 <- function() 2\nf1() == 2\n```\n\nWhile this does work for the simple case of calling the new function in the\nsame environment, it fails if another function calls a function in a different environment.\n\n```{r}\nenv <- new.env()\nf1 <- function() 1\nenv$f2 <- function() f1() + 1\n\nenv$f1 <- function() 2\n\nenv$f2() == 3\n```\n\nAs modifying external environments and correctly restoring them can be tricky\nto get correct, we use the C function\n[`covr_reassign_function`](https://github.com/r-lib/covr/blob/40122df12bc9ef1e577dd0720a895b5340b1516f/src/reassign.c#L65-L135).\nThis function takes a function name,\nenvironment, old definition, new definition and copies the formals, body,\nattributes and environment from the old function to the new function.\nThis allows you to do an in-place replacement of a given function with a new\nfunction and ensure that all references to the old function will use the new definition.\n\n# Object Orientation #\n\n## S3 Classes ##\n\nR's S3 object oriented classes simply define functions directly in the packages\nnamespace, so they can be treated the same as any other function.\n\n## S4 Classes ##\n\nS4 methods have a more complicated implementation than S3 classes.\nThe function definitions are placed in an enclosing environment based on the generic method they implement.\nThis makes getting the function definition more complicated.\n\n`replacements_S4` first gets all the generic functions for the package environment.\nThen for each generic function if finds the mangled meta package name\nand gets the corresponding environment from the base environment.\nAll of the functions within this environment are then traced.\n\n## Reference Classes ##\n\nSimilarly to S4 classes reference classes (RC) define their methods in a special environment.\nA similar method is used to add the tracing calls to the\nclass definition.\nThese calls are then copied to the object methods when the\ngenerator function is run.\n\n# Compiled code #\n\n## Gcov ##\n\nTest coverage of compiled code uses a completely different mechanism than that\nof R code. Fortunately we can take advantage of\n[Gcov](https://gcc.gnu.org/onlinedocs/gcc-4.1.2/gcc/Gcov.html#Gcov), the\nbuilt-in coverage tool for [gcc](https://gcc.gnu.org/) and compatible reports\nfrom [clang](http://clang.llvm.org/) versions 3.5 and greater.\n\nBoth of these compilers track execution coverage when given the `--coverage`\nflag. In addition it is necessary to turn off compiler optimization `-O0`,\notherwise the coverage output is difficult or impossible to interpret as\nmultiple lines can be optimized into one, functions can be inlined, etc.\n\n## Makevars ##\n\nR passes flags defined in `PKG_CFLAGS` to the compiler, however it also has\ndefault flags including `-02` (defined in `$R_HOME/etc/Makeconf`), which need to\nbe overridden. Unfortunately it is not possible to override the default flags\nwith environment variables (as the new flags are added to the left of the\ndefaults rather than the right). However if Make variables are defined in\n`~/.R/Makevars` they _are_ used in place of the defaults.\n\nTherefore, we need to temporarily add `-O0 --coverage` to\nthe Makevars file, then restore the previous state after the coverage is run.\n\n## Subprocess ##\n\nThe last hurdle to getting compiled code coverage working properly is that the\ncoverage output is only produced when the running process ends.\nTherefore you cannot run the tests and get the results in the same R process.\n**covr** runs a separate R process when running tests.\nHowever we need to modify the package code first before running the tests.\n\n**covr** installs the package to be tested in a\ntemporary directory.\nNext, calls are made to the lazy loading code which installs a user hook to modify the code when it is loaded. We also register a finalizer\nwhich prints the coverage counts when the namespace is unloaded or the R process exits.\nThese output files are then aggregated together to determine the coverage.\n\nThis procedure works regardless of the number of child R processes used, so\ntherefore also works with parallel code.\n\n# Output Formats #\n\nThe output format returned by **covr** is an R object  of class \"coverage\" containing the information gathered when executing the test suite.\nIt consists of a named list, where the names are colon-delimited information from the source references (the file, line and columns the traced call is from).\nThe value is the number of times that given expression was called and the source ref of the original call.\n\n```{r}\n# an object to analyze\nf1 <- function(x) { x + 1 }\n# get results with no unit tests\nc1 <- function_coverage(fun = f1, code = NULL)\nc1\n# get results with unit tests\nc2 <- function_coverage(fun = f1, code = f1(x = 1) == 2)\nc2\n```\n\nAn `as.data.frame` method is available to make subsetting by various features easy to do.\n\nWhile **covr** tracks coverage by expression, typically users expect coverage to\nbe reported by line, so there are functions to convert to line oriented\ncoverage.\n\n# Codecov.io and Coveralls.io #\n\n[Codecov](https://about.codecov.io/) and [Coveralls](https://coveralls.io/) are a web services to help you track your code coverage\nover time, and ensure that all new code is appropriately covered.\n\nThey both have JSON-based APIs to submit and report on coverage. The functions `codecov` and `coveralls` create outputs that can be consumed by these services.\n\n# Prior Art #\n\n## Overview ##\n\nPrior to writing **covr**, there were a handful of coverage tools for R code.\n[**R-coverage**](https://web.archive.org/web/20160611114452/http://r2d2.quartzbio.com/posts/r-coverage-docker.html) by Karl Forner and\n[**testCoverage**](https://github.com/MangoTheCat/testCoverage) by Tom Taverner, Chris Campbell & Suchen Jin.\n\n## R-coverage ##\n\n**R-coverage** provides a very robust solution by modifying\nthe R source code to instrument the code for each call.\nUnfortunately this requires you to patch the source of the R application itself.\nGetting the changes incorporated into the core R distribution would likely be challenging.\n\n## Test Coverage ##\n\n**testCoverage** uses `getParseData`, R's alternate parser (from 3.0) to analyse the R source code.\nThe package replaces symbols in the code to be tested with a unique identifier.\nThis is then injected into a tracing function that will report each time the symbol is called.\nThe first symbol at each level of the expression tree is traced, allowing the coverage of code branches to be checked.\nThis is a complicated implementation I do not fully\nunderstand, which is one of the reasons I decided to write **covr**.\n\n## Covr ##\n\n**covr** takes an approach in-between the two previous tools.\nFunction definitions are modified by parsing the abstract syntax tree and inserting trace statements.\nThese modified definitions are then transparently replaced in-place using C.\nThis allows us to correctly instrument every call and function in a package without having to resort to alternate parsing or changes to the R source.\n\n# Conclusion #\n\n**covr** provides an accessible framework which will ease the communication of R unit test suites.\n**covr** can be integrated with continuous integration services where R developers are working on larger projects, or as part of multi-disciplinary teams.\n**covr** aims to be simple to use to make writing high quality code part of every R user's routine.\n"
  }
]