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

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

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

", file, " - ", percentage, "

")), addHighlight( renderSourceTable(data$full, "") ) ) ) htmltools::save_html(ui, out_file) viewer <- getOption("viewer", utils::browseURL) if (browse) { viewer(out_file) } invisible(out_file) } to_report_data <- function(x) { coverages <- per_line(x) res <- list() res$overall <- percent_coverage(x) res$full <- lapply(coverages, function(coverage) { lines <- coverage$file$file_lines values <- coverage$coverage values[is.na(values)] <- "" data.frame( line = seq_along(lines), source = lines, coverage = values, stringsAsFactors = FALSE) }) nms <- names(coverages) # set a temp name if it doesn't exist nms[nms == ""] <- "" names(res$full) <- nms res$file_stats <- compute_file_stats(res$full) res$file_stats$File <- add_link(names(res$full)) res$file_stats <- sort_file_stats(res$file_stats) res$file_stats$Coverage <- res$file_stats$Coverage res } compute_file_stats <- function(files) { do.call("rbind", lapply(files, function(file) { data.frame( Coverage = sprintf("%.2f%%", sum(file$coverage > 0) / sum(file$coverage != "") * 100), Lines = NROW(file), Relevant = sum(file$coverage != ""), Covered = sum(file$coverage > 0), Missed = sum(file$coverage == 0), `Hits / Line` = sprintf("%.0f", sum(as.numeric(file$coverage), na.rm = TRUE) / sum(file$coverage != "")), stringsAsFactors = FALSE, check.names = FALSE) } ) ) } sort_file_stats <- function(stats) { stats[order(as.numeric(sub("%", "", stats$Coverage)), -stats$Relevant), c("File", "Lines", "Relevant", "Covered", "Missed", "Hits / Line", "Coverage")] } add_link <- function(files) { vcapply(files, function(file) { as.character(htmltools::a(href = "#", file)) }) } renderSourceTable <- function(data, class = "hidden") { htmltools::div(id = "files", Map(function(lines, file) { htmltools::div(id = file, class=class, htmltools::tags$table(class = "table-condensed", htmltools::tags$tbody( lapply(seq_len(NROW(lines)), function(row_num) { coverage <- lines[row_num, "coverage"] cov_type <- NULL if (coverage == 0) { cov_value <- "!" cov_type <- "missed" } else if (coverage > 0) { cov_value <- htmltools::HTML(paste0(lines[row_num, "coverage"], "x", collapse = "")) cov_type <- "covered" } else { cov_type <- "never" cov_value <- "" } htmltools::tags$tr(class = cov_type, htmltools::tags$td(class = "num", lines[row_num, "line"]), htmltools::tags$td(class = "coverage", cov_value), htmltools::tags$td(class = "col-sm-12", htmltools::pre(class = "language-r", lines[row_num, "source"])) ) }) ) )) }, lines = data, file = names(data)), htmltools::tags$script( "$('div#files pre').each(function(i, block) { hljs.highlightBlock(block); });")) } addHighlight <- function(x = list()) { highlight <- htmltools::htmlDependency("highlight.js", "6.2", system.file(package = "covr", "www/shared/highlight.js"), script = "highlight.pack.js", stylesheet = "rstudio.css") htmltools::attachDependencies(x, c(htmltools::htmlDependencies(x), list(highlight))) } addin_report <- function() { loadNamespace("rstudioapi") project <- rstudioapi::getActiveProject() covr::report(covr::package_coverage(project %||% getwd())) } # These are all adapted from functions in shiny column <- function(width, ..., offset = 0, size = c("xs", "sm", "md", "lg")) { size <- match.arg(size) col_class <- paste0("col-", size, "-", width) if (offset > 0) { col_class <- paste0(col_class, " ", "col-", size, "-offset-", offset) } htmltools::div(class = col_class, ...) } tab_panel <- function(title, ..., value = title) { htmltools::div(class = "tab-pane", title = title, `data-value` = value, ...) } fluid_page <- function(...) { bootstrap_page( htmltools::div(class = "container-fluid", ...) ) } bootstrap_page <- function(...) { htmltools::attachDependencies(htmltools::tagList(list(...)), html_dependency_bootstrap()) } # from htmldeps::html_dependency_bootstrap (not yet on CRAN) html_dependency_bootstrap <- function () { htmltools::htmlDependency(name = "bootstrap", version = "3.3.5", src = system.file(file = "www/shared/bootstrap", package = "covr"), meta = list(viewport = "width=device-width, initial-scale=1"), script = c("js/bootstrap.min.js", "shim/html5shiv.min.js", "shim/respond.min.js"), stylesheet = c("css/bootstrap.min.css", "css/bootstrap-theme.min.css") ) } tabset_panel <- function(...) { tabset <- build_tabset(list(...)) htmltools::div(class = "tabbable", tabset$nav_list, tabset$content) } build_tabset <- function(tabs) { tabset_id <- "covr" tabs <- lapply(seq_len(length(tabs)), build_tab_item, tabs = tabs, tabset_id = tabset_id) list(nav_list = ul(class = "nav nav-tabs", `data-tabsetid` = tabset_id, lapply(tabs, "[[", 1)), content = htmltools::div(class = "tab-content", `data-tabsetid` = tabset_id, lapply(tabs, "[[", 2)) ) } build_tab_item <- function(i, tabs, tabset_id) { div_tag <- tabs[[i]] tab_id <- paste("tab", tabset_id, i, sep = "-") li_tag <- li( htmltools::a(href = paste0("#", tab_id), `data-toggle` = "tab", `data-value` = div_tag$attribs$`data-value`, div_tag$attribs$title ) ) if (i == 1) { li_tag$attribs$class <- "active" div_tag$attribs$class <- paste(div_tag$attribs$class, "active") } div_tag$attribs$id <- tab_id list(li_tag = li_tag, div_tag = div_tag) } li <- function(...) htmltools::tag("li", list(...)) ul <- function(...) htmltools::tag("ul", list(...)) ================================================ FILE: R/sonarqube.R ================================================ #' Create a SonarQube Generic XML file for test coverage according to #' https://docs.sonarqube.org/latest/analysis/generic-test/ #' Based on cobertura.R #' #' This functionality requires the xml2 package be installed. #' @param cov the coverage object returned from [package_coverage()] #' @param filename the name of the SonarQube Generic XML file #' @author Talkdesk Inc. #' @export to_sonarqube <- function(cov, filename = "sonarqube.xml"){ loadNamespace("xml2") df <- tally_coverage(cov, by = "line") d <- xml2::xml_new_document() top <- xml2::xml_add_child(d, "coverage", version = "1") files <- unique(df$filename) for (f in files){ file <- xml2::xml_add_child(top, "file", path = paste(attr(cov, "package")$package, "/", as.character(f), sep="")) for (fun_name in unique(na.omit(df[df$filename == f, "functions"]))) { fun_lines <- which(df$functions == fun_name & df$filename == f) for (i in fun_lines){ line <- df[i, ] xml2::xml_add_child(file, "lineToCover", lineNumber = as.character(line$line), covered = tolower(as.character(line$value>0))) } } } xml2::write_xml(d, file = filename) invisible(d) } ================================================ FILE: R/summary_functions.R ================================================ #' Provide percent coverage of package #' #' Calculate the total percent coverage from a coverage result object. #' @param x the coverage object returned from [package_coverage()] #' @param ... additional arguments passed to [tally_coverage()] #' @return The total percentage as a `numeric(1)`. #' @export percent_coverage <- function(x, ...) { res <- tally_coverage(x, ...) (sum(res$value > 0) / length(res$value)) * 100 } #' Tally coverage by line or expression #' #' @inheritParams percent_coverage #' @param by whether to tally coverage by line or expression #' @return a `data.frame` of coverage tallied by line or expression. #' @export tally_coverage <- function(x, by = c("line", "expression")) { # Rarely something goes wrong with the source references and we get all NAs # for them, so we omit them here df <- as.data.frame(x) all_na_rows <- rowSums(is.na(df)) == ncol(df) df <- df[!all_na_rows, ] if (NROW(df) == 0) { return(df) } by <- match.arg(by) switch(by, "line" = { # if it already has a line column it has already been tallied. if (!is.null(df$line)) { return(df) } # aggregate() can't cope with zero-length data frames anyway. if (nrow(df) == 0L) { return(NULL) } # results with NA functions (such as from compiled code) are dropped # unless NA is a level. df$functions <- addNA(df$functions) res <- expand_lines(df) res <- aggregate(value ~ filename + functions + line, data = res, FUN = min, na.action = na.pass) res$functions <- as.character(res$functions) # exclude blank lines from results if (inherits(x, "coverage")) { srcfiles <- unique(lapply(x, function(x) attr(x$srcref, "srcfile"))) srcfile_names <- vcapply(srcfiles, `[[`, "filename") srcfile_names <- to_relative_path(srcfile_names, attr(x, "root")) blank_lines <- compact( setNames(lapply(srcfiles, function(srcfile) attr(srcfile_lines(srcfile), "blanks")), srcfile_names)) if (length(blank_lines)) { blank_lines <- utils::stack(blank_lines) non_blanks <- setdiff.data.frame( res, blank_lines, by.x = c("filename", "line"), by.y = c("ind", "values")) res <- res[non_blanks, ] } res } res[order(res$filename, res$line), ] }, "expression" = df ) } #' Provide locations of zero coverage #' #' When examining the test coverage of a package, it is useful to know if there are #' any locations where there is **0** test coverage. #' #' @param x a coverage object returned [package_coverage()] #' @param ... additional arguments passed to #' [tally_coverage()] #' @return A `data.frame` with coverage data where the coverage is 0. #' @details if used within RStudio this function outputs the results using the #' Marker API. #' @export zero_coverage <- function(x, ...) { coverage_data <- tally_coverage(x, ...) coverage_data <- coverage_data[coverage_data$value == 0, , drop = FALSE] res <- coverage_data[ # need to use %in% rather than explicit indexing because # tally_coverage returns a df without the columns if # by is equal to "line" colnames(coverage_data) %in% c("filename", "functions", "line", "first_line", "last_line", "first_column", "last_column", "value")] if (getOption("covr.rstudio_source_markers", TRUE) && rstudioapi::hasFun("sourceMarkers")) { markers <- markers(coverage_data) rstudioapi::callFun("sourceMarkers", name = "covr", markers = markers, basePath = attr(x, "package")$path, autoSelect = "first") invisible(res) } else { res } } #' Print a coverage object #' #' @param x the coverage object to be printed #' @param group whether to group coverage by filename or function #' @param by whether to count coverage by line or expression #' @param ... additional arguments ignored #' @return The coverage object (invisibly). #' @export print.coverage <- function(x, group = c("filename", "functions"), by = "line", ...) { if (length(x) == 0) { return() } group <- match.arg(group) type <- attr(x, "type") if (is.null(type) || type == "none") { type <- NULL } df <- tally_coverage(x, by = by) if (!NROW(df)) { return(invisible()) } percents <- tapply(df$value, df[[group]], FUN = function(x) (sum(x > 0) / length(x)) * 100) overall_percentage <- percent_coverage(df, by = by) msg <- cli::format_message(paste0( cli::style_bold( "{attr(x, 'package')$package} {to_title(type)} Coverage: " ), format_percentage(overall_percentage) )) message(msg) by_coverage <- percents[order(percents, names(percents))] for (i in seq_along(by_coverage)) { msg <- cli::format_message( paste0( cli::style_bold(names(by_coverage)[i], ": "), format_percentage(by_coverage[i]) ) ) message(msg) } invisible(x) } #' @export print.coverages <- function(x, ...) { for (i in seq_along(x)) { # Add a blank line between consecutive coverage items if (i != 1) { message() } print(x[[i]], ...) } invisible(x) } format_percentage <- function(x) { color <- if (x >= 90) cli::col_green else if (x >= 75) cli::col_yellow else cli::col_red color(sprintf("%02.2f%%", x)) } markers <- function(x, ...) UseMethod("markers") #' @export markers.coverages <- function(x, ...) { mrks <- unlist(lapply(unname(x), markers), recursive = FALSE) mrks <- mrks[order( vcapply(mrks, `[[`, "file"), viapply(mrks, `[[`, "line"), vcapply(mrks, `[[`, "message") )] # request source markers rstudioapi::callFun("sourceMarkers", name = "covr", markers = mrks, basePath = NULL, autoSelect = "first") invisible() } #' @export markers.coverage <- function(x, ...) { # generate the markers markers <- lapply(unname(x), function(xx) { filename <- get_source_filename(xx$srcref, full.names = TRUE) list( type = "warning", file = filename, line = xx$srcref[1], column = xx$srcref[2], message = sprintf("No %s Coverage!", to_title(attr(x, "type"))) ) }) } #' @export markers.data.frame <- function(x, ..., type = "test") { # nolint # generate the markers markers <- Map(function(filename, line, column) { list( type = "warning", file = filename, line = line, column = column %||% 1, message = sprintf("No %s Coverage!", to_title(type)) )}, x$filename, x$first_line %||% x$line, x$first_column %||% rep(list(NULL), NROW(x)), USE.NAMES = FALSE) } # Expand lines given as start and end ranges to enumerate each line expand_lines <- function(x) { repeats <- (x$last_line - x$first_line) + 1L lines <- unlist(Map(seq, x$first_line, x$last_line)) %||% integer() res <- x[rep(seq_len(NROW(x)), repeats), c("filename", "functions", "value")] res$line <- lines rownames(res) <- NULL res } ================================================ FILE: R/system.R ================================================ #' Run a system command and check if it succeeds. #' #' This function automatically quotes both the command and each #' argument so they are properly protected from shell expansion. #' @param cmd the command to run. #' @param args a vector of command arguments. #' @param env a named character vector of environment variables. Will be quoted #' @param quiet if `TRUE`, the command output will be echoed. #' @param echo if `TRUE`, the command to run will be echoed. #' @param ... additional arguments passed to [base::system()] #' @return `TRUE` if the command succeeds, an error will be thrown if the #' command fails. #' @keywords internal system_check <- function(cmd, args = character(), env = character(), quiet = FALSE, echo = FALSE, ...) { full <- paste(c(shQuote(cmd), lapply(args, shQuote)), collapse = " ") if (echo) { message(wrap_command(full), "\n") } status <- withr::with_envvar(env, system(full, intern = FALSE, ignore.stderr = quiet, ignore.stdout = quiet, ...) ) if (!identical(as.character(status), "0")) { stop("Command ", sQuote(full), " failed (", status, ")", call. = FALSE) } invisible(TRUE) } #' Run a system command and capture the output. #' #' This function automatically quotes both the command and each #' argument so they are properly protected from shell expansion. #' @inheritParams system_check #' @return command output if the command succeeds, an error will be thrown if #' the command fails. #' @keywords internal system_output <- function(cmd, args = character(), env = character(), quiet = FALSE, echo = FALSE, ...) { full <- paste(c(shQuote(cmd), lapply(args, shQuote)), collapse = " ") if (echo) { message(wrap_command(full), "\n") } result <- withCallingHandlers(withr::with_envvar(env, system(full, intern = TRUE, ignore.stderr = quiet, ...) ), warning = function(w) stop(w)) result } wrap_command <- function(x) { lines <- strwrap(x, getOption("width") - 2, exdent = 2) continue <- c(rep(" \\", length(lines) - 1), "") paste(lines, continue, collapse = "\n") } ================================================ FILE: R/trace_calls.R ================================================ #' trace each call with a srcref attribute #' #' This function calls itself recursively so it can properly traverse the AST. #' @param x the call #' @param parent_functions the functions which this call is a child of. #' @param parent_ref argument used to set the srcref of the current call during #' the recursion. #' @seealso #' @return a modified expression with count calls inserted before each previous #' call. #' @keywords internal trace_calls <- function (x, parent_functions = NULL, parent_ref = NULL) { # Construct the calls by hand to avoid a NOTE from R CMD check count <- function(key, val) { call("if", TRUE, call("{", as.call(list(call(":::", as.symbol("covr"), as.symbol("count")), key)), val ) ) } if (is.null(parent_functions)) { parent_functions <- deparse(substitute(x)) } recurse <- function(y) { lapply(y, trace_calls, parent_functions = parent_functions) } if (is.atomic(x) || is.name(x) || is.null(x)) { if (is.null(parent_ref)) { x } else { if (is_na(x) || is_brace(x)) { x } else { key <- new_counter(parent_ref, parent_functions) # nolint count(key, x) } } } else if (is.call(x)) { src_ref <- attr(x, "srcref") %||% impute_srcref(x, parent_ref) if ((identical(x[[1]], as.name("<-")) || identical(x[[1]], as.name("="))) && # nolint (is.call(x[[3]]) && identical(x[[3]][[1]], as.name("function")))) { parent_functions <- c(parent_functions, as.character(x[[2]])) } # do not try to trace curly curly if (identical(x[[1]], as.name("{")) && length(x) == 2 && is.call(x[[2]]) && identical(x[[2]][[1]], as.name("{"))) { as.call(x) } else if (!is.null(src_ref)) { as.call(Map(trace_calls, x, src_ref, MoreArgs = list(parent_functions = parent_functions))) } else if (!is.null(parent_ref)) { key <- new_counter(parent_ref, parent_functions) count(key, as.call(recurse(x))) } else { as.call(recurse(x)) } } else if (is.function(x)) { # We cannot trace primitive functions if (is.primitive(x)) { return(x) } fun_body <- body(x) if (!is.null(attr(x, "srcref")) && (is.symbol(fun_body) || !identical(fun_body[[1]], as.name("{")))) { src_ref <- attr(x, "srcref") key <- new_counter(src_ref, parent_functions) fun_body <- count(key, trace_calls(fun_body, parent_functions)) } else { fun_body <- trace_calls(fun_body, parent_functions) } new_formals <- trace_calls(formals(x), parent_functions) if (is.null(new_formals)) new_formals <- list() formals(x) <- new_formals body(x) <- fun_body x } else if (is.pairlist(x)) { as.pairlist(recurse(x)) } else if (is.expression(x)) { as.expression(recurse(x)) } else if (is.list(x)) { recurse(x) } else { message("Unknown language class: ", paste(class(x), collapse = "/")) x } } .counters <- new.env(parent = emptyenv()) .current_test <- new.env(parent = emptyenv()) #' initialize a new counter #' #' @param src_ref a [base::srcref()] #' @param parent_functions the functions that this srcref is contained in. #' @keywords internal new_counter <- function(src_ref, parent_functions) { key <- key(src_ref) .counters[[key]]$value <- 0 .counters[[key]]$srcref <- src_ref .counters[[key]]$functions <- parent_functions if (isTRUE(getOption("covr.record_tests", FALSE))) new_test_counter(key) key } #' increment a given counter #' #' @param key generated with [key()] #' @keywords internal count <- function(key) { .counters[[key]]$value <- .counters[[key]]$value + 1L if (isTRUE(.current_test$record)) count_test(key) } #' clear all previous counters #' #' @keywords internal clear_counters <- function() { rm(envir = .counters, list = ls(envir = .counters)) rm(envir = .current_test, list = ls(envir = .current_test)) .current_test$record <- isTRUE(getOption("covr.record_tests", FALSE)) } #' Generate a key for a call #' #' @param x the srcref of the call to create a key for #' @keywords internal key <- function(x) { paste(collapse = ":", c(get_source_filename(x), x)) } ================================================ FILE: R/trace_tests.R ================================================ #' Record Test Traces During Coverage Execution #' #' By setting `options(covr.record_tests = TRUE)`, the result of covr coverage #' collection functions will include additional data pertaining to the tests #' which are executed and an index of which tests, at what stack depth, trigger #' the execution of each trace. #' #' This functionality requires that the package code and tests are installed and #' sourced with the source. For more details, refer to R options, `keep.source`, #' `keep.source.pkgs` and `keep.parse.data.pkgs`. #' #' @section Additional fields: #' #' Within the `covr` result, you can explore this information in two places: #' #' \itemize{ #' \item `attr(,"tests")`: A list of call stacks, which results in target code #' execution. #' #' \item `$$tests`: For each srcref count in the coverage object, a #' `$tests` field is now included which contains a matrix with three columns, #' "test", "call", "depth" and "i" which specify the test number #' (corresponding to the index of the test in `attr(,"tests")`, the number #' of times the test expression was evaluated to produce the trace hit, the #' stack depth into the target code where the trace was executed, and the #' order of execution for each test. #' } #' #' @section Test traces: #' #' The content of test traces are dependent on the unit testing framework that #' is used by the target package. The behavior is contingent on the available #' information in the sources kept for the testing files. #' #' Test traces are extracted by the following criteria: #' #' 1. If any `srcref` files are are provided by a file within [covr]'s temporary #' library, all calls from those files are kept as a test trace. This will #' collect traces from tests run with common testing frameworks such as #' `testthat` and `RUnit`. #' 1. Otherwise, as a conservative fallback in situations where no source #' references are found, or when none are from within the temporary #' directory, the entire call stack is collected. #' #' These calls are subsequently subset for only those up until the call to #' [covr]'s internal `count` function, and will always include the last call in #' the call stack prior to a call to `count`. #' #' @examples #' fcode <- ' #' f <- function(x) { #' if (x) #' f(!x) #' else #' FALSE #' }' #' #' options(covr.record_tests = TRUE) #' cov <- code_coverage(fcode, "f(TRUE)") #' #' # extract executed test code for the first test #' tail(attr(cov, "tests")[[1L]], 1L) #' # [[1]] #' # f(TRUE) #' #' # extract test itemization per trace #' cov[[3]][c("srcref", "tests")] #' # $srcref #' # f(!x) #' # #' # $tests #' # test call depth i #' # [1,] 1 1 2 4 #' #' # reconstruct the code path of a test by ordering test traces by [,"i"] #' lapply(cov, `[[`, "tests") #' # $`source.Ref2326138c55:4:6:4:10:6:10:4:4` #' # test call depth i #' # [1,] 1 1 1 2 #' # #' # $`source.Ref2326138c55:3:8:3:8:8:8:3:3` #' # test call depth i #' # [1,] 1 1 1 1 #' # [2,] 1 1 2 3 #' # #' # $`source.Ref2326138c55:6:6:6:10:6:10:6:6` #' # test call depth i #' # [1,] 1 1 2 4 #' #' @name covr.record_tests NULL #' Append a test trace to a counter, updating global current test #' #' @param key generated with [key()] #' @keywords internal #' count_test <- function(key) { n_calls_into_covr <- 2L if (is_current_test_finished()) { update_current_test() } # ignore if .counter was not created with record_tests (nested coverage calls) if (is.null(.counters[[key]]$tests)) return() .current_test$i <- .current_test$i + 1L # expand infrequently as new tests are added, doubling matrix size as needed tests <- .counters[[key]]$tests n <- NROW(tests$tally) if (.counters[[key]]$value > n) { tests$tally <- rbind(tests$tally, matrix(NA_integer_, ncol = 4L, nrow = n)) } # ignore if .current_test was not initialized properly yet if (length(.current_test$index) == 0) { return() } # test number tests$.data[[1L]] <- .current_test$index # test call number (for test expressions that are called multiple times) tests$.data[[2L]] <- .current_test$call_count # call stack depth when trace is hit tests$.data[[3L]] <- sys.nframe() - length(.current_test$frames) - n_calls_into_covr + 1L # number of traces hit by the test so far tests$.data[[4L]] <- .current_test$i tests$.value <- .counters[[key]]$value with(tests, tally[.value, ] <- .data) } #' Initialize a new test counter for a coverage trace #' #' Initialize a test counter, a matrix used to tally tests, their stack depth #' and the execution order as the trace associated with \code{key} is hit. Each #' test trace is an environment, which allows assignment into a pre-allocated #' \code{tests} matrix with minimall reallocation. #' #' The \code{tests} matrix has columns \code{tests}, \code{depth} and \code{i}, #' corresponding to the test index (the index of the associated test in #' \code{.counters$tests}), the stack depth when the trace is evaluated and the #' number of traces that have been hit so far during test evaluation. #' #' @inheritParams count #' new_test_counter <- function(key) { .counters[[key]]$tests <- new.env(parent = baseenv()) .counters[[key]]$tests$.data <- vector("integer", 4L) .counters[[key]]$tests$.value <- integer(1L) .counters[[key]]$tests$tally <- matrix( NA_integer_, ncol = 4L, # initialize with 4 empty rows, only expanded once populated nrow = 4L, # cols: test index; call index; call stack depth of covr:::count; execution order index dimnames = list(c(), c("test", "call", "depth", "i")) ) } #' Update current test if unit test expression has progressed #' #' Updating a test logs some metadata regarding the current call stack, noteably #' trying to capture information about the call stack prior to the covr::count #' call being traced. #' #' There are a couple patterns of behavior, which try to accommodate a variety #' of testing suites: #' #' \itemize{ #' \item `testthat`: During execution of `testthat`'s `test_*` functions, #' files are sourced and the working directory is temporarily changed to the #' package `/tests` directory. Knowing this, calls in the call stack which #' are relative to this directory are extracted and recorded. #' \item `RUnit`: #' \item `custom`: Any other custom test suites may not have source kept with #' their execution, in which case the entire test call stack is kept. #' } #' #' checks to see if the current call stack has the same #' `srcref` (or expression, if no source is available) at the same frame prior #' to entering into a package where `covr:::count` is called. #' #' @keywords internal #' #' @importFrom utils getSrcDirectory #' update_current_test <- function() { syscalls <- sys.calls() syscall_first_count <- Position(is_covr_count_call, syscalls, nomatch = -1L) if (syscall_first_count < 2L) return() # skip if nothing before covr::count syscall_srcfile <- vcapply(syscalls, get_source_filename, normalize = TRUE) has_srcfile <- viapply(syscall_srcfile, length) > 0L srcfile_tmp <- logical(length(has_srcfile)) srcfile_tmp[has_srcfile] <- startsWith( syscall_srcfile[has_srcfile], normalizePath(.libPaths()[[1]], mustWork = FALSE) ) test_frames <- if (any(srcfile_tmp)) { # if possible, try to take any frames within the temporary library which(srcfile_tmp) } else { # otherwise, default to taking all syscalls up until covr:::count seq_len(syscall_first_count - 1L) } # add in outer frame, which may call intermediate .Internal or .External exec_frames <- unique(c(test_frames, syscall_first_count - 1L)) # build updated current test data, isolating relevant frames .current_test$trace <- syscalls[exec_frames] .current_test$i <- 0L .current_test$frames <- exec_frames .current_test$last_frame <- exec_frames[[Position( has_srcref, .current_test$trace, right = TRUE, nomatch = length(exec_frames) )]] # might be NULL if srcrefs aren't kept during building / sourcing .current_test$src_env <- sys.frame(which = .current_test$last_frame - 1L) .current_test$src_call <- syscalls[[.current_test$last_frame]] .current_test$srcref <- getSrcref(.current_test$src_call) .current_test$src <- .current_test$srcref %||% .current_test$src_call .current_test$key <- current_test_key() .current_test$index <- current_test_index() .current_test$call_count <- current_test_call_count() # NOTE: r-bugs 18348 # restrict test call lengths to avoid R Rds deserialization limit # https://bugs.r-project.org/show_bug.cgi?id=18348 max_call_len <- 1e4 call_lengths <- vapply(.current_test$trace, length, numeric(1L)) if (any(call_lengths > max_call_len)) { .current_test$trace <- lapply( .current_test$trace, truncate_call, limit = max_call_len ) warning("A large call was captured as part of a test and will be truncated.") } .counters$tests[[.current_test$index]] <- .current_test$trace attr(.counters$tests[[.current_test$index]], "call_count") <- .current_test$call_count names(.counters$tests)[[.current_test$index]] <- .current_test$key } #' Build key for the current test #' #' If the current test has a srcref, a unique character key is built from its #' srcref. Otherwise, an empty string is returned. #' #' @return A unique character string if the test call has a srcref, or an empty #' string otherwise. #' #' @keywords internal current_test_key <- function() { if (!inherits(.current_test$src, "srcref")) return("") file.path( dirname(get_source_filename(.current_test$src, normalize = TRUE)), key(.current_test$src) ) } #' Retrieve the index for the test in `.counters$tests` #' #' If the test was encountered before, the index will be the index of the test #' in the logged tests list. Otherwise, the index will be the next index beyond #' the length of the tests list. #' #' @return An integer index for the test call #' #' @keywords internal current_test_index <- function() { # check if test has already been encountered and reuse test index if (inherits(.current_test$src, "srcref")) { # when tests have srcrefs, we can quickly compare test keys match( .current_test$key, names(.counters$tests), nomatch = length(.counters$tests) + 1L ) } else { # otherwise we compare call stacks Position( function(t) identical(t[], .current_test$trace), # t[] to ignore attr .counters$tests, right = TRUE, nomatch = length(.counters$tests) + 1L ) } } #' Retrieve the number of times the test call was called #' #' A single test expression might be evaluated many times. Each time the same #' expression is called, the call count is incremented. #' #' @return An integer value representing the number of calls of the current #' call into the package from the testing suite. #' current_test_call_count <- function() { if (.current_test$index <= length(.counters$tests)) { attr(.counters$tests[[.current_test$index]], "call_count") + 1L } else { 1L } } #' Truncate call objects to limit the number of arguments #' #' A helper to circumvent R errors when deserializing large call objects from #' Rds. Trims the number of arguments in a call object, and replaces the last #' argument with a `` symbol. #' #' @param call_obj A (possibly large) \code{call} object #' @param limit A \code{call} length limit to impose #' @return The \code{call_obj} with arguments trimmed #' truncate_call <- function(call_obj, limit = 1e4) { if (length(call_obj) < limit) return(call_obj) call_obj <- head(call_obj, limit) call_obj[[length(call_obj)]] <- quote(``) call_obj } #' Returns TRUE if we've moved on from test reflected in .current_test #' #' Quickly dismiss the need to update the current test if we can. To test if #' we're still in the last test, check if the same srcref (or call, if source is #' not kept) exists at the last recorded calling frame prior to entering a covr #' trace. If this has changed, do a more comprehensive test to see if any of the #' test call stack has changed, in which case we are onto a new test. #' is_current_test_finished <- function() { is.null(.current_test$src) || .current_test$last_frame > sys.nframe() || !identical(.current_test$src_call, sys.call(which = .current_test$last_frame)) || !identical(.current_test$src_env, sys.frame(which = .current_test$last_frame - 1L)) } #' Is the source bound to the expression #' #' @param expr A language object which may have a `srcref` attribute #' @return A logical value indicating whether the language object has source #' has_srcref <- function(expr) { !is.null(getSrcref(expr)) } #' Is the expression a call to covr:::count #' #' @param expr A language object #' @return A logical value indicating whether the object is a call to #' `covr:::count`. #' is_covr_count_call <- function(expr) { count_call <- call(":::", as.symbol("covr"), as.symbol("count")) identical(expr[[1]], count_call) } ================================================ FILE: R/utils.R ================================================ `%||%` <- function(x, y) { if (!is.null(x)) { x } else { y } } compact <- function(x) { x[viapply(x, length) != 0] } trim <- function(x) { rex::re_substitutes(x, rex::rex(list(start, spaces) %or% list(spaces, end)), "", global = TRUE) } local_branch <- function(dir = ".") { withr::with_dir(dir, branch <- system_output("git", c("rev-parse", "--abbrev-ref", "HEAD")) ) trim(branch) } current_commit <- function(dir = ".") { withr::with_dir(dir, commit <- system_output("git", c("rev-parse", "HEAD")) ) trim(commit) } `[.coverage` <- function(x, i, ...) { attrs <- attributes(x) attrs$names <- attrs$names[i] res <- unclass(x) res <- res[i] attributes(res) <- attrs res } to_title <- function(x) { rex::re_substitutes(x, rex::rex(rex::regex("\\b"), capture(any)), "\\U\\1", global = TRUE) } srcfile_lines <- function(srcfile) { lines <- getSrcLines(srcfile, 1, Inf) matches <- rex::re_matches(lines, rex::rex(start, any_spaces, "#line", spaces, capture(name = "line_number", digit), spaces, quotes, capture(name = "filename", anything), quotes)) matches <- na.omit(matches) filename_match <- which(matches$filename == srcfile$filename) if (length(filename_match) == 1) { # rownames(matches) is the line number of lines start <- as.numeric(rownames(matches)[filename_match]) + 1 # If there is another directive we want to stop at that, otherwise stop at # the end end <- if (!is.na(rownames(matches)[filename_match + 1])) { as.numeric(rownames(matches)[filename_match + 1]) - 1 } else { length(lines) } # If there are no line directives for the file just use the entire file } else { start <- 1 end <- length(lines) } res <- lines[seq(start, end)] # Track blank or comment lines so they can be excluded from the result calculations, but only for R files if (rex::re_matches(srcfile$filename, rex::rex(".", one_of("r", "R"), end))) { attr(res, "blanks") <- which(rex::re_matches(res, rex::rex(start, any_spaces, maybe("#", anything), end))) } res } # Split lines into a list based on the line directives in the file. split_on_line_directives <- function(lines) { matches <- rex::re_matches(lines, rex::rex(start, any_spaces, "#line", spaces, capture(name = "line_number", digit), spaces, quotes, capture(name = "filename", anything), quotes)) directive_lines <- which(!is.na(matches$line_number)) if (!length(directive_lines)) { return(NULL) } file_starts <- directive_lines + 1 file_ends <- c(directive_lines[-1] - 1, length(lines)) res <- mapply( function(start, end) lines[start:end], file_starts, file_ends, SIMPLIFY = FALSE ) names(res) <- na.omit(matches$filename) res } traced_files <- function(x) { res <- list() filenames <- display_name(x) for (i in seq_along(x)) { src_file <- attr(x[[i]]$srcref, "srcfile") filename <- filenames[[i]] if (filename == "") next if (!is.null(res[[filename]])) next lines <- getSrcLines(src_file, 1, Inf) matches <- rex::re_matches(lines, rex::rex(start, any_spaces, "#line", spaces, capture(name = "line_number", digit), spaces, quotes, capture(name = "filename", anything), quotes)) matches <- na.omit(matches) filename_match <- which(matches$filename == src_file$filename) if (length(filename_match) == 1) { start <- as.numeric(rownames(matches)[filename_match]) + 1 end <- if (!is.na(rownames(matches)[filename_match + 1])) { as.numeric(rownames(matches)[filename_match + 1]) - 1 } else { length(lines) } } else { start <- 1 end <- length(lines) } src_file$file_lines <- lines[seq(start, end)] res[[filename]] <- src_file } res } per_line <- function(coverage) { df <- as.data.frame(coverage) # In rare cases the source reference such as generated code onload the source # reference will not exists, so the first_line will be NA df <- df[!is.na(df$first_line), ] files <- traced_files(coverage) # Lines with only spaces or only comments blank_lines <- lapply(files, function(file) { which(rex::re_matches(file$file_lines, rex::rex(start, any_spaces, maybe("#", anything), end))) }) # lines with only })], or an else block empty_lines <- lapply(files, function(file) { which(rex::re_matches(file$file_lines, "^(?:[[:punct:][:space:]]|else)*$")) }) file_lengths <- lapply(files, function(file) { length(file$file_lines) }) res <- lapply(file_lengths, function(x) { rep(NA_real_, length.out = x) }) # df is sorted by file and first line ascending, so we store the maximum # last_line seen to detect if the previous expression contains the current # expression. max_last <- 0 prev_filename <- "" for (i in seq_len(NROW(df))) { filename <- df[i, "filename"] for (line in seq(df[i, "first_line"], df[i, "last_line"])) { # if it is not a blank line or empty line if (!line %in% c(blank_lines[[filename]], empty_lines[[filename]])) { value <- df[i, "value"] # if current coverage is NA or last line < max last line if (is.na(res[[filename]][line]) || line < max_last || (line == max_last && res[[filename]][line] > value)) { res[[filename]][line] <- value } if (df[i, "filename"] != prev_filename) { prev_filename <- df[i, "filename"] max_last <- 0 } if (df[i, "last_line"] > max_last) { max_last <- df[i, "last_line"] } } } } structure( Map(function(file, coverage) { structure(list(file = file, coverage = coverage), class = "line_coverage") }, files, res), class = "line_coverages") } if (getRversion() < "3.2.0") { isNamespaceLoaded <- function(x) x %in% loadedNamespaces() } is_windows <- function() { .Platform$OS.type == "windows" } as_package <- function(path) { path <- normalize_path(path) if (!file.exists(path)) { stop("`path` is invalid: ", path, call. = FALSE) } root <- package_root(path) if (is.null(root)) { stop(sQuote(path), " does not contain a package!", call. = FALSE) } res <- read_description(file.path(root, "DESCRIPTION")) res$path <- root res } package_root <- function(path) { stopifnot(is.character(path)) has_description <- function(path) { file.exists(file.path(path, "DESCRIPTION")) } is_root <- function(path) { identical(path, dirname(path)) } path <- normalize_path(path) while (!is_root(path) && !has_description(path)) { path <- dirname(path) } if (is_root(path)) { NULL } else { path } } read_description <- function(path) { if (!length(path) || !file.exists(path)) { stop("DESCRIPTION file not found at ", sQuote(path), call. = FALSE) } res <- as.list(read.dcf(path)[1, ]) names(res) <- tolower(names(res)) res } clean_objects <- function(path) { files <- list.files(file.path(path, "src"), pattern = rex::rex(".", or("o", "sl", "so", "dylib", "a", "dll"), end), full.names = TRUE, recursive = TRUE) unlink(files) invisible(files) } # This is not actually an S3 method # From http://stackoverflow.com/a/34639237/2055486 setdiff.data.frame <- function(x, y, by = intersect(names(x), names(y)), by.x = by, by.y = by) { stopifnot( is.data.frame(x), is.data.frame(y), length(by.x) == length(by.y)) !do.call(paste, c(x[by.x], sep = "\30")) %in% do.call(paste, c(y[by.y], sep = "\30")) } `%==%` <- function(x, y) identical(x, y) `%!=%` <- function(x, y) !identical(x, y) is_na <- function(x) { !is.null(x) && !is.symbol(x) && is.na(x) } is_brace <- function(x) { is.symbol(x) && as.character(x) == "{" } modify_name <- function(expr, old, new) { replace <- function(e) if (is.name(e) && identical(e, as.name(old))) e <- as.name(new) else if (length(e) <= 1L) e else as.call(lapply(e, replace)) replace(expr) } # This is the fix for https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16659 match_arg <- base::match.arg body(match_arg) <- modify_name(body(match_arg), "all", "any") # from https://github.com/wch/r-source/blob/2065bd3c09813949e9fa7236d167f1b7ed5c8ba3/src/library/tools/R/check.R#L4134-L4137 env_path <- function(...) { paths <- c(...) paste(paths[nzchar(paths)], collapse = .Platform$path.sep) } normalize_path <- function(x) { path <- normalizePath(x, winslash = "/", mustWork = FALSE) # Strip any trailing slashes as they are invalid on windows sub("/*$", "", path) } temp_dir <- function() { normalize_path(tempdir()) } temp_file <- function(pattern = "file", tmpdir = temp_dir(), fileext = "") { normalize_path(tempfile(pattern, tmpdir, fileext)) } get_package_name <- function(x) { attr(x, "package")$package %||% "coverage" } get_source_filename <- function(x, full.names = FALSE, unique = TRUE, normalize = FALSE) { res <- getSrcFilename(x, full.names, unique) if (length(res) == 0) { return("") } if (normalize) { return(normalize_path(res)) } res } vcapply <- function(X, FUN, ...) vapply(X, FUN, ..., FUN.VALUE = character(1)) vdapply <- function(X, FUN, ...) vapply(X, FUN, ..., FUN.VALUE = numeric(1)) viapply <- function(X, FUN, ...) vapply(X, FUN, ..., FUN.VALUE = integer(1)) vlapply <- function(X, FUN, ...) vapply(X, FUN, ..., FUN.VALUE = logical(1)) trim_ws <- function(x) { x <- sub("^[ \t\r\n]+", "", x, perl = TRUE) sub("[ \t\r\n]+$", "", x, perl = TRUE) } ================================================ FILE: R/value.R ================================================ #' Retrieve the value from an object #' @export #' @param x object from which to retrieve the value #' @param ... additional arguments passed to methods value <- function(x, ...) UseMethod("value") #' @export value.coverage <- function(x, ...) { vdapply(x, value, ...) } #' @export value.expression_coverage <- function(x, ...) { x$value } #' @export value.expression_coverages <- value.coverage #' @export value.line_coverage <- value.expression_coverage #' @export value.line_coverages <- value.expression_coverages ================================================ FILE: R/vectorized.R ================================================ # simple function to test if a function is Vectorized is_vectorized <- function(x) { is.function(x) && exists("FUN", environment(x), mode = "function") && exists("vectorize.args", environment(x)) } ================================================ FILE: R/zzz.R ================================================ .onLoad <- function(libname, pkgname) { # nolint rex::register_shortcuts("covr") op <- options() op_covr <- list( covr.covrignore = Sys.getenv("COVR_COVRIGNORE", ".covrignore"), covr.gcov = Sys.which("gcov"), covr.gcov_args = NULL, covr.gcov_additional_paths = NULL, covr.exclude_pattern = rex::rex("#", any_spaces, "nocov"), covr.exclude_start = rex::rex("#", any_spaces, "nocov", any_spaces, "start"), covr.exclude_end = rex::rex("#", any_spaces, "nocov", any_spaces, "end"), covr.flags = c(CFLAGS = "-O0 --coverage", CXXFLAGS = "-O0 --coverage", CXX1XFLAGS = "-O0 --coverage", CXX11FLAGS = "-O0 --coverage", CXX14FLAGS = "-O0 --coverage", CXX17FLAGS = "-O0 --coverage", CXX20FLAGS = "-O0 --coverage", FFLAGS = "-O0 --coverage", FCFLAGS = "-O0 --coverage", FLIBS = "-lgcov", # LDFLAGS is ignored on windows and visa versa LDFLAGS = if (!is_windows()) "--coverage" else NULL, SHLIB_LIBADD = if (is_windows()) "--coverage" else NULL) ) # add icc code coverage settings icov_flag <- "-O0 -prof-gen=srcpos" op_covr <- c(op_covr, list( covr.icov = Sys.which("codecov"), covr.icov_args = NULL, covr.icov_prof = Sys.which("profmerge"), covr.icov_flags = c(CFLAGS = icov_flag, CXXFLAGS = icov_flag, CXX1XFLAGS = icov_flag, CXX11FLAGS = icov_flag, CXX14FLAGS = icov_flag, CXX17FLAGS = icov_flag, CXX20FLAGS = icov_flag, FFLAGS = icov_flag, FCFLAGS = icov_flag, # LDFLAGS is ignored on windows and visa versa LDFLAGS = icov_flag, SHLIB_LIBADD = icov_flag) )) toset <- !(names(op_covr) %in% names(op)) if (any(toset)) options(op_covr[toset]) invisible() } ================================================ FILE: README.md ================================================ # covr [![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) [![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) [![CRAN version](https://www.r-pkg.org/badges/version/covr)](https://cran.r-project.org/package=covr) Track test coverage for your R package and view reports locally or (optionally) upload the results to [codecov](https://about.codecov.io/) or [coveralls](https://coveralls.io/). # Installation # ```r install.packages("covr") # For devel version devtools::install_github("r-lib/covr") ``` The easiest way to setup covr on [Github Actions](https://github.com/r-lib/actions/tree/v2-branch/examples#test-coverage-workflow) is with [usethis](https://github.com/r-lib/usethis). ```r usethis::use_github_action("test-coverage") ``` # Usage # For local development a coverage report can be used to inspect coverage for each line in your package. *Note* requires the [DT](https://github.com/rstudio/DT) package to be installed. ```r library(covr) # If run with no arguments implicitly calls `package_coverage()` report() ``` covr also defines an [RStudio Addin](https://rstudio.github.io/rstudioaddins/), which runs `report()` on the active project. This can be used via the Addin menu or by binding the action to a [shortcut](https://rstudio.github.io/rstudioaddins/#keyboard-shorcuts), e.g. *Ctrl-Shift-C*. ## Interactively ## ```r # If run with the working directory within the package source. package_coverage() # or a package in another directory cov <- package_coverage("/dir/lintr") # view results as a data.frame as.data.frame(cov) # zero_coverage() shows only uncovered lines. # If run within RStudio, `zero_coverage()` will open a marker pane with the # uncovered lines. zero_coverage(cov) ``` # Exclusions # `covr` supports a few of different ways of excluding some or all of a file. ## .covrignore file ## A `.covrignore` file located in your package's root directory can be used to exclude files or directories. The lines in the `.covrignore` file are interpreted as a list of file globs to ignore. It uses the globbing rules in `Sys.glob()`. Any directories listed will ignore all the files in the directory. Alternative locations for the file can be set by the environment variable `COVR_COVRIGNORE` or the R option `covr.covrignore`. The `.covrignore` file should be added to your `.RBuildignore` file unless you want to distribute it with your package. If so it can be added to `inst/.covrignore` instead. ## Function Exclusions ## The `function_exclusions` argument to `package_coverage()` can be used to exclude functions by name. This argument takes a vector of regular expressions matching functions to exclude. ```r # exclude print functions package_coverage(function_exclusions = "print\\.") # exclude `.onLoad` function package_coverage(function_exclusions = "\\.onLoad") ``` ## Line Exclusions ## The `line_exclusions` argument to `package_coverage()` can be used to exclude some or all of a file. This argument takes a list of filenames or named ranges to exclude. ```r # exclude whole file of R/test.R package_coverage(line_exclusions = "R/test.R") # exclude lines 1 to 10 and 15 from R/test.R package_coverage(line_exclusions = list("R/test.R" = c(1:10, 15))) # exclude lines 1 to 10 from R/test.R, all of R/test2.R package_coverage(line_exclusions = list("R/test.R" = c(1, 10), "R/test2.R")) ``` ## Exclusion Comments ## In addition you can exclude lines from the coverage by putting special comments in your source code. This can be done per line. ```r f1 <- function(x) { x + 1 # nocov } ``` Or by specifying a range with a start and end. ```r f2 <- function(x) { # nocov start x + 2 } # nocov end ``` The patterns used can be specified by setting the global options `covr.exclude_pattern`, `covr.exclude_start`, `covr.exclude_end`. NB: 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`. # FAQ # ## Will covr work with testthat, RUnit, etc... ## Covr should be compatible with any testing package, it uses `tools::testInstalledPackage()` to run your packages tests. ## Will covr work with alternative compilers such as ICC ## Covr now supports Intel's `icc` compiler, thanks to work contributed by Qin Wang at Oracle. Covr is known to work with clang versions `3.5+` and gcc version `4.2+`. If the appropriate gcov version is not on your path you can set the appropriate location with the `covr.gcov` options. If you set this path to "" it will turn _off_ coverage of compiled code. ```r options(covr.gcov = "path/to/gcov") ``` ## How does covr work? ## `covr` tracks test coverage by modifying a package's code to add tracking calls to each call. The vignette [vignettes/how_it_works.Rmd](https://github.com/r-lib/covr/blob/master/vignettes/how_it_works.Rmd) contains a detailed explanation of the technique and the rationale behind it. You can view the vignette from within `R` using ```r vignette("how_it_works", package = "covr") ``` ## Why can't covr run during R CMD check ## Because covr modifies the package code it is possible there are unknown edge cases where that modification affects the output. In addition when tracking coverage for compiled code covr compiles the package without optimization, which _can_ modify behavior (usually due to package bugs which are masked with higher optimization levels). # Alternative Coverage Tools # - (no longer supported) - [**R-coverage**](https://web.archive.org/web/20160611114452/http://r2d2.quartzbio.com/posts/r-coverage-docker.html) (no longer supported) ## Code of Conduct Please 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. ================================================ FILE: SECURITY.md ================================================ # Security Policy ## Reporting a Vulnerability Send an email to james.f.hester@gmail.com to report a vulnerability. ================================================ FILE: _pkgdown.yml ================================================ url: https://covr.r-lib.org authors: "Jim Hester": href: https://www.jimhester.com/ destination: docs development: mode: auto template: bootstrap: 5 params: ganalytics: UA-115082821-1 ================================================ FILE: codecov.yml ================================================ comment: false coverage: status: project: default: target: auto threshold: 1% informational: true patch: default: target: auto threshold: 1% informational: true ================================================ FILE: cran-comments.md ================================================ This is a patch release to fix a change made in R-devel ## R CMD check results There were no NOTEs, ERRORs or WARNINGs. ================================================ FILE: docker_checker/Dockerfile ================================================ FROM rocker/hadleyverse MAINTAINER james.f.hester@gmail.com # install deps from current github master RUN Rscript -e 'devtools::install_github("jimhester/covr", dependencies = TRUE)' # remove installed covr to be sure not to conflict with current source version RUN Rscript -e 'remove.packages("covr")' # docker user setup RUN useradd -m docker && echo "docker:docker" | chpasswd && adduser docker sudo && \ chmod -R a+rwx /usr/local/lib/R/site-library USER docker WORKDIR /home/docker ================================================ FILE: inst/rstudio/addins.dcf ================================================ Name: Calculate package test coverage Description: Calculates the package test coverage and opens a report, using `covr::report()` Binding: addin_report Interactive: false ================================================ FILE: inst/www/report.css ================================================ table tr:hover td { font-weight:bold;text-decoration:none } table tr.covered td{ background-color:rgba(95,151,68,0.3) } table tr:hover.covered .num{ background-color:rgba(95,151,68,0.7) } table tr.missed td{ background-color:rgba(185,73,71,0.3) } table tr:hover.missed .num{ background-color:rgba(185,73,71,0.7) } table tr.missed:hover td{ -webkit-box-shadow:0 -2px 0 0 #b94947 inset; -moz-box-shadow:0 -2px 0 0 #b94947 inset; box-shadow:0 -2px 0 0 #b94947 inset } table tr.covered:hover td{ -webkit-box-shadow:0 -2px 0 0 #5f9744 inset; -moz-box-shadow:0 -2px 0 0 #5f9744 inset; box-shadow:0 -2px 0 0 #5f9744 inset } table tr.never td{ background-color:transparent } table tbody { border-style: solid; border: 1px solid rgba(0,0,0,0.1) } table .num { border-right: 1px solid rgba(0,0,0,0.1) } td.coverage em { opacity: 0.5; } table td.coverage { border-right: 1px solid rgba(0,0,0,0.1); font-weight: bold; text-align: center; } table.table-condensed pre { background-color: transparent; margin: 0; padding: 0; border: 0; font-size: 11px; } div#files td { padding: 0; padding-left: 5px; } div#files td.num { padding-right: 5px; } table.table-condensed { font-size: 11px; } ================================================ FILE: inst/www/shared/highlight.js/LICENSE ================================================ Copyright (c) 2006, Ivan Sagalaev All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of highlight.js nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ================================================ FILE: inst/www/shared/highlight.js/highlight.pack.js ================================================ 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]}]}}}(); ================================================ FILE: inst/www/shared/highlight.js/rstudio.css ================================================ code { line-height: 150%; } pre .operator, pre .paren { color: rgb(104, 118, 135) } pre .literal { color: rgb(88, 72, 246) } pre .number { color: rgb(0, 0, 205); } pre .comment { color: rgb(76, 136, 107); font-style: italic; } pre .keyword, pre .id { color: rgb(0, 0, 255); } pre .identifier { color: rgb(0, 0, 0); } pre .string, pre .attribute { color: rgb(3, 106, 7); } pre .doctype { color: rgb(104, 104, 92); } pre .tag, pre .title { color: rgb(4, 29, 140); } pre .value { color: rgb(13, 105, 18); } .language-xml .attribute { color: rgb(0, 0, 0); } .language-css .attribute { color: rgb(110, 124, 219); } .language-css .value { color: rgb(23, 149, 30); } .language-css .number, .language-css .hexcolor { color: rgb(7, 27, 201); } .language-css .function { color: rgb(61, 77, 113); } .language-css .tag { color: rgb(195, 13, 25); } .language-css .class { color: rgb(53, 132, 148); } .language-css .pseudo { color: rgb(13, 105, 18); } ================================================ FILE: man/as_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{as_coverage} \alias{as_coverage} \title{Convert a counters object to a coverage object} \usage{ as_coverage(counters = NULL, ...) } \arguments{ \item{counters}{An environment of covr trace results to convert to a coverage object. If \code{counters} is not provided, the \code{covr} namespace value \code{.counters} is used.} \item{...}{Additional attributes to include with the coverage object.} } \description{ Convert a counters object to a coverage object } ================================================ FILE: man/as_coverage_with_tests.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{as_coverage_with_tests} \alias{as_coverage_with_tests} \title{Clean and restructure counter tests for a coverage object} \usage{ as_coverage_with_tests(counters) } \arguments{ \item{counters}{An environment of covr trace results to convert to a coverage object. If \code{counters} is not provided, the \code{covr} namespace value \code{.counters} is used.} } \description{ For tests produced with \code{options(covr.record_tests)}, prune any unused records in the $tests$tally matrices of each trace and get rid of the wrapping $tests environment (reassigning with value of $tests$tally) } ================================================ FILE: man/azure.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/azure.R \name{azure} \alias{azure} \title{Run covr on a package and output the result so it is available on Azure Pipelines} \usage{ azure( ..., coverage = package_coverage(..., quiet = quiet), filename = "coverage.xml", quiet = TRUE ) } \arguments{ \item{...}{arguments passed to \code{\link[=package_coverage]{package_coverage()}}} \item{coverage}{an existing coverage object to submit, if \code{NULL}, \code{\link[=package_coverage]{package_coverage()}} will be called with the arguments from \code{...}} \item{filename}{the name of the Cobertura XML file} \item{quiet}{if \code{FALSE}, print the coverage before submission.} } \description{ Run covr on a package and output the result so it is available on Azure Pipelines } ================================================ FILE: man/clear_counters.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_calls.R \name{clear_counters} \alias{clear_counters} \title{clear all previous counters} \usage{ clear_counters() } \description{ clear all previous counters } \keyword{internal} ================================================ FILE: man/code_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{code_coverage} \alias{code_coverage} \title{Calculate coverage of code directly} \usage{ code_coverage( source_code, test_code, line_exclusions = NULL, function_exclusions = NULL, ... ) } \arguments{ \item{source_code}{A character vector of source code} \item{test_code}{A character vector of test code} \item{line_exclusions}{a named list of files with the lines to exclude from each file.} \item{function_exclusions}{a vector of regular expressions matching function names to exclude. Example \verb{print\\\\\\.} to match print methods.} \item{...}{Additional arguments passed to \code{\link[=file_coverage]{file_coverage()}}} } \description{ This function is useful for testing, and is a thin wrapper around \code{\link[=file_coverage]{file_coverage()}} because parseData is not populated properly unless the functions are defined in a file. } \examples{ source <- "add <- function(x, y) { x + y }" test <- "add(1, 2) == 3" code_coverage(source, test) } ================================================ FILE: man/codecov.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/codecov.R \name{codecov} \alias{codecov} \title{Run covr on a package and upload the result to codecov.io} \usage{ codecov( ..., coverage = NULL, base_url = "https://codecov.io", token = NULL, commit = NULL, branch = NULL, pr = NULL, flags = NULL, quiet = TRUE ) } \arguments{ \item{...}{arguments passed to \code{\link[=package_coverage]{package_coverage()}}} \item{coverage}{an existing coverage object to submit, if \code{NULL}, \code{\link[=package_coverage]{package_coverage()}} will be called with the arguments from \code{...}} \item{base_url}{Codecov url (change for Enterprise)} \item{token}{a codecov upload token, if \code{NULL} then following external sources will be checked in this order: \enumerate{ \item the environment variable \sQuote{CODECOV_TOKEN}. If it is empty, then \item package will look at directory of the package for a file \code{codecov.yml}. File must have \code{codecov} section where field \code{token} is set to a token that will be used. }} \item{commit}{explicitly set the commit this coverage result object corresponds to. Is looked up from the service or locally if it is \code{NULL}.} \item{branch}{explicitly set the branch this coverage result object corresponds to, this is looked up from the service or locally if it is \code{NULL}.} \item{pr}{explicitly set the pr this coverage result object corresponds to, this is looked up from the service if it is \code{NULL}.} \item{flags}{A flag to use for this coverage upload see \url{https://docs.codecov.com/docs/flags} for details.} \item{quiet}{if \code{FALSE}, print the coverage before submission.} } \description{ Run covr on a package and upload the result to codecov.io } \examples{ \dontrun{ codecov(path = "test") } } ================================================ FILE: man/count.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_calls.R \name{count} \alias{count} \title{increment a given counter} \usage{ count(key) } \arguments{ \item{key}{generated with \code{\link[=key]{key()}}} } \description{ increment a given counter } \keyword{internal} ================================================ FILE: man/count_test.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{count_test} \alias{count_test} \title{Append a test trace to a counter, updating global current test} \usage{ count_test(key) } \arguments{ \item{key}{generated with \code{\link[=key]{key()}}} } \description{ Append a test trace to a counter, updating global current test } \keyword{internal} ================================================ FILE: man/coverage_to_list.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{coverage_to_list} \alias{coverage_to_list} \title{Convert a coverage dataset to a list} \usage{ coverage_to_list(x = package_coverage()) } \arguments{ \item{x}{a coverage dataset, defaults to running \code{package_coverage()}.} } \value{ A list containing coverage result for each individual file and the whole package } \description{ Convert a coverage dataset to a list } ================================================ FILE: man/coveralls.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/coveralls.R \name{coveralls} \alias{coveralls} \title{Run covr on a package and upload the result to coveralls} \usage{ coveralls( ..., coverage = NULL, repo_token = Sys.getenv("COVERALLS_TOKEN"), service_name = Sys.getenv("CI_NAME", "travis-ci"), quiet = TRUE ) } \arguments{ \item{...}{arguments passed to \code{\link[=package_coverage]{package_coverage()}}} \item{coverage}{an existing coverage object to submit, if \code{NULL}, \code{\link[=package_coverage]{package_coverage()}} will be called with the arguments from \code{...}} \item{repo_token}{The secret repo token for your repository, found at the bottom of your repository's page on Coveralls. This is useful if your job is running on a service Coveralls doesn't support out-of-the-box. If set to NULL, it is assumed that the job is running on travis-ci} \item{service_name}{the CI service to use, if environment variable \sQuote{CI_NAME} is set that is used, otherwise \sQuote{travis-ci} is used.} \item{quiet}{if \code{FALSE}, print the coverage before submission.} } \description{ Run covr on a package and upload the result to coveralls } ================================================ FILE: man/covr-package.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \docType{package} \name{covr-package} \alias{covr} \alias{covr-package} \title{covr: Test coverage for packages} \description{ covr tracks and reports code coverage for your package and (optionally) upload the results to a coverage service like 'Codecov' \url{https://about.codecov.io} or 'Coveralls' \url{https://coveralls.io}. Code coverage is a measure of the amount of code being exercised by a set of tests. It is an indirect measure of test quality and completeness. This package is compatible with any testing methodology or framework and tracks coverage of both R code and compiled C/C++/FORTRAN code. } \details{ A coverage report can be used to inspect coverage for each line in your package. Using \code{report()} requires the additional dependencies \code{DT} and \code{htmltools}. \if{html}{\out{
}}\preformatted{# If run with no arguments `report()` implicitly calls `package_coverage()` report() }\if{html}{\out{
}} } \section{Package options}{ \code{covr} uses the following \code{\link[=options]{options()}} to configure behaviour: \itemize{ \item \code{covr.covrignore}: A filename to use as an ignore file, listing glob-style wildcarded paths of files to ignore for coverage calculations. Defaults to the value of environment variable \code{COVR_COVRIGNORE}, or \code{".covrignore"} if the neither the option nor the environment variable are set. \item \code{covr.exclude_end}: Used along with \code{covr.exclude_start}, an optional regular expression which ends a line-exclusion region. For more details, see \code{?exclusions}. \item \code{covr.exclude_pattern}: An optional line-exclusion pattern. Lines which match the pattern will be excluded from coverage. For more details, see \code{?exclusions}. \item \code{covr.exclude_start}: Used along with \code{covr.exclude_end}, an optional regular expression which starts a line-exclusion region. For more details, see \code{?exclusions}. \item \code{covr.filter_non_package}: If \code{TRUE} (the default behavior), coverage of files outside the target package are filtered from coverage output. \item \code{covr.fix_parallel_mcexit}: \item \code{covr.flags}: \item \code{covr.gcov}: If the appropriate gcov version is not on your path you can use this option to set the appropriate location. If set to "" it will turn off coverage of compiled code. \item \code{covr.gcov_additional_paths}: \item \code{covr.gcov_args}: \item \code{covr.icov}: \item \code{covr.icov_args}: \item \code{covr.icov_flags}: \item \code{covr.icov_prof}: \item \code{covr.rstudio_source_markers}: A logical value. If \code{TRUE} (the default behavior), source markers are displayed within the RStudio IDE when using \code{zero_coverage}. \item \code{covr.record_tests}: If \code{TRUE} (default \code{NULL}), record a listing of top level test expressions and associate tests with \code{covr} traces evaluated during the test's execution. For more details, see \code{?covr.record_tests}. \item \code{covr.showCfunctions}: } } \seealso{ Useful links: \itemize{ \item \url{https://covr.r-lib.org} \item \url{https://github.com/r-lib/covr} \item Report bugs at \url{https://github.com/r-lib/covr/issues} } } \author{ \strong{Maintainer}: Jim Hester \email{james.f.hester@gmail.com} Other contributors: \itemize{ \item Willem Ligtenberg [contributor] \item Kirill Müller [contributor] \item Henrik Bengtsson [contributor] \item Steve Peak [contributor] \item Kirill Sevastyanenko [contributor] \item Jon Clayden [contributor] \item Robert Flight [contributor] \item Eric Brown [contributor] \item Brodie Gaslam [contributor] \item Will Beasley [contributor] \item Robert Krzyzanowski [contributor] \item Markus Wamser [contributor] \item Karl Forner [contributor] \item Gergely Daróczi [contributor] \item Jouni Helske [contributor] \item Kun Ren [contributor] \item Jeroen Ooms [contributor] \item Ken Williams [contributor] \item Chris Campbell [contributor] \item David Hugh-Jones [contributor] \item Qin Wang [contributor] \item Doug Kelkhoff [contributor] \item Ivan Sagalaev (highlight.js library) [contributor, copyright holder] \item Mark Otto (Bootstrap library) [contributor] \item Jacob Thornton (Bootstrap library) [contributor] \item Bootstrap contributors (Bootstrap library) [contributor] \item Twitter, Inc (Bootstrap library) [copyright holder] } } ================================================ FILE: man/covr.record_tests.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{covr.record_tests} \alias{covr.record_tests} \title{Record Test Traces During Coverage Execution} \description{ By setting \code{options(covr.record_tests = TRUE)}, the result of covr coverage collection functions will include additional data pertaining to the tests which are executed and an index of which tests, at what stack depth, trigger the execution of each trace. } \details{ This functionality requires that the package code and tests are installed and sourced with the source. For more details, refer to R options, \code{keep.source}, \code{keep.source.pkgs} and \code{keep.parse.data.pkgs}. } \section{Additional fields}{ Within the \code{covr} result, you can explore this information in two places: \itemize{ \item \code{attr(,"tests")}: A list of call stacks, which results in target code execution. \item \verb{$$tests}: For each srcref count in the coverage object, a \verb{$tests} field is now included which contains a matrix with three columns, "test", "call", "depth" and "i" which specify the test number (corresponding to the index of the test in \code{attr(,"tests")}, the number of times the test expression was evaluated to produce the trace hit, the stack depth into the target code where the trace was executed, and the order of execution for each test. } } \section{Test traces}{ The content of test traces are dependent on the unit testing framework that is used by the target package. The behavior is contingent on the available information in the sources kept for the testing files. Test traces are extracted by the following criteria: \enumerate{ \item If any \code{srcref} files are are provided by a file within \link{covr}'s temporary library, all calls from those files are kept as a test trace. This will collect traces from tests run with common testing frameworks such as \code{testthat} and \code{RUnit}. \item Otherwise, as a conservative fallback in situations where no source references are found, or when none are from within the temporary directory, the entire call stack is collected. } These calls are subsequently subset for only those up until the call to \link{covr}'s internal \code{count} function, and will always include the last call in the call stack prior to a call to \code{count}. } \examples{ fcode <- ' f <- function(x) { if (x) f(!x) else FALSE }' options(covr.record_tests = TRUE) cov <- code_coverage(fcode, "f(TRUE)") # extract executed test code for the first test tail(attr(cov, "tests")[[1L]], 1L) # [[1]] # f(TRUE) # extract test itemization per trace cov[[3]][c("srcref", "tests")] # $srcref # f(!x) # # $tests # test call depth i # [1,] 1 1 2 4 # reconstruct the code path of a test by ordering test traces by [,"i"] lapply(cov, `[[`, "tests") # $`source.Ref2326138c55:4:6:4:10:6:10:4:4` # test call depth i # [1,] 1 1 1 2 # # $`source.Ref2326138c55:3:8:3:8:8:8:3:3` # test call depth i # [1,] 1 1 1 1 # [2,] 1 1 2 3 # # $`source.Ref2326138c55:6:6:6:10:6:10:6:6` # test call depth i # [1,] 1 1 2 4 } ================================================ FILE: man/current_test_call_count.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{current_test_call_count} \alias{current_test_call_count} \title{Retrieve the number of times the test call was called} \usage{ current_test_call_count() } \value{ An integer value representing the number of calls of the current call into the package from the testing suite. } \description{ A single test expression might be evaluated many times. Each time the same expression is called, the call count is incremented. } ================================================ FILE: man/current_test_index.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{current_test_index} \alias{current_test_index} \title{Retrieve the index for the test in \code{.counters$tests}} \usage{ current_test_index() } \value{ An integer index for the test call } \description{ If the test was encountered before, the index will be the index of the test in the logged tests list. Otherwise, the index will be the next index beyond the length of the tests list. } \keyword{internal} ================================================ FILE: man/current_test_key.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{current_test_key} \alias{current_test_key} \title{Build key for the current test} \usage{ current_test_key() } \value{ A unique character string if the test call has a srcref, or an empty string otherwise. } \description{ If the current test has a srcref, a unique character key is built from its srcref. Otherwise, an empty string is returned. } \keyword{internal} ================================================ FILE: man/display_name.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/display_name.R \name{display_name} \alias{display_name} \title{Retrieve the path name (filename) for each coverage object} \usage{ display_name(x) } \arguments{ \item{x}{A coverage object} } \description{ Retrieve the path name (filename) for each coverage object } \keyword{internal} ================================================ FILE: man/environment_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{environment_coverage} \alias{environment_coverage} \title{Calculate coverage of an environment} \usage{ environment_coverage( env = parent.frame(), test_files, line_exclusions = NULL, function_exclusions = NULL ) } \arguments{ \item{env}{The environment to be instrumented.} \item{test_files}{Character vector of test files with code to test the functions} \item{line_exclusions}{a named list of files with the lines to exclude from each file.} \item{function_exclusions}{a vector of regular expressions matching function names to exclude. Example \verb{print\\\\\\.} to match print methods.} } \description{ Calculate coverage of an environment } ================================================ FILE: man/exclusions.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/exclusions.R \name{exclusions} \alias{exclusions} \title{Exclusions} \description{ covr supports a couple of different ways of excluding some or all of a file. } \section{Line Exclusions}{ The \code{line_exclusions} argument to \code{package_coverage()} can be used to exclude some or all of a file. This argument takes a list of filenames or named ranges to exclude. } \section{Function Exclusions}{ Alternatively \code{function_exclusions} can be used to exclude R functions based on regular expression(s). For example \verb{print\\\\\\.*} can be used to exclude all the print methods defined in a package from coverage. } \section{Exclusion Comments}{ In addition you can exclude lines from the coverage by putting special comments in your source code. This can be done per line or by specifying a range. The patterns used can be specified by the \code{exclude_pattern}, \code{exclude_start}, \code{exclude_end} arguments to \code{package_coverage()} or by setting the global options \code{covr.exclude_pattern}, \code{covr.exclude_start}, \code{covr.exclude_end}. } \examples{ \dontrun{ # exclude whole file of R/test.R package_coverage(exclusions = "R/test.R") # exclude lines 1 to 10 and 15 from R/test.R package_coverage(line_exclusions = list("R/test.R" = c(1:10, 15))) # exclude lines 1 to 10 from R/test.R, all of R/test2.R package_coverage(line_exclusions = list("R/test.R" = 1:10, "R/test2.R")) # exclude all print and format methods from the package. package_coverage(function_exclusions = c("print\\\\.", "format\\\\.")) # single line exclusions f1 <- function(x) { x + 1 # nocov } # ranged exclusions f2 <- function(x) { # nocov start x + 2 } # nocov end } } ================================================ FILE: man/file_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{file_coverage} \alias{file_coverage} \title{Calculate test coverage for sets of files} \usage{ file_coverage( source_files, test_files, line_exclusions = NULL, function_exclusions = NULL, parent_env = parent.frame() ) } \arguments{ \item{source_files}{Character vector of source files with function definitions to measure coverage} \item{test_files}{Character vector of test files with code to test the functions} \item{line_exclusions}{a named list of files with the lines to exclude from each file.} \item{function_exclusions}{a vector of regular expressions matching function names to exclude. Example \verb{print\\\\\\.} to match print methods.} \item{parent_env}{The parent environment to use when sourcing the files.} } \description{ The files in \code{source_files} are first sourced into a new environment to define functions to be checked. Then they are instrumented to track coverage and the files in \code{test_files} are sourced. } \examples{ # For the purpose of this example, save code containing code and tests to files cat("add <- function(x, y) { x + y }", file="add.R") cat("add(1, 2) == 3", file="add_test.R") # Use file_coverage() to calculate test coverage file_coverage(source_files = "add.R", test_files = "add_test.R") # cleanup file.remove(c("add.R", "add_test.R")) } ================================================ FILE: man/file_report.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/report.R \name{file_report} \alias{file_report} \title{A coverage report for a specific file} \usage{ file_report( x = package_coverage(), file = NULL, out_file = file.path(tempdir(), paste0(get_package_name(x), "-file-report.html")), browse = interactive() ) } \arguments{ \item{x}{a coverage dataset, defaults to running \code{package_coverage()}.} \item{file}{The file to report on, if \code{NULL}, use the first file in the coverage output.} \item{out_file}{The output file} \item{browse}{whether to open a browser to view the report.} } \description{ A coverage report for a specific file } ================================================ FILE: man/function_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{function_coverage} \alias{function_coverage} \title{Calculate test coverage for a specific function.} \usage{ function_coverage(fun, code = NULL, env = NULL, enc = parent.frame()) } \arguments{ \item{fun}{name of the function.} \item{code}{expressions to run.} \item{env}{environment the function is defined in.} \item{enc}{the enclosing environment which to run the expressions.} } \description{ Calculate test coverage for a specific function. } \examples{ add <- function(x, y) { x + y } function_coverage(fun = add, code = NULL) # 0\% coverage function_coverage(fun = add, code = add(1, 2) == 3) # 100\% coverage } ================================================ FILE: man/gitlab.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gitlab.R \name{gitlab} \alias{gitlab} \title{Run covr on package and create report for GitLab} \usage{ gitlab(..., coverage = NULL, file = "public/coverage.html", quiet = TRUE) } \arguments{ \item{...}{arguments passed to \code{\link[=package_coverage]{package_coverage()}}} \item{coverage}{an existing coverage object to submit, if \code{NULL}, \code{\link[=package_coverage]{package_coverage()}} will be called with the arguments from \code{...}} \item{file}{The report filename.} \item{quiet}{if \code{FALSE}, print the coverage before submission.} } \description{ Utilize internal GitLab static pages to publish package coverage. Creates local covr report in a package subdirectory. Uses the \href{https://docs.gitlab.com/user/project/pages/}{pages} GitLab job to publish the report. } ================================================ FILE: man/has_srcref.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{has_srcref} \alias{has_srcref} \title{Is the source bound to the expression} \usage{ has_srcref(expr) } \arguments{ \item{expr}{A language object which may have a \code{srcref} attribute} } \value{ A logical value indicating whether the language object has source } \description{ Is the source bound to the expression } ================================================ FILE: man/in_covr.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{in_covr} \alias{in_covr} \title{Determine if code is being run in covr} \usage{ in_covr() } \description{ covr functions set the environment variable \code{R_COVR} when they are running. \code{\link[=in_covr]{in_covr()}} returns \code{TRUE} if this environment variable is set and \code{FALSE} otherwise. } \examples{ if (require(testthat)) { testthat::skip_if(in_covr()) } } ================================================ FILE: man/is_covr_count_call.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{is_covr_count_call} \alias{is_covr_count_call} \title{Is the expression a call to covr:::count} \usage{ is_covr_count_call(expr) } \arguments{ \item{expr}{A language object} } \value{ A logical value indicating whether the object is a call to \code{covr:::count}. } \description{ Is the expression a call to covr:::count } ================================================ FILE: man/is_current_test_finished.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{is_current_test_finished} \alias{is_current_test_finished} \title{Returns TRUE if we've moved on from test reflected in .current_test} \usage{ is_current_test_finished() } \description{ Quickly dismiss the need to update the current test if we can. To test if we're still in the last test, check if the same srcref (or call, if source is not kept) exists at the last recorded calling frame prior to entering a covr trace. If this has changed, do a more comprehensive test to see if any of the test call stack has changed, in which case we are onto a new test. } ================================================ FILE: man/key.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_calls.R \name{key} \alias{key} \title{Generate a key for a call} \usage{ key(x) } \arguments{ \item{x}{the srcref of the call to create a key for} } \description{ Generate a key for a call } \keyword{internal} ================================================ FILE: man/new_counter.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_calls.R \name{new_counter} \alias{new_counter} \title{initialize a new counter} \usage{ new_counter(src_ref, parent_functions) } \arguments{ \item{src_ref}{a \code{\link[base:srcfile]{base::srcref()}}} \item{parent_functions}{the functions that this srcref is contained in.} } \description{ initialize a new counter } \keyword{internal} ================================================ FILE: man/new_test_counter.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{new_test_counter} \alias{new_test_counter} \title{Initialize a new test counter for a coverage trace} \usage{ new_test_counter(key) } \arguments{ \item{key}{generated with \code{\link[=key]{key()}}} } \description{ Initialize a test counter, a matrix used to tally tests, their stack depth and the execution order as the trace associated with \code{key} is hit. Each test trace is an environment, which allows assignment into a pre-allocated \code{tests} matrix with minimall reallocation. } \details{ The \code{tests} matrix has columns \code{tests}, \code{depth} and \code{i}, corresponding to the test index (the index of the associated test in \code{.counters$tests}), the stack depth when the trace is evaluated and the number of traces that have been hit so far during test evaluation. } ================================================ FILE: man/package_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/covr.R \name{package_coverage} \alias{package_coverage} \title{Calculate test coverage for a package} \usage{ package_coverage( path = ".", type = c("tests", "vignettes", "examples", "all", "none"), combine_types = TRUE, relative_path = TRUE, quiet = TRUE, clean = TRUE, line_exclusions = NULL, function_exclusions = NULL, code = character(), install_path = temp_file("R_LIBS"), ..., exclusions, pre_clean = TRUE ) } \arguments{ \item{path}{file path to the package.} \item{type}{run the package \sQuote{tests}, \sQuote{vignettes}, \sQuote{examples}, \sQuote{all}, or \sQuote{none}. The default is \sQuote{tests}.} \item{combine_types}{If \code{TRUE} (the default) the coverage for all types is simply summed into one coverage object. If \code{FALSE} separate objects are used for each type of coverage.} \item{relative_path}{whether to output the paths as relative or absolute paths. If a string, it is interpreted as a root path and all paths will be relative to that root.} \item{quiet}{whether to load and compile the package quietly, useful for debugging errors.} \item{clean}{whether to clean temporary output files after running, mainly useful for debugging errors.} \item{line_exclusions}{a named list of files with the lines to exclude from each file.} \item{function_exclusions}{a vector of regular expressions matching function names to exclude. Example \verb{print\\\\\\.} to match print methods.} \item{code}{A character vector of additional test code to run.} \item{install_path}{The path the instrumented package will be installed to and tests run in. By default it is a path in the R sessions temporary directory. It can sometimes be useful to set this (along with \code{clean = FALSE}) to help debug test failures.} \item{...}{Additional arguments passed to \code{\link[tools:testInstalledPackage]{tools::testInstalledPackage()}}.} \item{exclusions}{\sQuote{Deprecated}, please use \sQuote{line_exclusions} instead.} \item{pre_clean}{whether to delete all objects present in the src directory before recompiling} } \description{ This function calculates the test coverage for a development package on the \code{path}. By default it runs only the package tests, but it can also run vignette and example code. } \details{ This function uses \code{\link[tools:testInstalledPackage]{tools::testInstalledPackage()}} to run the code, if you would like to test your package in another way you can set \code{type = "none"} and pass the code to run as a character vector to the \code{code} parameter. #ifdef unix Parallelized code using \pkg{parallel}'s \code{\link[=mcparallel]{mcparallel()}} needs to use a patched \code{parallel:::mcexit}. This is done automatically if the package depends on \pkg{parallel}, but can also be explicitly set using the environment variable \code{COVR_FIX_PARALLEL_MCEXIT} or the global option \code{covr.fix_parallel_mcexit}. #endif } \seealso{ \code{\link[=exclusions]{exclusions()}} For details on excluding parts of the package from the coverage calculations. } ================================================ FILE: man/percent_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary_functions.R \name{percent_coverage} \alias{percent_coverage} \title{Provide percent coverage of package} \usage{ percent_coverage(x, ...) } \arguments{ \item{x}{the coverage object returned from \code{\link[=package_coverage]{package_coverage()}}} \item{...}{additional arguments passed to \code{\link[=tally_coverage]{tally_coverage()}}} } \value{ The total percentage as a \code{numeric(1)}. } \description{ Calculate the total percent coverage from a coverage result object. } ================================================ FILE: man/print.coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary_functions.R \name{print.coverage} \alias{print.coverage} \title{Print a coverage object} \usage{ \method{print}{coverage}(x, group = c("filename", "functions"), by = "line", ...) } \arguments{ \item{x}{the coverage object to be printed} \item{group}{whether to group coverage by filename or function} \item{by}{whether to count coverage by line or expression} \item{...}{additional arguments ignored} } \value{ The coverage object (invisibly). } \description{ Print a coverage object } ================================================ FILE: man/report.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/report.R \name{report} \alias{report} \title{Display covr results using a standalone report} \usage{ report( x = package_coverage(), file = file.path(tempdir(), paste0(get_package_name(x), "-report.html")), browse = interactive() ) } \arguments{ \item{x}{a coverage dataset, defaults to running \code{package_coverage()}.} \item{file}{The report filename.} \item{browse}{whether to open a browser to view the report.} } \description{ Display covr results using a standalone report } \examples{ \dontrun{ x <- package_coverage() report(x) } } ================================================ FILE: man/system_check.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/system.R \name{system_check} \alias{system_check} \title{Run a system command and check if it succeeds.} \usage{ system_check( cmd, args = character(), env = character(), quiet = FALSE, echo = FALSE, ... ) } \arguments{ \item{cmd}{the command to run.} \item{args}{a vector of command arguments.} \item{env}{a named character vector of environment variables. Will be quoted} \item{quiet}{if \code{TRUE}, the command output will be echoed.} \item{echo}{if \code{TRUE}, the command to run will be echoed.} \item{...}{additional arguments passed to \code{\link[base:system]{base::system()}}} } \value{ \code{TRUE} if the command succeeds, an error will be thrown if the command fails. } \description{ This function automatically quotes both the command and each argument so they are properly protected from shell expansion. } \keyword{internal} ================================================ FILE: man/system_output.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/system.R \name{system_output} \alias{system_output} \title{Run a system command and capture the output.} \usage{ system_output( cmd, args = character(), env = character(), quiet = FALSE, echo = FALSE, ... ) } \arguments{ \item{cmd}{the command to run.} \item{args}{a vector of command arguments.} \item{env}{a named character vector of environment variables. Will be quoted} \item{quiet}{if \code{TRUE}, the command output will be echoed.} \item{echo}{if \code{TRUE}, the command to run will be echoed.} \item{...}{additional arguments passed to \code{\link[base:system]{base::system()}}} } \value{ command output if the command succeeds, an error will be thrown if the command fails. } \description{ This function automatically quotes both the command and each argument so they are properly protected from shell expansion. } \keyword{internal} ================================================ FILE: man/tally_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary_functions.R \name{tally_coverage} \alias{tally_coverage} \title{Tally coverage by line or expression} \usage{ tally_coverage(x, by = c("line", "expression")) } \arguments{ \item{x}{the coverage object returned from \code{\link[=package_coverage]{package_coverage()}}} \item{by}{whether to tally coverage by line or expression} } \value{ a \code{data.frame} of coverage tallied by line or expression. } \description{ Tally coverage by line or expression } ================================================ FILE: man/to_cobertura.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cobertura.R \name{to_cobertura} \alias{to_cobertura} \title{Create a Cobertura XML file} \usage{ to_cobertura(cov, filename = "cobertura.xml") } \arguments{ \item{cov}{the coverage object returned from \code{\link[=package_coverage]{package_coverage()}}} \item{filename}{the name of the Cobertura XML file} } \description{ Create a cobertura-compliant XML report following \href{https://github.com/cobertura/cobertura/blob/master/cobertura/src/site/htdocs/xml/coverage-04.dtd}{this DTD}. Because there are \emph{two} DTDs called \verb{coverage-04.dtd} and some tools do not seem to adhere to either of them, the parser you're using may balk at the file. Please see \href{https://github.com/cobertura/cobertura/issues/425}{this github discussion} for context. Where \code{covr} doesn't provide a coverage metric (branch coverage, complexity), a zero is reported. } \details{ \emph{Note}: This functionality requires the xml2 package be installed. } ================================================ FILE: man/to_sonarqube.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/sonarqube.R \name{to_sonarqube} \alias{to_sonarqube} \title{Create a SonarQube Generic XML file for test coverage according to https://docs.sonarqube.org/latest/analysis/generic-test/ Based on cobertura.R} \usage{ to_sonarqube(cov, filename = "sonarqube.xml") } \arguments{ \item{cov}{the coverage object returned from \code{\link[=package_coverage]{package_coverage()}}} \item{filename}{the name of the SonarQube Generic XML file} } \description{ This functionality requires the xml2 package be installed. } \author{ Talkdesk Inc. } ================================================ FILE: man/trace_calls.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_calls.R \name{trace_calls} \alias{trace_calls} \title{trace each call with a srcref attribute} \usage{ trace_calls(x, parent_functions = NULL, parent_ref = NULL) } \arguments{ \item{x}{the call} \item{parent_functions}{the functions which this call is a child of.} \item{parent_ref}{argument used to set the srcref of the current call during the recursion.} } \value{ a modified expression with count calls inserted before each previous call. } \description{ This function calls itself recursively so it can properly traverse the AST. } \seealso{ \url{http://adv-r.had.co.nz/Expressions.html} } \keyword{internal} ================================================ FILE: man/truncate_call.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{truncate_call} \alias{truncate_call} \title{Truncate call objects to limit the number of arguments} \usage{ truncate_call(call_obj, limit = 10000) } \arguments{ \item{call_obj}{A (possibly large) \code{call} object} \item{limit}{A \code{call} length limit to impose} } \value{ The \code{call_obj} with arguments trimmed } \description{ A helper to circumvent R errors when deserializing large call objects from Rds. Trims the number of arguments in a call object, and replaces the last argument with a \verb{} symbol. } ================================================ FILE: man/update_current_test.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/trace_tests.R \name{update_current_test} \alias{update_current_test} \title{Update current test if unit test expression has progressed} \usage{ update_current_test() } \description{ Updating a test logs some metadata regarding the current call stack, noteably trying to capture information about the call stack prior to the covr::count call being traced. } \details{ There are a couple patterns of behavior, which try to accommodate a variety of testing suites: \itemize{ \item \code{testthat}: During execution of \code{testthat}'s \verb{test_*} functions, files are sourced and the working directory is temporarily changed to the package \verb{/tests} directory. Knowing this, calls in the call stack which are relative to this directory are extracted and recorded. \item \code{RUnit}: \item \code{custom}: Any other custom test suites may not have source kept with their execution, in which case the entire test call stack is kept. } checks to see if the current call stack has the same \code{srcref} (or expression, if no source is available) at the same frame prior to entering into a package where \code{covr:::count} is called. } \keyword{internal} ================================================ FILE: man/value.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/value.R \name{value} \alias{value} \title{Retrieve the value from an object} \usage{ value(x, ...) } \arguments{ \item{x}{object from which to retrieve the value} \item{...}{additional arguments passed to methods} } \description{ Retrieve the value from an object } ================================================ FILE: man/zero_coverage.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary_functions.R \name{zero_coverage} \alias{zero_coverage} \title{Provide locations of zero coverage} \usage{ zero_coverage(x, ...) } \arguments{ \item{x}{a coverage object returned \code{\link[=package_coverage]{package_coverage()}}} \item{...}{additional arguments passed to \code{\link[=tally_coverage]{tally_coverage()}}} } \value{ A \code{data.frame} with coverage data where the coverage is 0. } \description{ When examining the test coverage of a package, it is useful to know if there are any locations where there is \strong{0} test coverage. } \details{ if used within RStudio this function outputs the results using the Marker API. } ================================================ FILE: shim_package.sh ================================================ #!/usr/bin/env sh perl -i -pe 's/\bcovr\b/covrShim/g;s/\bcovr_/covrShim_/g;s/_covr/_covrShim/g;' DESCRIPTION NAMESPACE R/* src/* tests/*R tests/testthat/*R ================================================ FILE: src/reassign.c ================================================ #define USE_RINTERNALS #include #include #include #include #include #include // for NULL #include // for uint64_t inline static void CheckBody(SEXP x) { switch (TYPEOF(x)) { case NILSXP: case SYMSXP: case LISTSXP: // case CLOSXP: case ENVSXP: case PROMSXP: case LANGSXP: // case SPECIALSXP: // case BUILTINSXP: case CHARSXP: case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: // case DOTSXP: // case ANYSXP: case VECSXP: case EXPRSXP: case BCODESXP: case EXTPTRSXP: case WEAKREFSXP: case RAWSXP: case S4SXP: // renamed to OBJSXP return; default: error("Unexpected closure body type"); } } inline static void CheckEnvironment(SEXP x) { if(TYPEOF(x) != ENVSXP) error("Unexpected closure env type"); } inline static void CheckFormals(SEXP ls) { // copied from R: // https://github.com/wch/r-source/blob/tags/R-4-4-2/src/main/eval.c#L3842-L3852 if (isList(ls)) { for (; ls != R_NilValue; ls = CDR(ls)) if (TYPEOF(TAG(ls)) != SYMSXP) goto err; return; } err: error("Unexpected closure formals"); } SEXP covr_reassign_function(SEXP old_fun, SEXP new_fun) { if (TYPEOF(old_fun) != CLOSXP) error("old_fun must be a function"); if (TYPEOF(new_fun) != CLOSXP) error("new_fun must be a function"); // The goal is to modify `old_fun` in place, so that all existing references // to `old_fun` call the tracing `new_fun` instead. // This used to be simply: // SET_FORMALS(old_fun, FORMALS(new_fun)); // SET_BODY(old_fun, BODY(new_fun)); // SET_CLOENV(old_fun, CLOENV(new_fun)); // But those functions are now "non-API". So we comply with the letter of the // law and swap the fields manually, making some hard assumptions about the // underlying memory layout in the process. // Rather than using memcpy() with a hard-coded byte offset, we mirror the R // internals SEXPREC struct defs here, to hopefully match the alignment // behavior of R (e.g., on windows). // Mirror the exact structures of SEXPREC from R internals struct proxy_sxpinfo_struct { uint64_t bits; // guaranteed to be 64 bits }; struct proxy_closxp_struct { struct SEXPREC *formals; struct SEXPREC *body; struct SEXPREC *env; }; struct proxy_sexprec { struct proxy_sxpinfo_struct sxpinfo; struct SEXPREC *attrib; struct SEXPREC *gengc_next_node, *gengc_prev_node; union { struct proxy_closxp_struct closxp; // We could add other union members if needed } u; }; typedef struct proxy_sexprec* proxy_sexp; proxy_sexp old = (proxy_sexp) old_fun; proxy_sexp new = (proxy_sexp) new_fun; // Sanity checks. If the closxp struct is not what we expect, then the // underlying internal memory layout of a CLOSXP has probably changed and we // need to update this code. // https://github.com/wch/r-source/blob/tags/R-4-4-2/src/include/Defn.h#L170-L174 CheckFormals(old->u.closxp.formals); CheckFormals(new->u.closxp.formals); CheckBody(old->u.closxp.body); CheckBody(new->u.closxp.body); CheckEnvironment(old->u.closxp.env); CheckEnvironment(new->u.closxp.env); MARK_NOT_MUTABLE(old_fun); MARK_NOT_MUTABLE(old->u.closxp.body); MARK_NOT_MUTABLE(old->u.closxp.env); MARK_NOT_MUTABLE(old->u.closxp.formals); MARK_NOT_MUTABLE(new_fun); MARK_NOT_MUTABLE(new->u.closxp.body); MARK_NOT_MUTABLE(new->u.closxp.env); MARK_NOT_MUTABLE(new->u.closxp.formals); old->u.closxp = new->u.closxp; // Duplicate attributes is still not "non-API", thankfully. DUPLICATE_ATTRIB(old_fun, new_fun); return R_NilValue; } SEXP covr_duplicate_(SEXP x) { return duplicate(x); } /* .Call calls */ extern SEXP covr_duplicate_(SEXP); extern SEXP covr_reassign_function(SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { {"covr_duplicate_", (DL_FUNC)&covr_duplicate_, 1}, {"covr_reassign_function", (DL_FUNC)&covr_reassign_function, 2}, {NULL, NULL, 0}}; void R_init_covr(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } ================================================ FILE: tests/testthat/Test+Char/TestCompiled/DESCRIPTION ================================================ Package: TestCompiled Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true Suggests: testthat RoxygenNote: 7.1.1 ================================================ FILE: tests/testthat/Test+Char/TestCompiled/NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand useDynLib(TestCompiled,simple_) ================================================ FILE: tests/testthat/Test+Char/TestCompiled/R/TestCompiled.R ================================================ #' an example function #' #' @useDynLib TestCompiled simple_ simple <- function(x) { .Call(simple_, x) # nolint } ================================================ FILE: tests/testthat/Test+Char/TestCompiled/man/simple.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/TestCompiled.R \name{simple} \alias{simple} \title{an example function} \usage{ simple(x) } \description{ an example function } ================================================ FILE: tests/testthat/Test+Char/TestCompiled/src/simple.cc ================================================ #define USE_RINTERNALS #include #include #include extern "C" SEXP simple_(SEXP x) { double *px, *pout; SEXP out = PROTECT(Rf_allocVector(REALSXP, 1)); px = REAL(x); pout = REAL(out); if (px[0] >= 1) { pout[0] = 1; } else if (px[0] == 0) { pout[0] = 0; } else { pout[0] = -1; } UNPROTECT(1); return out; } ================================================ FILE: tests/testthat/Test+Char/TestCompiled/tests/testthat/test-TestCompiled.R ================================================ test_that("compiled function simple works", { expect_equal(simple(1), 1) expect_equal(simple(2), 1) expect_equal(simple(3), 1) expect_equal(simple(-1), -1) }) ================================================ FILE: tests/testthat/Test+Char/TestCompiled/tests/testthat.R ================================================ library(testthat) library("TestCompiled") test_check("TestCompiled") ================================================ FILE: tests/testthat/TestCompiled/DESCRIPTION ================================================ Package: TestCompiled Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true Suggests: testthat RoxygenNote: 5.0.1 ================================================ FILE: tests/testthat/TestCompiled/NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand useDynLib(TestCompiled,simple_) useDynLib(TestCompiled,simple3_) useDynLib(TestCompiled,simple4_) ================================================ FILE: tests/testthat/TestCompiled/R/TestCompiled.R ================================================ #' an example function #' #' @useDynLib TestCompiled simple_ simple <- function(x) { .Call(simple_, x) # nolint } simple3 <- function(x) { .Call(simple3_, x) # nolint } simple4 <- function(x) { .Call(simple4_, x) # nolint } ================================================ FILE: tests/testthat/TestCompiled/man/simple.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/TestCompiled.R \name{simple} \alias{simple} \title{an example function} \usage{ simple(x) } \description{ an example function } ================================================ FILE: tests/testthat/TestCompiled/src/simple-header.h ================================================ #pragma once #define USE_RINTERNALS #include #include #include template SEXP simple2_(SEXP x) { R *px, *pout; SEXP out = PROTECT(Rf_allocVector(R_SXP, 1)); px = (R *) DATAPTR(x); pout = (R *) DATAPTR(out); if (px[0] >= 1) { pout[0] = 1; } else if (px[0] == 0) { pout[0] = 0; } else { pout[0] = -1; } UNPROTECT(1); return out; } ================================================ FILE: tests/testthat/TestCompiled/src/simple.cc ================================================ #define USE_RINTERNALS #include #include #include #include "simple-header.h" extern "C" SEXP simple_(SEXP x) { double *px, *pout; SEXP out = PROTECT(Rf_allocVector(REALSXP, 1)); px = REAL(x); pout = REAL(out); if (px[0] >= 1) { pout[0] = 1; } else if (px[0] == 0) { pout[0] = 0; } else { pout[0] = -1; } UNPROTECT(1); return out; } extern "C" SEXP simple3_(SEXP x) { return simple2_(x); } ================================================ FILE: tests/testthat/TestCompiled/src/simple4.cc ================================================ #define USE_RINTERNALS #include #include #include #include "simple-header.h" extern "C" SEXP simple4_(SEXP x) { return simple2_(x); } ================================================ FILE: tests/testthat/TestCompiled/tests/testthat/test-TestCompiled.R ================================================ test_that("compiled function simple works", { expect_equal(simple(1), 1) expect_equal(simple(2), 1) expect_equal(simple(3), 1) expect_equal(simple(-1), -1) }) test_that("compiled function simple3 works", { expect_equal(simple3(1), 1) expect_equal(simple3(2), 1) }) test_that("compiled function simple4 works", { expect_equal(simple4(3L), 1L) expect_equal(simple4(-1L), -1L) }) ================================================ FILE: tests/testthat/TestCompiled/tests/testthat.R ================================================ library(testthat) library("TestCompiled") test_check("TestCompiled") ================================================ FILE: tests/testthat/TestCompiledSubdir/DESCRIPTION ================================================ Package: TestCompiledSubdir Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true Suggests: testthat ================================================ FILE: tests/testthat/TestCompiledSubdir/NAMESPACE ================================================ # Generated by roxygen2 (4.1.1): do not edit by hand useDynLib(TestCompiledSubdir,simple_) ================================================ FILE: tests/testthat/TestCompiledSubdir/R/TestCompiledSubdir.R ================================================ #' an example function #' #' @useDynLib TestCompiledSubdir simple_ simple <- function(x) { .Call(simple_, x) # nolint } ================================================ FILE: tests/testthat/TestCompiledSubdir/man/simple.Rd ================================================ % Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/TestCompiledSubdir.R \name{simple} \alias{simple} \title{an example function} \usage{ simple(x) } \description{ an example function } ================================================ FILE: tests/testthat/TestCompiledSubdir/src/Makevars ================================================ OBJECTS = lib/simple.o ================================================ FILE: tests/testthat/TestCompiledSubdir/src/lib/simple.c ================================================ #define USE_RINTERNALS #include #include #include SEXP simple_(SEXP x) { double *px, *pout; SEXP out = PROTECT(Rf_allocVector(REALSXP, 1)); px = REAL(x); pout = REAL(out); if (px[0] >= 1) { pout[0] = 1; } else if (px[0] == 0) { pout[0] = 0; } else { pout[0] = -1; } UNPROTECT(1); return out; } ================================================ FILE: tests/testthat/TestCompiledSubdir/tests/testthat/test-TestCompiledSubdir.R ================================================ test_that("compiled function simple works", { expect_equal(simple(1), 1) expect_equal(simple(2), 1) expect_equal(simple(3), 1) expect_equal(simple(-1), -1) }) ================================================ FILE: tests/testthat/TestCompiledSubdir/tests/testthat.R ================================================ library(testthat) library("TestCompiledSubdir") test_check("TestCompiledSubdir") ================================================ FILE: tests/testthat/TestExclusion/DESCRIPTION ================================================ Package: TestExclusion Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true ================================================ FILE: tests/testthat/TestExclusion/NAMESPACE ================================================ # Generated by roxygen2 (4.1.1): do not edit by hand export(dont_test_me) export(test_exclusion) export(test_me) ================================================ FILE: tests/testthat/TestExclusion/R/TestExclusion.R ================================================ #' an example function #' #' @export test_me <- function(x, y){ x + y } # nocov start #' @export dont_test_me <- function(x, y){ x * y } # nocov end #' @export test_exclusion <- function(x) { if (x > 5) { 1 # nocov } else { 2 } } ================================================ FILE: tests/testthat/TestExclusion/man/test_me.Rd ================================================ % Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/TestExclusion.R \name{test_me} \alias{test_me} \title{an example function} \usage{ test_me(x, y) } \description{ an example function } ================================================ FILE: tests/testthat/TestExclusion/tests/testthat/test-TestExclusion.R ================================================ test_that("test_me works", { expect_equal(test_me(2, 2), 4) expect_equal(test_exclusion(1), 2) }) ================================================ FILE: tests/testthat/TestExclusion/tests/testthat.R ================================================ library(testthat) library("TestExclusion") test_check("TestExclusion") ================================================ FILE: tests/testthat/TestFunctional/DESCRIPTION ================================================ Package: TestFunctional Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true Suggests: testthat RoxygenNote: 6.1.1 ================================================ FILE: tests/testthat/TestFunctional/NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand export(a) export(b) ================================================ FILE: tests/testthat/TestFunctional/R/a.R ================================================ foo <- function(x) { force(x) function() { if (x < 1) { return(TRUE) } else { return(FALSE) } } } #' @export a <- foo(0) #' @export b <- foo(1) ================================================ FILE: tests/testthat/TestFunctional/tests/testthat/test-a.R ================================================ test_that("regular function `a` works as expected", { expect_equal(a(), TRUE) expect_equal(b(), FALSE) }) ================================================ FILE: tests/testthat/TestFunctional/tests/testthat.R ================================================ library(testthat) library("TestFunctional") test_check("TestFunctional") ================================================ FILE: tests/testthat/TestNestedTestDirs/DESCRIPTION ================================================ Package: TestNestedTestDirs Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true Suggests: testthat RoxygenNote: 6.1.1 ================================================ FILE: tests/testthat/TestNestedTestDirs/NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand export(a) export(b) ================================================ FILE: tests/testthat/TestNestedTestDirs/R/a.R ================================================ foo <- function(x) { force(x) function() { if (x < 1) { return(TRUE) } else { return(FALSE) } } } #' @export a <- foo(0) #' @export b <- foo(1) ================================================ FILE: tests/testthat/TestNestedTestDirs/tests/testthat/nested_tests/test-a.R ================================================ test_that("regular function `a` works as expected", { expect_equal(a(), TRUE) expect_equal(b(), FALSE) }) ================================================ FILE: tests/testthat/TestNestedTestDirs/tests/testthat/test-a.R ================================================ test_that("regular function `a` works as expected", { expect_equal(a(), TRUE) expect_equal(b(), FALSE) }) ================================================ FILE: tests/testthat/TestNestedTestDirs/tests/testthat/test-nested-dir.R ================================================ # used for testing the extraction of srcrefs pertaining to tests, which assumes # srcrefs within working directory if (Sys.getenv("COVR_TEST_NESTED") == "TRUE") { test_dir("./nested_tests") # keep.source needed to extract test trace source("./nested_tests/test-a.R", keep.source = TRUE) } ================================================ FILE: tests/testthat/TestNestedTestDirs/tests/testthat.R ================================================ library(testthat) library("TestNestedTestDirs") test_check("TestNestedTestDirs") ================================================ FILE: tests/testthat/TestParallel/DESCRIPTION ================================================ Package: TestParallel Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) Suggests: parallel License: What license is it under? LazyData: true ================================================ FILE: tests/testthat/TestParallel/NAMESPACE ================================================ # Generated by roxygen2 (4.1.1): do not edit by hand export(test1) export(test2) export(test3) ================================================ FILE: tests/testthat/TestParallel/R/TestParallel.R ================================================ #' an example function #' #' @export test1 <- function(x, y){ x + y } #' @export test2 <- function(x, y){ x * y } #' @export test3 <- function(x, y){ x - y } ================================================ FILE: tests/testthat/TestParallel/man/test_me.Rd ================================================ % Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/TestSummary.R \name{test_me} \alias{test_me} \title{an example function} \usage{ test_me(x, y) } \description{ an example function } ================================================ FILE: tests/testthat/TestParallel/tests/testthat/test-TestParallel.R ================================================ test_that("test_me works", { library(parallel) mccollect(mcparallel( expect_equal(test1(2, 2), 4) )) mccollect(mcparallel( expect_equal(test2(2, 2), 4) )) expect_equal(test3(2, 2), 0) }) ================================================ FILE: tests/testthat/TestParallel/tests/testthat.R ================================================ library(testthat) library("TestParallel") test_check("TestParallel") ================================================ FILE: tests/testthat/TestPrint/DESCRIPTION ================================================ Package: TestPrint Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true ================================================ FILE: tests/testthat/TestPrint/NAMESPACE ================================================ # Generated by roxygen2 (4.1.1): do not edit by hand export(test_me) ================================================ FILE: tests/testthat/TestPrint/R/TestPrint.R ================================================ #' an example function #' #' @export test_me <- function(x, y) { if (TRUE) { x + y } else { 0 } # nolint } ================================================ FILE: tests/testthat/TestPrint/man/test_me.Rd ================================================ % Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/TestPrint.R \name{test_me} \alias{test_me} \title{an example function} \usage{ test_me(x, y) } \description{ an example function } ================================================ FILE: tests/testthat/TestPrint/tests/testthat/test-TestSummary.R ================================================ test_that("test_me works", { expect_equal(test_me(2, 2), 4) }) ================================================ FILE: tests/testthat/TestPrint/tests/testthat.R ================================================ library(testthat) library("TestPrint") test_check("TestPrint") ================================================ FILE: tests/testthat/TestR6/DESCRIPTION ================================================ Package: TestR6 Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true Imports: R6 Suggests: testthat ================================================ FILE: tests/testthat/TestR6/NAMESPACE ================================================ # Generated by roxygen2 (4.1.1): do not edit by hand export(TestR6) export(a) ================================================ FILE: tests/testthat/TestR6/R/TestR6.R ================================================ #' an example function #' #' @export a <- function(x) { if (x <= 1) { 1 } else { 2 } } #' @export TestR6 <- R6::R6Class("TestR6", # nolint public = list( show = function(x) { 1 + 3 }, print2 = function(x) { 1 + 2 } ) ) .InternalTestR6 <- R6::R6Class("InternalTestR6", # nolint public = list( some_method = function(x){ 1 + 2 } ) ) ================================================ FILE: tests/testthat/TestR6/man/a.Rd ================================================ % Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/TestR6.R \name{a} \alias{a} \title{an example function} \usage{ a(x) } \description{ an example function } ================================================ FILE: tests/testthat/TestR6/tests/testthat/test-TestR6.R ================================================ test_that("regular function `a` works as expected", { expect_equal(a(1), 1) expect_equal(a(2), 2) expect_equal(a(3), 2) expect_equal(a(4), 2) expect_equal(a(0), 1) }) test_that("TestR6 class can be instantiated", { t1 <- TestR6$new() # nolint }) test_that("TestR6 Methods can be evaluated", { t1 <- TestR6$new() # nolint t1$show() print(t1$print2()) }) ================================================ FILE: tests/testthat/TestR6/tests/testthat.R ================================================ library(testthat) library("TestR6") test_check("TestR6") ================================================ FILE: tests/testthat/TestRC/DESCRIPTION ================================================ Package: TestRC Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true Suggests: testthat ================================================ FILE: tests/testthat/TestRC/NAMESPACE ================================================ # Generated by roxygen2 (4.1.1): do not edit by hand export(a) exportClasses(TestRC) ================================================ FILE: tests/testthat/TestRC/R/TestRC.R ================================================ #' an example function #' #' @export a <- function(x) { if (x <= 1) { 1 } else { 2 } } #' @export TestRC <- setRefClass("TestRC", # nolint fields = list(name = "character", enabled = "logical"), methods = list( show = function(x) { 1 + 3 }, print2 = function(x) { 1 + 2 } ) ) ================================================ FILE: tests/testthat/TestRC/man/a.Rd ================================================ % Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/TestRC.R \name{a} \alias{a} \title{an example function} \usage{ a(x) } \description{ an example function } ================================================ FILE: tests/testthat/TestRC/tests/testthat/test-TestRC.R ================================================ test_that("regular function `a` works as expected", { expect_equal(a(1), 1) expect_equal(a(2), 2) expect_equal(a(3), 2) expect_equal(a(4), 2) expect_equal(a(0), 1) }) test_that("TestRC class can be instantiated", { t1 <- TestRC() # nolint }) test_that("TestRC Methods can be evaluated", { t1 <- TestRC() # nolint t1$show() print(t1$print2()) }) ================================================ FILE: tests/testthat/TestRC/tests/testthat.R ================================================ library(testthat) library("TestRC") test_check("TestRC") ================================================ FILE: tests/testthat/TestS4/DESCRIPTION ================================================ Package: TestS4 Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true RoxygenNote: 5.0.1 ================================================ FILE: tests/testthat/TestS4/NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand export(a) export(print2) exportClasses(TestS4) ================================================ FILE: tests/testthat/TestS4/R/TestS4.R ================================================ #' an example function #' #' @export #' @examples #' a(1) a <- function(x) { if (x <= 1) { 1 } else { 2 } } #' @export TestS4 <- setClass("TestS4", # nolint slots = list(name = "character", enabled = "logical")) #' @export setGeneric("print2", function(x, y) { }) setMethod("print2", c(x = "TestS4"), function(x) { 1 + 1 }) setMethod("print2", c(x = "TestS4", y = "character"), function(x, y) { 1 + 2 }) setMethod("show", c(object = "TestS4"), function(object) { 1 + 3 }) ================================================ FILE: tests/testthat/TestS4/codecov.yml ================================================ codecov: token: codecov_token_from_yaml ================================================ FILE: tests/testthat/TestS4/man/a.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/TestS4.R \name{a} \alias{a} \title{an example function} \usage{ a(x) } \description{ an example function } \examples{ a(1) } ================================================ FILE: tests/testthat/TestS4/tests/testthat/test-TestS4.R ================================================ test_that("regular function `a` works as expected", { expect_equal(a(1), 1) expect_equal(a(2), 2) expect_equal(a(3), 2) expect_equal(a(4), 2) expect_equal(a(0), 1) }) test_that("TestS4 class can be instantiated", { t1 <- TestS4() # nolint }) test_that("TestS4 Methods can be evaluated", { t1 <- TestS4() # nolint show(t1) print(print2(t1)) print(print2(t1, "hi")) }) ================================================ FILE: tests/testthat/TestS4/tests/testthat.R ================================================ library(testthat) suppressPackageStartupMessages(test_check("TestS4")) ================================================ FILE: tests/testthat/TestS7/DESCRIPTION ================================================ Package: TestS7 Title: What the Package Does (One Line, Title Case) Version: 0.0.0.9000 Authors@R: c( person("Jim", "Hester", , "james.f.hester@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2739-7082")), person("RStudio", role = c("cph", "fnd")) ) Description: What the package does (one paragraph). License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Imports: S7 Suggests: testthat (>= 3.0.0) Config/testthat/edition: 3 ================================================ FILE: tests/testthat/TestS7/NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand export(Range) export(inside) if (getRversion() < "4.3.0") importFrom("S7", "@") import(S7) ================================================ FILE: tests/testthat/TestS7/R/foo.R ================================================ #' @import S7 #' @export Range <- new_class("Range", properties = list( start = class_double, end = class_double, length = new_property( class = class_double, getter = function(self) self@end - self@start, setter = function(self, value) { self@end <- self@start + value self } ) ), constructor = function(x) { new_object(S7_object(), start = as.double(min(x, na.rm = TRUE)), end = as.double(max(x, na.rm = TRUE))) }, validator = function(self) { if (length(self@start) != 1) { "@start must be length 1" } else if (length(self@end) != 1) { "@end must be length 1" } else if (self@end < self@start) { "@end must be greater than or equal to @start" } } ) #' @export inside <- new_generic("inside", "x") method(inside, Range) <- function(x, y) { y >= x@start & y <= x@end } # enable usage of @name in package code #' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@") NULL # test external S3 generics method(format, Range) <- function(x) { sprintf("Range(%s, %s)", x@start, x@end) } testthat_print <- new_external_generic("testthat", "testthat_print", "x") method(testthat_print, Range) <- function(x, ...) { cat(format(x)) invisible(x) } .onLoad <- function(libname, pkgname) { S7::methods_register() } ================================================ FILE: tests/testthat/TestS7/tests/testthat/test-foo.R ================================================ test_that("Range works", { x <- Range(1:10) x@end <- 20 expect_error(x@end <- "x", "must be ") expect_error(x@end <- -1, "greater than or equal") expect_equal(inside(x, c(0, 5, 10, 15)), c(FALSE, TRUE, TRUE, TRUE)) x@length <- 5 expect_equal(x@length, 5) expect_equal(x@end, 6) }) test_that("Range methods work", { x <- Range(1:10) expect_equal(base::format(x), "Range(1, 10)") # Test external generic method for testthat::testthat_print() expect_equal(testthat::capture_output(x, print = TRUE), "Range(1, 10)") }) ================================================ FILE: tests/testthat/TestS7/tests/testthat.R ================================================ # This file is part of the standard setup for testthat. # It is recommended that you do not modify it. # # Where should you do additional test configuration? # Learn more about the roles of various files in: # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview # * https://testthat.r-lib.org/articles/special-files.html library(testthat) library(TestS7) test_check("TestS7") ================================================ FILE: tests/testthat/TestSummary/DESCRIPTION ================================================ Package: TestSummary Title: What the Package Does (one line, title case) Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true ================================================ FILE: tests/testthat/TestSummary/NAMESPACE ================================================ # Generated by roxygen2 (4.1.1): do not edit by hand export(dont_test_me) export(test_me) ================================================ FILE: tests/testthat/TestSummary/R/TestSummary.R ================================================ #' an example function #' #' @export test_me <- function(x, y){ if (TRUE) x + y else x - y } #' @export dont_test_me <- function(x, y){ x * y } ================================================ FILE: tests/testthat/TestSummary/man/test_me.Rd ================================================ % Generated by roxygen2 (4.1.1): do not edit by hand % Please edit documentation in R/TestSummary.R \name{test_me} \alias{test_me} \title{an example function} \usage{ test_me(x, y) } \description{ an example function } ================================================ FILE: tests/testthat/TestSummary/tests/testthat/test-TestSummary.R ================================================ test_that("test_me works", { expect_equal(test_me(2, 2), 4) }) ================================================ FILE: tests/testthat/TestSummary/tests/testthat.R ================================================ library(testthat) library("TestSummary") test_check("TestSummary") ================================================ FILE: tests/testthat/TestUseTry/DESCRIPTION ================================================ Package: TestUseTry Title: Test That `use_try` Parameter works Version: 0.0.0.9000 Authors@R: "First Last [aut, cre]" Description: What the package does (one paragraph) Depends: R (>= 3.1.2) License: What license is it under? LazyData: true Suggests: testthat ================================================ FILE: tests/testthat/TestUseTry/NAMESPACE ================================================ # Generated by roxygen2 (4.1.1): do not edit by hand export(fun) ================================================ FILE: tests/testthat/TestUseTry/R/notry.R ================================================ #' @export fun <- function() { withCallingHandlers( signalCondition(simpleError("This Will Exit if `!isTRUE(use_try)`")), error = function(e) TRUE ) 1 + 1 2 + 2 "hello" "welcome" TRUE } ================================================ FILE: tests/testthat/TestUseTry/tests/tests.R ================================================ TestUseTry::fun() ================================================ FILE: tests/testthat/TestUseTry/tests/testthat/test-notry.R ================================================ expect_true(TestUseTry::fun()) ================================================ FILE: tests/testthat/Testbox/app/app.R ================================================ options(box.path = file.path(getwd())) # remove box cache loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) box::use( app/modules/module ) ================================================ FILE: tests/testthat/Testbox/app/modules/module.R ================================================ #' an example function #' #' @export a <- function(x) { if (x <= 1) { 1 } else { 2 } } private_function <- function(x) { x ^ 2 } ================================================ FILE: tests/testthat/Testbox/tests/testthat/test-module.R ================================================ box::use( testthat[test_that, expect_equal] ) box::use( app/modules/module ) impl <- attr(module, "namespace") test_that("regular function `a` works as expected", { expect_equal(module$a(1), 1) expect_equal(module$a(2), 2) expect_equal(module$a(3), 2) expect_equal(module$a(4), 2) expect_equal(module$a(0), 1) }) test_that("private function works as expected", { expect_equal(impl$private_function(2), 4) expect_equal(impl$private_function(3), 9) expect_equal(impl$private_function(4), 16) }) ================================================ FILE: tests/testthat/Testbox/tests/testthat.R ================================================ options(box.path = file.path(getwd())) # remove box cache loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) library(testthat) test_dir("tests/testthat") ================================================ FILE: tests/testthat/Testbox_R6/app/app.R ================================================ options(box.path = file.path(getwd())) # remove box cache loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) box::use( app/modules/moduleR6 ) ================================================ FILE: tests/testthat/Testbox_R6/app/modules/moduleR6.R ================================================ #' @export TestR6 <- R6::R6Class("TestR6", # nolint public = list( show = function(x) { 1 + 3 }, print2 = function(x) { 1 + 2 } ) ) ================================================ FILE: tests/testthat/Testbox_R6/tests/testthat/test-moduleR6.R ================================================ box::use( testthat[test_that, expect_equal, expect_s3_class] ) box::use( app/modules/moduleR6 ) test_that("TestR6 class can be instantiated", { skip_if(is_r_devel()) t1 <- moduleR6$TestR6$new() # nolint expect_s3_class(t1, "R6") expect_s3_class(t1, "TestR6") }) test_that("TestR6 Methods can be evaluated", { skip_if(is_r_devel()) t1 <- moduleR6$TestR6$new() # nolint expect_equal(t1$show(), 4) expect_equal(print(t1$print2()), 3) }) ================================================ FILE: tests/testthat/Testbox_R6/tests/testthat.R ================================================ options(box.path = file.path(getwd())) # remove box cache loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) library(testthat) test_dir("tests/testthat") ================================================ FILE: tests/testthat/Testbox_attached_modules_functions/app/app.R ================================================ options(box.path = file.path(getwd())) # remove box cache loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) box::use( app/modules/module ) ================================================ FILE: tests/testthat/Testbox_attached_modules_functions/app/modules/module.R ================================================ #' an example function #' #' @export a <- function(x) { if (x <= 1) { 1 } else { 2 } } #' @export b <- function(x) { return(x * 2) } private_function <- function(x) { x ^ 2 } ================================================ FILE: tests/testthat/Testbox_attached_modules_functions/tests/testthat/test-aliased_functions.R ================================================ box::use( testthat[test_that, expect_equal] ) box::use( app/modules/module[x = a] ) test_that("attached regular function `a` works as expected", { expect_equal(x(1), 1) expect_equal(x(2), 2) expect_equal(x(3), 2) expect_equal(x(4), 2) expect_equal(x(0), 1) }) ================================================ FILE: tests/testthat/Testbox_attached_modules_functions/tests/testthat/test-aliased_modules.R ================================================ box::use( testthat[test_that, expect_equal] ) box::use( x = app/modules/module ) test_that("attached regular function `a` works as expected", { expect_equal(x$a(1), 1) expect_equal(x$a(2), 2) expect_equal(x$a(3), 2) expect_equal(x$a(4), 2) expect_equal(x$a(0), 1) }) ================================================ FILE: tests/testthat/Testbox_attached_modules_functions/tests/testthat/test-attached_functions.R ================================================ box::use( testthat[test_that, expect_equal] ) box::use( app/modules/module[a] ) test_that("attached regular function `a` works as expected", { expect_equal(a(1), 1) expect_equal(a(2), 2) expect_equal(a(3), 2) expect_equal(a(4), 2) expect_equal(a(0), 1) }) ================================================ FILE: tests/testthat/Testbox_attached_modules_functions/tests/testthat/test-three_dots.R ================================================ box::use( testthat[test_that, expect_equal] ) box::use( app/modules/module[...] ) test_that("attached regular function `a` works as expected", { expect_equal(a(1), 1) expect_equal(a(2), 2) expect_equal(a(3), 2) expect_equal(a(4), 2) expect_equal(a(0), 1) }) test_that("attached regular function `b` works as expected", { expect_equal(b(1), 2) expect_equal(b(2), 4) expect_equal(b(3), 6) }) ================================================ FILE: tests/testthat/Testbox_attached_modules_functions/tests/testthat.R ================================================ options(box.path = file.path(getwd())) # remove box cache loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) library(testthat) test_dir("tests/testthat") ================================================ FILE: tests/testthat/Testbox_attached_modules_functions_R6/app/app.R ================================================ options(box.path = file.path(getwd())) # remove box cache loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) box::use( app/modules/moduleR6 ) ================================================ FILE: tests/testthat/Testbox_attached_modules_functions_R6/app/modules/moduleR6.R ================================================ #' @export TestR6 <- R6::R6Class("TestR6", # nolint public = list( show = function(x) { 1 + 3 }, print2 = function(x) { 1 + 2 } ) ) ================================================ FILE: tests/testthat/Testbox_attached_modules_functions_R6/tests/testthat/test-attached_R6.R ================================================ box::use( testthat[test_that, expect_equal, expect_s3_class] ) box::use( app/modules/moduleR6[TestR6] ) test_that("TestR6 class can be instantiated", { skip_if(is_r_devel()) t1 <- TestR6$new() # nolint expect_s3_class(t1, "R6") expect_s3_class(t1, "TestR6") }) test_that("TestR6 Methods can be evaluated", { skip_if(is_r_devel()) t1 <- TestR6$new() # nolint expect_equal(t1$show(), 4) expect_equal(t1$print2(), 3) }) ================================================ FILE: tests/testthat/Testbox_attached_modules_functions_R6/tests/testthat.R ================================================ options(box.path = file.path(getwd())) # remove box cache loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) library(testthat) test_dir("tests/testthat") ================================================ FILE: tests/testthat/_snaps/Compiled.md ================================================ # Error thrown for missing gcov Code package_coverage("TestCompiled", relative_path = TRUE) Condition Error in `run_gcov()`: ! gcov not found # Warning thrown for empty gcov output Code . <- package_coverage("TestCompiled", relative_path = TRUE) Condition Warning in `run_gcov()`: parsed gcov output was empty ================================================ FILE: tests/testthat/_snaps/S7.md ================================================ # S7 coverage is reported Code cov[, c("functions", "first_line", "last_line", "value")] Output functions first_line last_line value 1 Range@properties$length$getter 9 9 1 2 Range@properties$length$setter 11 11 1 3 Range@properties$length$setter 12 12 1 4 Range 17 17 2 5 Range@validator 20 20 5 6 Range@validator 21 21 0 7 Range@validator 22 22 5 8 Range@validator 23 23 0 9 Range@validator 24 24 5 10 Range@validator 25 25 1 11 method(inside, TestS7::Range) 34 34 1 12 method(base::format, TestS7::Range) 43 43 2 13 method(testthat::testthat_print, TestS7::Range) 48 48 1 14 method(testthat::testthat_print, TestS7::Range) 49 49 1 15 .onLoad 53 53 0 ================================================ FILE: tests/testthat/a ================================================ ================================================ FILE: tests/testthat/b ================================================ ================================================ FILE: tests/testthat/cobertura.xml ================================================ /dummy/directory ================================================ FILE: tests/testthat/corner-cases-test.R ================================================ fun1() fun2() fun3() fun4(1) fun4(1L) ================================================ FILE: tests/testthat/corner-cases.R ================================================ make_fun_1 <- function() { function(x) { 2 + 2 1 + 1 cat("fun1\n") } } make_fun_2 <- function() { function(x) { 3 + 3 4 + 4 cat("fun2\n") } } #' @export fun1 <- make_fun_1() #' @export fun2 <- function(x) { 2 + 2 1 + 1 cat("fun2\n") } #' @export fun3 <- function() { if(FALSE) 1 else 2 1 + 1; if(TRUE) 1 else 2 if(FALSE) 3 else 4 if(FALSE) {3} else {4} if(TRUE) 3 else {1 + 1 2 + 2 } {1 + 1; 2 + 2}; if(FALSE) 1 else 2; {TRUE} {1 + 1; 2 + 2}; "hello"; {TRUE} if(TRUE) { {1 + 1; 2 + 2}; "hello"; {TRUE} {1 + 1; 2 + 2}; if(FALSE) 1 else 2; {TRUE} } else { {1 + 1; 2 + 2}; "hello"; {TRUE} {1 + 1; 2 + 2}; if(FALSE) 1 else 2; {TRUE} } } #' @export setGeneric("fun4", function(x) StandardGeneric("fun2")) setMethod("fun4", "integer", make_fun_2()) setMethod("fun4", "numeric", make_fun_1()) ================================================ FILE: tests/testthat/helper.R ================================================ is_r_devel <- function() { startsWith(R.version$status, "Under development") } is_win_r41 <- function() { x <- getRversion() is_windows() && x$major == 4 && x$minor == 1 } ================================================ FILE: tests/testthat/sonarqube.xml ================================================ ================================================ FILE: tests/testthat/test-Compiled.R ================================================ test_that("Compiled code coverage is reported including code in headers", { skip_on_cran() skip_if(is_win_r41()) cov <- as.data.frame(package_coverage("TestCompiled", relative_path = TRUE)) simple_cc <- cov[cov$filename == "src/simple.cc", ] expect_equal(simple_cc[simple_cc$first_line == "10", "value"], 4) expect_equal(simple_cc[simple_cc$first_line == "16", "value"], 3) expect_equal(simple_cc[simple_cc$first_line == "19", "value"], 0) expect_equal(simple_cc[simple_cc$first_line == "21", "value"], 1) expect_equal(simple_cc[simple_cc$first_line == "23", "value"], 4) # This header contains a C++ template, which requires you to run gcov for # each object file separately and merge the results together. simple_h <- cov[cov$filename == "src/simple-header.h", ] expect_equal(simple_h[simple_h$first_line == "12", "value"], 4) expect_equal(simple_h[simple_h$first_line == "18", "value"], 3) expect_equal(simple_h[simple_h$first_line == "21", "value"], 0) expect_equal(simple_h[simple_h$first_line == "23", "value"], 1) expect_equal(simple_h[simple_h$first_line == "25", "value"], 4) expect_true(all(unique(cov$filename) %in% c("R/TestCompiled.R", "src/simple-header.h", "src/simple.cc", "src/simple4.cc"))) }) test_that("Can pass path to relative_path argument", { skip_on_cran() skip_if(is_win_r41()) cov <- as.data.frame(package_coverage("TestCompiled", relative_path = ".")) expect_true(all(unique(cov$filename) %in% c( "TestCompiled/R/TestCompiled.R", "TestCompiled/src/simple-header.h", "TestCompiled/src/simple.cc", "TestCompiled/src/simple4.cc" ))) }) test_that("Source code subdirectories are found", { skip_on_cran() skip_if(is_win_r41()) cov <- as.data.frame(package_coverage("TestCompiledSubdir", relative_path = TRUE)) expect_equal(cov[cov$first_line == "9", "value"], 4) expect_equal(cov[cov$first_line == "15", "value"], 3) expect_equal(cov[cov$first_line == "18", "value"], 0) expect_equal(cov[cov$first_line == "20", "value"], 1) expect_equal(cov[cov$first_line == "22", "value"], 4) }) test_that("Compiled code coverage is reported under non-standard char's", { skip_on_cran() skip_if(is_win_r41()) cov <- as.data.frame(package_coverage("Test+Char/TestCompiled", relative_path = TRUE)) expect_equal(cov[cov$first_line == "9", "value"], 4) expect_equal(cov[cov$first_line == "15", "value"], 3) expect_equal(cov[cov$first_line == "18", "value"], 0) expect_equal(cov[cov$first_line == "20", "value"], 1) expect_equal(cov[cov$first_line == "22", "value"], 4) }) test_that("Error thrown for missing gcov", { skip_on_cran() withr::local_options(covr.gcov='') expect_snapshot(package_coverage("TestCompiled", relative_path=TRUE), error = TRUE) }) test_that("Warning thrown for empty gcov output", { skip_on_cran() withr::local_options(covr.gcov_args='-n') expect_snapshot( . <- package_coverage("TestCompiled", relative_path=TRUE), transform = function(x) gsub(getwd(), "", x) ) }) test_that("tally_coverage includes compiled code", { skip_on_cran() skip_if(is_win_r41()) cov <- package_coverage(test_path("TestCompiled")) tall <- tally_coverage(cov) expect_named(tall, c("filename", "functions", "line", "value")) expect_equal( unique(tall$filename), c("R/TestCompiled.R", "src/simple-header.h", "src/simple.cc", "src/simple4.cc")) }) ================================================ FILE: tests/testthat/test-R6.R ================================================ test_that("R6 methods coverage is reported", { # There is some sort of bug that causes this test to fail during R CMD check # in R-devel, not sure why, and can't reproduce it interactively skip_if(is_r_devel()) cov <- as.data.frame(package_coverage(test_path("TestR6"))) expect_equal(cov$value, c(5, 2, 3, 1, 1, 0)) expect_equal(cov$first_line, c(5, 6, 8, 16, 19, 27)) expect_equal(cov$last_line, c(5, 6, 8, 16, 19, 27)) expect_true("some_method" %in% cov$functions) }) ================================================ FILE: tests/testthat/test-RC.R ================================================ test_that("RC methods coverage is reported", { cov <- as.data.frame(package_coverage("TestRC")) expect_equal(cov$value, c(5, 2, 3, 1, 1)) expect_equal(cov$first_line, c(5, 6, 8, 17, 20)) expect_equal(cov$last_line, c(5, 6, 8, 17, 20)) }) ================================================ FILE: tests/testthat/test-S4.R ================================================ test_that("S4 methods coverage is reported", { cov <- as.data.frame(package_coverage("TestS4")) expect_equal(cov$first_line, c(7, 8, 10, 25, 31, 37)) expect_equal(cov$value, c(5, 2, 3, 1, 1, 1)) }) ================================================ FILE: tests/testthat/test-S7.R ================================================ test_that("S7 coverage is reported", { skip_if_not_installed("S7") cov <- as.data.frame(package_coverage(test_path("TestS7"))) expect_equal(cov$value, c(1, 1, 1, 2, 5, 0, 5, 0, 5, 1, 1, 2, 1, 1, 0)) expect_snapshot(cov[, c("functions", "first_line", "last_line", "value")]) }) ================================================ FILE: tests/testthat/test-azure.R ================================================ test_that("azure_pipelines calls package_coverage and to_cobertura", { tf <- tempfile() on.exit(unlink(tf)) azure(test_path("TestS4"), filename = tf) expect_true(file.exists(tf)) }) ================================================ FILE: tests/testthat/test-box-R6.R ================================================ loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) test_that("R6 box module coverage is reported", { # Similar to test-R6.R, there is some sort of bug that causes this test # to fail during R CMD check in R-devel, not sure why, and can't reproduce # it interactively skip_if(is_r_devel()) withr::with_dir("Testbox_R6", { cov <- as.data.frame(file_coverage( source_files = "app/app.R", test_files = list.files("tests/testthat", full.names = TRUE))) expect_equal(cov$value, c(1, 1)) expect_equal(cov$first_line, c(5, 8)) expect_equal(cov$last_line, c(5, 8)) expect_true("show" %in% cov$functions) }) }) ================================================ FILE: tests/testthat/test-box.R ================================================ loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) test_that("box module coverage is reported", { withr::with_dir("Testbox", { cov <- as.data.frame(file_coverage( source_files = "app/app.R", test_files = list.files("tests/testthat", full.names = TRUE))) expect_equal(cov$value, c(5, 2, 3, 3)) expect_equal(cov$first_line, c(5, 6, 8, 13)) expect_equal(cov$last_line, c(5, 6, 8, 13)) expect_true("a" %in% cov$functions) expect_true("private_function" %in% cov$functions) }) }) ================================================ FILE: tests/testthat/test-box_attached_modules_functions-R6.R ================================================ loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) test_that("R6 box attached module coverage is reported", { # Similar to test-R6.R, there is some sort of bug that causes this test # to fail during R CMD check in R-devel, not sure why, and can't reproduce # it interactively skip_if(is_r_devel()) withr::with_dir("Testbox_attached_modules_functions_R6", { cov <- as.data.frame(file_coverage( source_files = "app/app.R", test_files = list.files("tests/testthat", full.names = TRUE))) expect_equal(cov$value, c(1, 1)) expect_equal(cov$first_line, c(5, 8)) expect_equal(cov$last_line, c(5, 8)) expect_true("show" %in% cov$functions) }) }) ================================================ FILE: tests/testthat/test-box_attached_modules_functions.R ================================================ loaded_mods <- loadNamespace("box")$loaded_mods rm(list = ls(loaded_mods), envir = loaded_mods) test_that("box attached module coverage is reported", { withr::with_dir("Testbox_attached_modules_functions", { cov <- as.data.frame(file_coverage( source_files = "app/app.R", test_files = list.files("tests/testthat", full.names = TRUE))) expect_equal(cov$value, c(20, 8, 12, 3, 0)) expect_equal(cov$first_line, c(5, 6, 8, 14, 18)) expect_equal(cov$last_line, c(5, 6, 8, 14, 18)) expect_true("a" %in% cov$functions) expect_true("private_function" %in% cov$functions) }) }) ================================================ FILE: tests/testthat/test-braceless.R ================================================ test_that("if", { f <- 'f <- function(x) { if (FALSE) FALSE # never covered, used as anchor if (x) TRUE else FALSE }' cov <- code_coverage(f, "f(TRUE)") expect_equal(zero_coverage(code_coverage(f, "f(TRUE)"))$line, c(3, 7)) expect_equal(zero_coverage(code_coverage(f, "f(FALSE)"))$line, c(3, 5)) expect_equal(zero_coverage(code_coverage(f, "f(TRUE);f(FALSE)"))$line, 3) }) test_that("nested if else", { f <- 'f <- function(x) { if (FALSE) FALSE # never covered, used as anchor else if (x) TRUE else FALSE }' cov <- code_coverage(f, "f(TRUE)") expect_equal(zero_coverage(code_coverage(f, "f(TRUE)"))$line, c(3, 7)) expect_equal(zero_coverage(code_coverage(f, "f(FALSE)"))$line, c(3, 5)) expect_equal(zero_coverage(code_coverage(f, "f(TRUE);f(FALSE)"))$line, 3) }) test_that("switch", { f <- 'f <- function(x) { switch(x, a = 1, b = 2, c = d <- 1 ) }' expect_equal(length(zero_coverage(code_coverage(f, "f(\"a\"); f(\"b\")"))$line), 1) expect_equal(length(zero_coverage(code_coverage(f, "f(\"a\"); f(\"c\")"))$line), 1) expect_equal(diff(zero_coverage(code_coverage(f, "f(\"a\"); f(\"d\")"))$line), 1) }) test_that("switch with default value", { f <- 'f <- function(x) { switch(x, a = 1, b = 2, c = d <- 1, NULL ) }' expect_equal(length(zero_coverage(code_coverage(f, "f(\"a\"); f(\"b\"); f(\"c\")"))$line), 1) expect_equal(length(zero_coverage(code_coverage(f, "f(\"a\"); f(\"c\")"))$line), 2) }) test_that("switch with drop through", { f <- 'f <- function(x) { switch(x, a = , b = 2, c = d <- 1, NULL ) }' res <- as.data.frame(code_coverage(f, 'f("a");f("b");f("c")')) expect_equal(res$first_line, c(2, 4, 5, 6)) expect_equal(res$value, c(3, 2, 1, 0)) }) test_that("switch with ellipses", { f <- 'f <- function(x, ...) { switch(typeof(x), ...) }' res <- as.data.frame(code_coverage(f, "f(\"a\", character = TRUE)")) expect_equal(res$first_line, 2) expect_equal(res$value, 1) f <- 'f <- function(x, ...) { switch(typeof(x), ..., character = TRUE) }' res <- as.data.frame(code_coverage(f, "f(\"a\")")) expect_equal(res$first_line, c(2, 4)) expect_equal(res$value, c(1, 1)) }) ================================================ FILE: tests/testthat/test-cobertura.R ================================================ test_that("it works with coverage objects", { tmp <- tempfile() cov <- package_coverage(test_path("TestSummary")) attr(cov, "package")$path <- "/dummy/directory" to_cobertura(cov, filename = tmp) expect_equal( readLines(tmp)[c(-1, -2, -3)], readLines(test_path("cobertura.xml"))[c(-1, -2, -3)] ) }) ================================================ FILE: tests/testthat/test-codecov.R ================================================ ci_vars <- c( "APPVEYOR" = NA, "APPVEYOR_ACCOUNT_NAME" = NA, "APPVEYOR_PROJECT_SLUG" = NA, "APPVEYOR_BUILD_VERSION" = NA, "APPVEYOR_JOB_ID" = NA, "APPVEYOR_REPO_BRANCH" = NA, "APPVEYOR_REPO_COMMIT" = NA, "APPVEYOR_REPO_NAME" = NA, "BRANCH_NAME" = NA, "BUILD_NUMBER" = NA, "BUILD_URL" = NA, "CI" = NA, "CIRCLECI" = NA, "CIRCLE_BRANCH" = NA, "CIRCLE_BUILD_NUM" = NA, "CIRCLE_PROJECT_REPONAME" = NA, "CIRCLE_PROJECT_USERNAME" = NA, "CIRCLE_SHA1" = NA, "CI_BRANCH" = NA, "CI_BUILD_NUMBER" = NA, "CI_BUILD_URL" = NA, "CI_COMMIT_ID" = NA, "CI_NAME" = NA, "CODECOV_TOKEN" = NA, "DRONE" = NA, "DRONE_BRANCH" = NA, "DRONE_BUILD_NUMBER" = NA, "DRONE_BUILD_URL" = NA, "DRONE_COMMIT" = NA, "GIT_BRANCH" = NA, "GIT_COMMIT" = NA, "GITHUB_ACTION" = NA, "GITHUB_REPOSTIORY" = NA, "JENKINS_URL" = NA, "REVISION" = NA, "SEMAPHORE" = NA, "SEMAPHORE_BUILD_NUMBER" = NA, "SEMAPHORE_REPO_SLUG" = NA, "TRAVIS" = NA, "TRAVIS_BRANCH" = NA, "TRAVIS_COMMIT" = NA, "TRAVIS_JOB_ID" = NA, "TRAVIS_JOB_NUMBER" = NA, "TRAVIS_PULL_REQUEST" = NA, "TRAVIS_REPO_SLUG" = NA, "WERCKER_GIT_BRANCH" = NA, "WERCKER_GIT_COMMIT" = NA, "WERCKER_GIT_OWNER" = NA, "WERCKER_GIT_REPOSITORY" = NA, "WERCKER_MAIN_PIPELINE_STARTED" = NA ) cov <- package_coverage(test_path("TestS4")) test_that("it generates a properly formatted json file", { withr::local_envvar(ci_vars) local_mocked_bindings( RETRY = function(...) list(...), content = identity, local_branch = function(dir) "master", current_commit = function(dir) "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" ) res <- codecov(coverage = cov) json <- jsonlite::fromJSON(res$body) expect_match(json$files$name, "R/TestS4.R") expect_equal( json$files$coverage[[1]], c( NA, NA, NA, NA, NA, NA, NA, 5, 2, NA, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA ) ) expect_equal(json$uploader, "R") }) test_that("it adds a flags argument to the query if specified", { withr::local_envvar(ci_vars) local_mocked_bindings( RETRY = function(...) list(...), content = identity, local_branch = function(dir) "master", current_commit = function(dir) "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" ) res <- codecov(coverage = cov, flags = "R") expect_equal(res$query$flags, "R") }) test_that("it works with local repos", { withr::local_envvar(ci_vars) local_mocked_bindings( RETRY = function(...) list(...), content = identity, local_branch = function(dir) "master", current_commit = function(dir) "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" ) res <- codecov(coverage = cov) expect_match(res$url, "2") # nolint expect_match(res$query$branch, "master") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) test_that("it works with local repos and explicit branch and commit", { withr::local_envvar(ci_vars) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov, branch = "master", commit = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") expect_match(res$url, "/upload/v2") # nolint expect_match(res$query$branch, "master") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) test_that("it adds the token to the query if available", { withr::local_envvar(c(ci_vars, "CODECOV_TOKEN" = "codecov_test")) local_mocked_bindings( RETRY = function(...) list(...), content = identity, local_branch = function(dir) "master", current_commit = function(dir) "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" ) res <- codecov(coverage = cov) expect_match(res$url, "/upload/v2") # nolint expect_match(res$query$branch, "master") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") expect_match(res$query$token, "codecov_test") }) test_that("it looks for token in a .yml file", { withr::local_envvar(ci_vars) local_mocked_bindings( RETRY = function(...) list(...), content = identity, local_branch = function(dir) "master", current_commit = function(dir) "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" ) res <- codecov(coverage = cov) expect_match(res$url, "/upload/v2") # nolint expect_match(res$query$branch, "master") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") expect_match(res$query$token, "codecov_token_from_yaml") }) test_that("it works with jenkins", { withr::local_envvar(c( ci_vars, "JENKINS_URL" = "jenkins.com", "GIT_BRANCH" = "test", "GIT_COMMIT" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3", "BUILD_NUMBER" = "1", "BUILD_URL" = "http://test.com/tester/test" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "jenkins") expect_match(res$query$branch, "test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") expect_match(res$query$build, "1") expect_match(res$query$build_url, "http://test.com/tester/test") }) test_that("it works with travis normal builds", { withr::local_envvar(c( ci_vars, "CI" = "true", "TRAVIS" = "true", "TRAVIS_PULL_REQUEST" = "false", "TRAVIS_REPO_SLUG" = "tester/test", "TRAVIS_BRANCH" = "master", "TRAVIS_JOB_NUMBER" = "100", "TRAVIS_JOB_ID" = "10", "TRAVIS_COMMIT" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "travis") expect_match(res$query$branch, "master") expect_match(res$query$job, "10") expect_match(res$query$pr, "") expect_match(res$query$slug, "tester/test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") expect_match(res$query$build, "100") }) test_that("it works with travis pull requests", { withr::local_envvar(c( ci_vars, "CI" = "true", "TRAVIS" = "true", "TRAVIS_PULL_REQUEST" = "5", "TRAVIS_REPO_SLUG" = "tester/test", "TRAVIS_BRANCH" = "master", "TRAVIS_JOB_NUMBER" = "100", "TRAVIS_JOB_ID" = "10", "TRAVIS_COMMIT" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "travis") expect_match(res$query$branch, "master") expect_match(res$query$job, "10") expect_match(res$query$pr, "5") expect_match(res$query$slug, "tester/test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") expect_match(res$query$build, "100") }) test_that("it works with codeship", { withr::local_envvar(c( ci_vars, "CI" = "true", "CI_NAME" = "codeship", "CI_BRANCH" = "master", "CI_BUILD_NUMBER" = "5", "CI_BUILD_URL" = "http://test.com/tester/test", "CI_COMMIT_ID" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "codeship") expect_match(res$query$branch, "master") expect_match(res$query$build, "5") expect_match(res$query$build_url, "http://test.com/tester/test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) test_that("it works with circleci", { withr::local_envvar(c( ci_vars, "CI" = "true", "CIRCLECI" = "true", "CIRCLE_BRANCH" = "master", "CIRCLE_BUILD_NUM" = "5", "CIRCLE_PROJECT_USERNAME" = "tester", "CIRCLE_PROJECT_REPONAME" = "test", "CIRCLE_SHA1" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "circleci") expect_match(res$query$branch, "master") expect_match(res$query$build, "5") expect_match(res$query$owner, "tester") expect_match(res$query$repo, "test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) test_that("it works with semaphore", { withr::local_envvar(c( ci_vars, "CI" = "true", "SEMAPHORE" = "true", "BRANCH_NAME" = "master", "SEMAPHORE_BUILD_NUMBER" = "5", "SEMAPHORE_REPO_SLUG" = "tester/test", "REVISION" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "semaphore") expect_match(res$query$branch, "master") expect_match(res$query$build, "5") expect_match(res$query$owner, "tester") expect_match(res$query$repo, "test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) test_that("it works with drone", { withr::local_envvar(c( ci_vars, "CI" = "true", "DRONE" = "true", "DRONE_BRANCH" = "master", "DRONE_BUILD_NUMBER" = "5", "DRONE_BUILD_URL" = "http://test.com/tester/test", "DRONE_COMMIT" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "drone.io") expect_match(res$query$branch, "master") expect_match(res$query$build, "5") expect_match(res$query$build_url, "http://test.com/tester/test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) test_that("it works with AppVeyor", { withr::local_envvar(c( ci_vars, "CI" = "True", "APPVEYOR" = "True", "APPVEYOR_REPO_NAME" = "testspace/test", "APPVEYOR_REPO_BRANCH" = "master", "APPVEYOR_ACCOUNT_NAME" = "testuser", # not necessarily the same as testspace above "APPVEYOR_PROJECT_SLUG" = "test", "APPVEYOR_BUILD_VERSION" = "1.0.5", "APPVEYOR_JOB_ID" = "225apqggpmlkn5pr", "APPVEYOR_REPO_COMMIT" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "appveyor") expect_match(res$query$branch, "master") expect_match(res$query$job, "testuser/test/1.0.5") expect_match(res$query$build, "225apqggpmlkn5pr") expect_match(res$query$slug, "testspace/test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) test_that("it works with Wercker", { withr::local_envvar(c( ci_vars, "CI" = "true", "WERCKER_GIT_BRANCH" = "master", "WERCKER_MAIN_PIPELINE_STARTED" = "5", "WERCKER_GIT_OWNER" = "tester", "WERCKER_GIT_REPOSITORY" = "test", "WERCKER_GIT_COMMIT" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "wercker") expect_match(res$query$branch, "master") expect_match(res$query$build, "5") expect_match(res$query$owner, "tester") expect_match(res$query$repo, "test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) test_that("it works with GitLab", { withr::local_envvar(c( ci_vars, "CI" = "true", "CI_SERVER_NAME" = "GitLab CI", "CI_BUILD_ID" = "5", "CI_BUILD_REPO" = "https://gitlab.com/tester/test.git", "CI_BUILD_REF_NAME" = "master", "CI_BUILD_REF" = "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity ) res <- codecov(coverage = cov) expect_match(res$query$service, "gitlab") expect_match(res$query$branch, "master") expect_match(res$query$build, "5") expect_match(res$query$slug, "tester/test") expect_match(res$query$commit, "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3") }) ================================================ FILE: tests/testthat/test-corner-cases.R ================================================ test_that("corner-cases are handled as expected", { expect_warning(withr::with_output_sink(tempfile(), { cov <- file_coverage("corner-cases.R", "corner-cases-test.R") })) expect_equal(as.data.frame(cov), readRDS("corner-cases.Rds")) }) ================================================ FILE: tests/testthat/test-coveralls.R ================================================ ci_vars <- c( "APPVEYOR" = NA, "APPVEYOR_BUILD_NUMBER" = NA, "APPVEYOR_REPO_BRANCH" = NA, "APPVEYOR_REPO_COMMIT" = NA, "APPVEYOR_REPO_NAME" = NA, "BRANCH_NAME" = NA, "BUILD_NUMBER" = NA, "BUILD_URL" = NA, "CI" = NA, "CIRCLECI" = NA, "CIRCLE_BRANCH" = NA, "CIRCLE_BUILD_NUM" = NA, "CIRCLE_PROJECT_REPONAME" = NA, "CIRCLE_PROJECT_USERNAME" = NA, "CIRCLE_SHA1" = NA, "CI_BRANCH" = NA, "CI_BUILD_NUMBER" = NA, "CI_BUILD_URL" = NA, "CI_COMMIT_ID" = NA, "CI_NAME" = NA, "CODECOV_TOKEN" = NA, "DRONE" = NA, "DRONE_BRANCH" = NA, "DRONE_BUILD_NUMBER" = NA, "DRONE_BUILD_URL" = NA, "DRONE_COMMIT" = NA, "GIT_BRANCH" = NA, "GIT_COMMIT" = NA, "JENKINS_URL" = NA, "REVISION" = NA, "SEMAPHORE" = NA, "SEMAPHORE_BUILD_NUMBER" = NA, "SEMAPHORE_REPO_SLUG" = NA, "TRAVIS" = NA, "TRAVIS_BRANCH" = NA, "TRAVIS_COMMIT" = NA, "TRAVIS_JOB_ID" = NA, "TRAVIS_JOB_NUMBER" = NA, "TRAVIS_PULL_REQUEST" = NA, "TRAVIS_REPO_SLUG" = NA, "WERCKER_GIT_BRANCH" = NA, "WERCKER_GIT_COMMIT" = NA, "WERCKER_GIT_OWNER" = NA, "WERCKER_GIT_REPOSITORY" = NA, "WERCKER_MAIN_PIPELINE_STARTED" = NA ) read_file <- function(file) paste(collapse = "\n", readLines(file)) cov <- package_coverage(test_path("TestS4")) test_that("coveralls generates a properly formatted json file", { withr::local_envvar(c( ci_vars, "CI_NAME" = "FAKECI" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity, upload_file = function(file) readChar(file, file.info(file)$size) ) res <- coveralls(coverage = cov) json <- jsonlite::fromJSON(res$body$json_file) expect_equal(nrow(json$source_files), 1) expect_equal(json$service_name, "fakeci") expect_match(json$source_files$name, rex::rex("R", one_of("/", "\\"), "TestS4.R")) expect_equal(json$source_files$source, read_file("TestS4/R/TestS4.R")) expect_equal(json$source_files$source_digest, "1233f2eca5d84704101cb9d9b928f2e9") expect_equal( json$source_files$coverage[[1]], c( NA, NA, NA, NA, NA, NA, 5, 2, NA, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA ) ) }) test_that("coveralls can spawn a job using repo_token", { withr::local_envvar(c( ci_vars, "CI_NAME" = "DRONE" )) local_mocked_bindings( RETRY = function(...) list(...), content = identity, upload_file = function(file) readChar(file, file.info(file)$size), system_output = function(...) paste0(c("a", "b", "c", "d", "e", "f"), collapse = "\n") ) res <- coveralls(coverage = cov, repo_token = "mytoken") json <- jsonlite::fromJSON(res$body$json_file) expect_equal(is.null(json$git), FALSE) expect_equal(nrow(json$source_files), 1) # service_name set #285 expect_equal(json$service_name, "drone") expect_equal(json$repo_token, "mytoken") expect_match(json$source_files$name, rex::rex("R", one_of("/", "\\"), "TestS4.R")) expect_equal(json$source_files$source, read_file("TestS4/R/TestS4.R")) expect_equal(json$source_files$source_digest, "1233f2eca5d84704101cb9d9b928f2e9") expect_equal( json$source_files$coverage[[1]], c( NA, NA, NA, NA, NA, NA, 5, 2, NA, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA ) ) }) test_that("generates correct payload for Drone and Jenkins", { withr::local_envvar(c( ci_vars, "CI_NAME" = "FAKECI", "CI_BRANCH" = "fakebranch", "CI_REMOTE" = "covr" )) local_mocked_bindings( system_output = function(...) paste0(c("a", "b", "c", "d", "e", "f"), collapse = "\n") ) git <- jenkins_git_info() expect_equal(git$head$id, jsonlite::unbox("a")) expect_equal(git$head$author_name, jsonlite::unbox("b")) expect_equal(git$head$author_email, jsonlite::unbox("c")) expect_equal(git$head$commiter_name, jsonlite::unbox("d")) expect_equal(git$head$commiter_email, jsonlite::unbox("e")) expect_equal(git$head$message, jsonlite::unbox("f")) expect_equal(git$branch, jsonlite::unbox("fakebranch")) expect_equal(git$remotes[[1]]$name, jsonlite::unbox("origin")) expect_equal(git$remotes[[1]]$url, jsonlite::unbox("covr")) }) test_that("coveralls can spawn a job using repo_token - travis-pro #285", { withr::local_envvar( c(ci_vars, "CI_NAME" = "travis-pro") ) local_mocked_bindings( RETRY = function(...) list(...), content = identity, upload_file = function(file) readChar(file, file.info(file)$size), system_output = function(...) paste0(c("a", "b", "c", "d", "e", "f"), collapse = "\n") ) res <- coveralls(coverage = cov, repo_token = "mytoken") json <- jsonlite::fromJSON(res$body$json_file) expect_equal(is.null(json$git), FALSE) expect_equal(nrow(json$source_files), 1) expect_equal(json$service_name, "travis-pro") expect_equal(json$repo_token, "mytoken") expect_match(json$source_files$name, rex::rex("R", one_of("/", "\\"), "TestS4.R")) expect_equal(json$source_files$source, read_file("TestS4/R/TestS4.R")) expect_equal(json$source_files$source_digest, "1233f2eca5d84704101cb9d9b928f2e9") expect_equal( json$source_files$coverage[[1]], c( NA, NA, NA, NA, NA, NA, 5, 2, NA, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 1, NA ) ) # git correct #285 expect_equal(json$git$head$id, "a") expect_equal(json$git$head$author_name, "b") expect_equal(json$git$head$author_email, "c") expect_equal(json$git$head$commiter_name, "d") expect_equal(json$git$head$commiter_email, "e") expect_equal(json$git$head$message, "f") }) ================================================ FILE: tests/testthat/test-covr.R ================================================ test_that("function_coverage", { withr::with_options(c(keep.source = TRUE), { f <- function(x) { x + 1 } expect_equal(as.numeric(function_coverage("f", env = environment(f))[[1]]$value), 0) expect_equal(as.numeric(function_coverage("f", env = environment(f), f(1))[[1]]$value), 1) expect_equal(as.numeric(function_coverage("f", env = environment(f), f(1), f(1))[[1]]$value), 2) }) }) test_that("function_coverage identity function", { withr::with_options(c(keep.source = TRUE), { fun <- function(x) { x } cov_num <- function(...) { as.numeric(function_coverage("fun", env = environment(fun), ...)[[1]]$value) } expect_equal(cov_num(), 0) expect_equal(cov_num(fun(1)), 1) }) }) test_that("function_coverage return last expr", { withr::with_options(c(keep.source = TRUE), { fun <- function(x = 1) { x x <- 1 } cov_fun <- function(...) { vdapply(function_coverage("fun", env = environment(fun), ...), "[[", "value") } expect_equal(as.numeric(cov_fun()), c(0L, 0L)) expect_equal(as.numeric(cov_fun(fun())), c(1L, 1L)) }) }) test_that("duplicated first_line", { withr::with_options(c(keep.source = TRUE), { fun <- function() { res <- lapply(1:2, function(x) { x + 1 }) # nolint } cov <- function_coverage("fun", env = environment(fun)) first_lines <- as.data.frame(cov)$first_line expect_equal(length(first_lines), 2) expect_equal(first_lines[1], first_lines[2]) }) }) test_that("trace calls handles all possibilities", { expr <- expression(y <- x * 10) expect_equal(trace_calls(expr), expr) expect_equal(trace_calls(list(expr)), list(expr)) }) test_that("show_failures shows as much text as it can from the end", { withr::with_options(c(warning.length = 300), { td <- tempfile() dir.create(td) out <- file.path(td, "test.Rout.fail") on.exit(unlink(td, recursive = TRUE)) writeLines( "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.", out ) # Expect the error to contain the end of the file expect_error(show_failures(td), "eleifend conubia pellentesque viverra.", fixed = TRUE, class = "covr_error") }) }) ================================================ FILE: tests/testthat/test-exclusions.R ================================================ exclude_ops <- list(exclude_pattern = "#TeSt_NoLiNt", exclude_start = "#TeSt_NoLiNt_StArT", exclude_end = "#TeSt_NoLiNt_EnD") test_that("it returns an empty vector if there are no exclusions", { t1 <- c("this", "is", "a", "test") expect_equal(do.call(parse_exclusions, c(list(t1), exclude_ops, recursive = F)), numeric(0)) }) test_that("it returns the line if one line is excluded", { t1 <- c("this", "is #TeSt_NoLiNt", "a", "test") expect_equal(do.call(parse_exclusions, c(list(t1), exclude_ops)), c(2)) t2 <- c("this", "is #TeSt_NoLiNt", "a", "test #TeSt_NoLiNt") expect_equal(do.call(parse_exclusions, c(list(t2), exclude_ops)), c(2, 4)) }) test_that("it returns all lines between start and end", { t1 <- c("this #TeSt_NoLiNt_StArT", "is", "a #TeSt_NoLiNt_EnD", "test") expect_equal(do.call(parse_exclusions, c(list(t1), exclude_ops)), c(1, 2, 3)) t2 <- c("this #TeSt_NoLiNt_StArT", "is", "a #TeSt_NoLiNt_EnD", "test", "of", "the #TeSt_NoLiNt_StArT", "emergency #TeSt_NoLiNt_EnD", "broadcast", "system") expect_equal(do.call(parse_exclusions, c(list(t2), exclude_ops)), c(1, 2, 3, 6, 7)) }) test_that("it ignores exclude coverage lines within start and end", { t1 <- c("this #TeSt_NoLiNt_StArT", "is #TeSt_NoLiNt", "a #TeSt_NoLiNt_EnD", "test") expect_equal(do.call(parse_exclusions, c(list(t1), exclude_ops)), c(1, 2, 3)) }) test_that("it throws an error if start and end are unpaired", { t1 <- c("this #TeSt_NoLiNt_StArT", "is #TeSt_NoLiNt", "a", "test") expect_error(do.call(parse_exclusions, c(list(t1), exclude_ops)), "but only") }) expect_equal_vals <- function(x, y) { testthat::expect_equal(unname(x), unname(y)) } test_that("it merges two NULL or empty objects as an empty list", { expect_equal(normalize_exclusions(c(NULL, NULL)), list()) expect_equal(normalize_exclusions(c(NULL, list())), list()) expect_equal(normalize_exclusions(c(list(), NULL)), list()) expect_equal(normalize_exclusions(c(list(), list())), list()) }) test_that("it returns the object if the other is NULL", { t1 <- list(a = 1:10) expect_equal_vals(normalize_exclusions(c(t1, NULL)), t1) expect_equal_vals(normalize_exclusions(c(NULL, t1)), t1) }) test_that("it returns the union of two non-overlapping lists", { t1 <- list(a = 1:10) t2 <- list(a = 20:30) expect_equal_vals(normalize_exclusions(c(t1, t2)), list(a = c(1:10, 20:30))) }) test_that("it returns the union of two overlapping lists", { t1 <- list(a = 1:10) t2 <- list(a = 5:15) expect_equal_vals(normalize_exclusions(c(t1, t2)), list(a = 1:15)) }) test_that("it adds names if needed", { t1 <- list(a = 1:10) t2 <- list(b = 5:15) expect_equal_vals(normalize_exclusions(c(t1, t2)), list(a = 1:10, b = 5:15)) }) test_that("it handles full file exclusions", { expect_equal_vals(normalize_exclusions(list("a")), list(a = Inf)) expect_equal_vals(normalize_exclusions(list("a", b = 1)), list(a = Inf, b = 1)) }) test_that("it handles redundant lines", { expect_equal_vals(normalize_exclusions(list(a = c(1, 1, 1:10))), list(a = 1:10)) expect_equal_vals(normalize_exclusions(list(a = c(1, 1, 1:10), b = 1:10)), list(a = 1:10, b = 1:10)) }) test_that("it handles redundant files", { expect_equal_vals(normalize_exclusions(list(a = c(1:10), a = c(10:20))), list(a = 1:20)) }) cov <- package_coverage("TestSummary") test_that("it excludes lines", { expect_equal(length(cov), 4) expect_equal(length(exclude(cov, list("R/TestSummary.R" = 5), path = "TestSummary")), 3) expect_equal(length(exclude(cov, list("R/TestSummary.R" = 13), path = "TestSummary")), 3) }) test_that("it preserves the class", { expect_equal(class(exclude(cov, NULL, path = "TestSummary")), class(cov)) expect_equal(class(exclude(cov, list("R/TestSummary.R" = 3), path = "TestSummary")), class(cov)) }) test_that("function exclusions work", { expect_equal(length(exclude(cov, NULL, "^test")), 1) expect_equal(length(exclude(cov, NULL, c("^test", "dont"))), 0) }) test_that("it excludes properly", { t1 <- package_coverage("TestExclusion") expect_equal(length(t1), 3) t1 <- package_coverage("TestExclusion", line_exclusions = "R/TestExclusion.R") expect_equal(length(t1), 0) }) test_that("it returns NULL if empty or no file exclusions", { expect_equal(file_exclusions(NULL, ""), NULL) expect_equal(file_exclusions(list("a" = c(1, 2))), NULL) expect_equal(file_exclusions(list("a" = c(1, 2), "b" = c(3, 4))), NULL) }) test_that("it returns a normalizedPath if the file can be found", { expect_match(file_exclusions(list("test-exclusions.R"), "."), "test-exclusions.R") expect_match( file_exclusions(list("testthat/test-exclusions.R", "testthat.R"), ".."), rex::rex(or("test-exclusions.R", "testthat.R"))) }) describe("covrignore", { it("returns NULL if empty or no file exclusions", { withr::with_options(list(covr.covrignore = ""), expect_equal(parse_covr_ignore(), NULL) ) withr::with_envvar(list("COVR_COVRIGNORE" = ""), expect_equal(parse_covr_ignore(), NULL) ) tf <- tempfile() on.exit(unlink(tf)) writeLines("", tf) withr::with_options(list(covr.covrignore = tf), expect_equal(parse_covr_ignore(), NULL) ) withr::with_envvar(list("COVR_COVRIGNORE" = tf), expect_equal(parse_covr_ignore(), NULL) ) }) it("returns the file if file exists", { td <- tempfile() on.exit(unlink(td, recursive = TRUE)) dir.create(td) writeLines("foo.c", file.path(td, ".covrignore")) writeLines("", file.path(td, "foo.c")) withr::with_dir(td, { expect_equal(parse_covr_ignore(), "foo.c") }) }) it("handles globs correctly", { td <- tempfile() on.exit(unlink(td, recursive = TRUE)) dir.create(td) writeLines("foo.*", file.path(td, ".covrignore")) writeLines("", file.path(td, "foo.c")) writeLines("", file.path(td, "foo.o")) withr::with_dir(td, { expect_equal(parse_covr_ignore(), c("foo.c", "foo.o")) }) }) it("handles directories correctly", { td <- tempfile() on.exit(unlink(td, recursive = TRUE)) dir.create(td) dir.create(file.path(td, "src")) writeLines("src", file.path(td, ".covrignore")) writeLines("", file.path(td, "src", "foo.c")) writeLines("", file.path(td, "src", "foo.o")) withr::with_dir(td, { expect_equal(gsub("//", "/", parse_covr_ignore()), c("src/foo.c", "src/foo.o")) }) }) }) ================================================ FILE: tests/testthat/test-file_coverage.R ================================================ s1 <- tempfile() t1 <- tempfile() writeLines(con = s1, "a <- function(x) { x + 1 } b <- function(x) { if (x > 1) TRUE else FALSE }") writeLines(con = t1, "a(1) a(2) a(3) b(0) b(1) b(2)") on.exit(unlink(c(s1, t1))) test_that("it works on single files", { cov <- file_coverage(s1, t1) cov_d <- as.data.frame(cov) expect_equal(cov_d$functions, c("a", "b", "b", "b")) expect_equal(cov_d$value, c(3, 3, 1, 2)) }) ================================================ FILE: tests/testthat/test-functions.R ================================================ test_that("function_coverage generates output", { env <- new.env() withr::with_options(c("keep.source" = TRUE), { eval(parse(text = "fun <- function(x) { if (isTRUE(x)) { 1 } else { 2 } }"), envir = env) }) t1 <- function_coverage("fun", env = env) expect_equal(length(t1), 3) expect_equal(length(exclude(t1)), 3) expect_equal(length(exclude(t1, "")), 0) expect_equal(length(exclude(t1, list("" = 3))), 2) }) ================================================ FILE: tests/testthat/test-gcov.R ================================================ test_that("parse_gcov parses files properly", { local_mocked_bindings( # functions called within parse_gcov file.exists = function(path) TRUE, normalize_path = function(path) "simple.c", line_coverages = function(source_file, matches, values, ...) values ) with_mocked_bindings( readLines = function(x) { " -: 0:Source:simple.c" }, expect_equal(parse_gcov("hi.c.gcov"), numeric()) ) with_mocked_bindings( readLines = function(x) { c( " -: 0:Source:simple.c", " -: 1:#define USE_RINTERNALS" ) }, expect_equal(parse_gcov("hi.c.gcov"), numeric()) ) with_mocked_bindings( readLines = function(x) { c( " -: 0:Source:simple.c", " -: 0:Graph:simple.gcno", " -: 0:Data:simple.gcda", " -: 0:Runs:1", " -: 0:Programs:1", " -: 1:#define USE_RINTERNALS", " -: 2:#include ", " -: 3:#include ", " -: 4:#include ", " -: 5:", " 4: 6:SEXP simple_(SEXP x) {" ) }, expect_equal(parse_gcov("hi.c.gcov"), 4) ) with_mocked_bindings( readLines = function(x) { c( " -: 0:Source:simple.c", " -: 0:Graph:simple.gcno", " -: 0:Data:simple.gcda", " -: 0:Runs:1", " -: 0:Programs:1", " -: 1:#define USE_RINTERNALS", " -: 2:#include ", " -: 3:#include ", " -: 4:#include ", " -: 5:", " 4: 6:SEXP simple_(SEXP x) {", " -: 7: }", " #####: 8: pout[0] = 0;" ) }, expect_equal(parse_gcov("hi.c.gcov"), c(4, 0)) ) }) test_that("clean_gcov correctly clears files", { dir <- file.path(tempfile(), "src") dir.create(dir, recursive = TRUE) file.create(file.path(dir, c("simple.c", "Makevars", "simple.c.gcov", "simple.gcda", "simple.gcno"))) expect_identical(list.files(dir), sort(c("simple.c", "Makevars", "simple.c.gcov", "simple.gcda", "simple.gcno"))) clean_gcov(dirname(dir)) expect_identical(list.files(dir), sort(c("simple.c", "Makevars"))) }) ================================================ FILE: tests/testthat/test-gitlab.R ================================================ test_that("gitlab", { cov <- package_coverage("TestS4") on.exit(unlink("TestS4/public", recursive = TRUE), add = TRUE) expect_error(gitlab(coverage = cov), NA) expect_true(file.exists("TestS4/public/coverage.html")) }) ================================================ FILE: tests/testthat/test-memoised.R ================================================ s1 <- tempfile() t1 <- tempfile() writeLines(con = s1, "a <- memoise::memoise(function(x) { x + 1 })") writeLines(con = t1, " a(1) a(1) a(1) a(1) a(2) a(3)") on.exit(unlink(c(s1, t1))) test_that("it works on Vectorized functions", { cov <- file_coverage(s1, t1) cov_d <- as.data.frame(cov) expect_equal(cov_d$functions, "a") expect_equal(cov_d$value, 3) }) ================================================ FILE: tests/testthat/test-null.R ================================================ test_that("coverage of functions with NULL constructs", { f1 <- function() NULL f2 <- function() { NULL } f3 <- function() { if (FALSE) { NULL } } f4 <- function() { if (FALSE) NULL } cv1 <- function_coverage(f1, f1()) expect_equal(percent_coverage(cv1), 100) cv2 <- function_coverage(f2, f2()) expect_equal(percent_coverage(cv2), 100) cv3 <- function_coverage(f3, f3()) expect_equal(percent_coverage(cv3), 50) cv4 <- function_coverage(f4, f4()) expect_equal(percent_coverage(cv4), 50) }) ================================================ FILE: tests/testthat/test-package_coverage.R ================================================ test_that("package_coverage returns an error if the path does not exist", { expect_error(package_coverage("blah")) }) test_that("package_coverage returns an error if the type is incorrect", { expect_error( package_coverage("TestPrint", type = "blah"), "'arg' should be one of") expect_error(package_coverage("TestPrint", type = c("blah", "test")), "'arg' should be one of") }) test_that("package_coverage can return just tests and vignettes", { cov <- package_coverage("TestPrint", type = c("tests", "vignettes"), combine_types = FALSE) expect_equal(names(cov), c("tests", "vignettes")) }) test_that("package_coverage with type == 'all' returns test, vignette and example coverage", { cov <- package_coverage("TestPrint", type = "all", combine_types = FALSE) expect_equal(names(cov), c("tests", "vignettes", "examples")) }) test_that("package_coverage with type == 'none' runs no test code", { cov <- package_coverage("TestS4", type = "none") expect_equal(percent_coverage(cov), 0.00) }) test_that("package_coverage runs additional test code", { cov <- package_coverage("TestS4", type = "none", code = c("a(1)", "a(2)")) expect_gt(percent_coverage(cov), 0.00) }) ================================================ FILE: tests/testthat/test-parallel.R ================================================ test_that("mcparallel without the fix", { skip_on_os("windows") cov <- withr::with_options(list(covr.fix_parallel_mcexit = FALSE), package_coverage("TestParallel", type = "test")) # only the non parallel code is covered expect_equal(floor(percent_coverage(cov)), 33) }) test_that("mcparallel with the fix", { skip_on_os("windows") # using auto detection cov <- package_coverage(test_path("TestParallel"), type = "test") # only the non parallel code is covered expect_equal(percent_coverage(cov), 100) }) test_that("uses_parallel", { pkg <- covr:::as_package("TestParallel") expect_true(covr:::uses_parallel(pkg)) pkg <- covr:::as_package("TestSummary") expect_false(covr:::uses_parallel(pkg)) }) test_that("should_enable_parallel_mcexit_fix", { skip_on_os("windows") on.exit({ Sys.unsetenv('COVR_FIX_PARALLEL_MCEXIT') options(covr.fix_parallel_mcexit = NULL) }, add = TRUE ) grid <- expand.grid( var = c(NA, TRUE, FALSE), option = c(NA, TRUE, FALSE), pkg = c("TestParallel", "TestSummary"), stringsAsFactors = FALSE) grid$res <- with(grid, ifelse(!is.na(var), var, ifelse(!is.na(option), option, pkg == "TestParallel") )) .test_config <- function(var, option, pkgname) { if (is.na(var)) Sys.unsetenv('COVR_FIX_PARALLEL_MCEXIT') else Sys.setenv(COVR_FIX_PARALLEL_MCEXIT = var) if (is.na(option)) options(covr.fix_parallel_mcexit = NULL) else options(covr.fix_parallel_mcexit = option) pkg <- covr:::as_package(pkgname) covr:::should_enable_parallel_mcexit_fix(pkg) } res <- with(grid, vapply(1:nrow(grid), function(i) .test_config(var[i], option[i], pkg[i]), TRUE)) expect_identical(res, grid$res) }) ================================================ FILE: tests/testthat/test-print.R ================================================ test_that("format_percentage works as expected", { expect_equal(format_percentage(0), cli::col_red("0.00%")) expect_equal(format_percentage(25), cli::col_red("25.00%")) expect_equal(format_percentage(51), cli::col_red("51.00%")) expect_equal(format_percentage(76.5), cli::col_yellow("76.50%")) expect_equal(format_percentage(86.5), cli::col_yellow("86.50%")) expect_equal(format_percentage(96.5), cli::col_green("96.50%")) }) test_that("print.coverage prints by = \"line\" by default", { cov <- package_coverage(test_path("TestPrint")) expect_message(print(cov, by = "expression"), rex::rex("R/TestPrint.R: ", anything, "66.67%")) expect_message(print(cov, by = "line"), rex::rex("TestPrint Coverage: ", anything, "0.00%")) expect_message(print(cov, by = "line"), rex::rex("R/TestPrint.R: ", anything, "0.00%")) # test default expect_message(print(cov), rex::rex("TestPrint Coverage: ", anything, "0.00%")) expect_message(print(cov), rex::rex("R/TestPrint.R: ", anything, "0.00%")) expect_message(print(cov, group = "functions"), rex::rex("test_me", anything, "0.00%")) expect_message(print(cov, group = "functions", by = "expression"), rex::rex("test_me", anything, "66.67%")) }) ================================================ FILE: tests/testthat/test-record_tests.R ================================================ cov_func <- withr::with_options( list(covr.record_tests = TRUE), package_coverage(test_path("TestFunctional"))) cov_tests_not_recorded <- withr::with_options( list(covr.record_tests = NULL), package_coverage(test_path("TestFunctional"))) test_that("covr.record_tests causes test traces to be recorded", { expect_gt(length(attr(cov_func, "tests")), 0L) expect_gt(length(attr(cov_func, "tests")[[1]]), 0L) }) test_that("covr.record_tests records test indices and depth for each trace", { expect_equal(ncol(cov_func[[1]]$tests), 4L) expect_equal(colnames(cov_func[[1]]$tests), c("test", "call", "depth", "i")) }) test_that("covr.record_tests test traces list uses srcref key names", { expect_match(names(attr(cov_func, "tests")), "\\w+(:\\d+){4,8}") }) test_that("covr.record_tests=NULL does not record tests", { expect_null(attr(cov_tests_not_recorded, "tests")) expect_null(cov_tests_not_recorded[[1]]$tests$tally) }) test_that("covr.record_tests traces to tests nested within test directory", { cov_top_level <- withr::with_envvar( list(COVR_TEST_NESTED = "FALSE"), package_coverage(test_path("TestNestedTestDirs"))) cov_nested <- withr::with_envvar( list(COVR_TEST_NESTED = "TRUE"), cov_nested <- package_coverage(test_path("TestNestedTestDirs"))) # same test file is evaluated twice more in a nested directory expect_equal(length(attr(cov_top_level, "tests")) * 3L, length(attr(cov_nested, "tests"))) }) test_that("covr.record_tests: merging coverage objects appends tests", { # recreate some ".counters" objects for testing .counter_1 <- list( tests = list( `./test1:1:2:3:4:5:6:7:8` = list( quote(test_that("test1", { expect_true(a()) })), quote(expect_true(a())), quote(a()) ), `./test2:1:2:3:4:5:6:7:8` = list( quote(test_that("test2", { expect_true(a()) })), quote(expect_true(a())), quote(a()) ) ), `a:1:2:3:4:5:6:7:8` = list( value = 2L, tests = as.environment(list(tally = cbind(test = c(1, 2), depth = c(0, 1), i = c(1, 3)))) ), `b:1:2:3:4:5:6:7:8` = list( value = 1L, tests = as.environment(list(tally = cbind(test = c(2), depth = c(0), i = c(2)))) ) ) .counter_2 <- list( tests = list( `./test1:1:2:3:4:5:6:7:8` = list( quote(test_that("test1", { expect_true(a()) })), quote(expect_true(a())), quote(a()) ), `./test3:1:2:3:4:5:6:7:8` = list( quote(test_that("test3", { expect_true(a()) })), quote(expect_true(a())), quote(a()) ) ), `a:1:2:3:4:5:6:7:8` = list( value = 1L, tests = as.environment(list(tally = cbind(test = c(2), depth = c(0), i = c(1)))) ), `c:1:2:3:4:5:6:7:8` = list( value = 1L, tests = as.environment(list(tally = cbind(test = c(2), depth = c(0), i = c(2)))) ) ) # store sum total of individual counters. store before merge, as the first # will be modified in-place during merging. counter_total <- nrow(.counter_1$`a:1:2:3:4:5:6:7:8`$tests$tally) + nrow(.counter_2$`a:1:2:3:4:5:6:7:8`$tests$tally) expect_silent(cov_merged <- merge_coverage.list(list(.counter_1, .counter_2))) expect_equal(nrow(cov_merged$`a:1:2:3:4:5:6:7:8`$tests$tally), counter_total) expect_equal(length(cov_merged$tests), 3L) expect_equal(cov_merged$`a:1:2:3:4:5:6:7:8`$tests$tally[[3L,1L]], 3L) }) test_that("covr.record_tests: tests tally is pruned even when no tests are hit", { # "test" a function, but no code is executed and therefore no tests are logged fcode <- 'f <- function(x) { if (x) f(!x) else FALSE }' withr::with_options(c("covr.record_tests" = TRUE), cov <- code_coverage(fcode, "{ }")) # expect that no tests were recorded, as no expressions evaluated f expect_null(attr(cov, "tests")) # expect that a matrix was still produced by a counter and pruned to 0 rows expect_true(is.matrix(cov[[1L]]$tests)) expect_equal(cov[[1L]]$value, 0L) expect_equal(nrow(cov[[1L]]$tests), 0L) }) test_that("covr.record_tests: merging coverage test objects doesn't break default tests", { # recreate some ".counters" objects for testing .counter_1 <- list( `a:1:2:3:4:5:6:7:8` = list(value = 2L), `b:1:2:3:4:5:6:7:8` = list(value = 2L) ) .counter_2 <- list( `a:1:2:3:4:5:6:7:8` = list(value = 2L), `c:1:2:3:4:5:6:7:8` = list(value = 2L) ) expect_silent(cov_merged <- merge_coverage(list(.counter_1, .counter_2))) expect_equal(cov_merged$`a:1:2:3:4:5:6:7:8`$value, 4L) }) test_that("covr.record_tests: test that coverage objects contain expected test data", { fcode <- ' f <- function(x) { if (x) f(!x) else FALSE }' withr::with_options(c("covr.record_tests" = TRUE), cov <- code_coverage(fcode, "f(TRUE)")) # expect 4 covr traces due to test expect_equal(sum(unlist(lapply(cov, function(i) nrow(i[["tests"]])))), 4L) # expect that all tests have the same index expect_equal(unique(unlist(lapply(cov, function(i) i[["tests"]][,"test"]))), 1L) # expect execution order index to be the same length as the number of traces expect_equal(length(unique(unlist(lapply(cov, function(i) i[["tests"]][,"i"])))), 4L) # expect that there are two distinct stack depths (`if (x)` (@1), `TRUE` (@2), `FALSE` (@2)) expect_equal(length(unique(unlist(lapply(cov, function(i) i[["tests"]][,"depth"])))), 2L) }) test_that("covr.record_tests: safely handles extremely large calls", { skip_on_cran() skip_if(is_r_devel()) fcode <- 'f <- function(...) { sum(...) }' expect_warning( withr::with_options(c("covr.record_tests" = TRUE), { cov <- code_coverage(fcode, "do.call('f', as.list(rep_len(1L, 1e6)))") }), "large call .* truncated" ) # expect that all calls in recorded test call stacks are under call length limit expect_true(all(vapply(attr(cov, "tests")[[1L]], length, numeric(1L)) < 1e5)) # add a canary to test for R updates that handle large call deserialization # more gracefully suppressWarnings({ code <- deparse(quote({ x <- as.call(c(list("f"), as.list(rep_len(1L, 1e6)))) f <- tempfile("test_rds", fileext = ".Rds") saveRDS(x, f) readRDS(f) })) r_script <- tempfile("test_rds_script", fileext = ".R") writeLines(code, r_script) res <- system2(file.path(R.home("bin"), "R"), list("-q", "-s", "--vanilla", "-f", r_script), stdout = TRUE, stderr = TRUE) }) if (identical(attr(res, "status"), 0L)) { warning(paste0(collapse = "\n", strwrap(paste0( "Looks like R was updated and the work-around for Rds ", "deserialization segfaults can now be made to apply conditionally to only ", "legacy R versions. Search for 'NOTE: r-bugs 18348' in the covr ", "codebase to find and add necessary R version condition to the affected ", "code" )))) } }) test_that("covr.record_tests: records multiple calls to the same test expr", { fcode <- 'f1 <- function(...) "hello, world"; f2 <- function() c(1, 2, 3)' withr::with_options(c("covr.record_tests" = TRUE), { cov <- code_coverage(fcode, "for (i in 1:3) with(new.env(), { f1(); f2() })") }) trace_f1 <- which(vapply(cov, `[[`, character(1L), "functions") == "f1") expect_equal(cov[[trace_f1]]$tests[, "test"], c(1, 1, 1)) expect_equal(cov[[trace_f1]]$tests[, "call"], c(1, 2, 3)) trace_f2 <- which(vapply(cov, `[[`, character(1L), "functions") == "f2") expect_equal(cov[[trace_f2]]$tests[, "test"], c(2, 2, 2)) expect_equal(cov[[trace_f2]]$tests[, "call"], c(1, 2, 3)) }) ================================================ FILE: tests/testthat/test-report.R ================================================ skip_on_ci <- function() { if (!identical(Sys.getenv("CI"), "true")) { return(invisible(TRUE)) } skip("On CI") } #test_that("it works with coverage objects", { #skip_on_cran() #skip_on_ci() #tmp <- tempfile() #set.seed(42) #cov <- package_coverage(test_path("TestS4")) ## Shiny uses its own seed which is not affected by set.seed, so we need to ## set that as well to have reproducibility #g <- shiny:::.globals #g$ownSeed <- .Random.seed #htmlwidgets::setWidgetIdSeed(42) #report(cov, file = tmp, browse = FALSE) #simplify_link <- function(x) { #rex::re_substitutes(x, #rex::rex(capture(or("src", "href")), "=", quote, non_quotes, quote), "\\1=\"\">") #} #expect_equal(simplify_link(readLines(tmp)), simplify_link(readLines("test-report.htm"))) #}) ================================================ FILE: tests/testthat/test-report.htm ================================================ TestS4 Coverage
================================================ FILE: tests/testthat/test-sonarqube.R ================================================ test_that("it works with coverage objects", { tmp <- tempfile() cov <- package_coverage(test_path("TestSummary")) to_sonarqube(cov, filename = tmp) expect_equal(readLines(tmp), readLines(test_path("sonarqube.xml"))) }) ================================================ FILE: tests/testthat/test-summary.R ================================================ test_that("Summary gives 50% coverage and two lines with zero coverage", { cv <- package_coverage(test_path("TestSummary")) expect_equal(percent_coverage(cv), 50) expect_equal(nrow(zero_coverage(cv)), 2) }) test_that("percent_coverage", { old <- getOption("keep.source") options(keep.source = TRUE) on.exit(options(keep.source = old), add = TRUE) fun <- function() { x <- 1 if (x > 2) { print(x) } res <- lapply(1:2, function(x) { x + 1 }) } cov <- function_coverage("fun", env = environment(fun), fun()) res <- percent_coverage(cov) expect_equal(res, 83.333333, tolerance = .01) }) ================================================ FILE: tests/testthat/test-trace_calls.R ================================================ test_that("one-line functions are traced correctly", { old <- getOption("keep.source") options(keep.source = TRUE) on.exit(options(keep.source = old)) fun <- function(x) x + 1 expect_equal(as.character(body(trace_calls(fun))[[3]][[2]][[1]]), c(":::", "covr", "count")) fun <- function() 1 expect_equal(as.character(body(trace_calls(fun))[[3]][[2]][[1]]), c(":::", "covr", "count")) expect_equal(body(trace_calls(fun))[[3]][[3]], body(fun)) }) test_that("one-line functions with no calls are traced correctly", { old <- getOption("keep.source") options(keep.source = TRUE) on.exit(options(keep.source = old)) fun <- function(x) x expect_equal(as.character(body(trace_calls(fun))[[3]][[2]][[1]]), c(":::", "covr", "count")) expect_equal(body(trace_calls(fun))[[3]][[3]], body(fun)) }) test_that("one-line functions with braces are traced correctly", { old <- getOption("keep.source") options(keep.source = TRUE) on.exit(options(keep.source = old)) fun <- function(x) { x + 1 } expect_equal(as.character(body(trace_calls(fun))[[2]][[3]][[2]][[1]]), c(":::", "covr", "count")) expect_equal(body(trace_calls(fun))[[2]][[3]][[3]], body(fun)[[2]]) }) test_that("one-line functions with no calls and braces are traced correctly", { old <- getOption("keep.source") options(keep.source = TRUE) on.exit(options(keep.source = old)) fun <- function() { 1 } e2 <- body(trace_calls(fun))[[2]][[3]] expect_true(length(e2) > 1 && identical(as.character(e2[[2]][[1]]), c(":::", "covr", "count"))) fun <- function(x) { x } e2 <- body(trace_calls(fun))[[2]][[3]] # the second expr should be a block expect_true(length(e2) > 1 && identical(as.character(e2[[2]][[1]]), c(":::", "covr", "count"))) }) test_that("last evaled expression is traced", { old <- getOption("keep.source") options(keep.source = TRUE) on.exit(options(keep.source = old)) fun <- function() { x <- 1 x } body <- body(trace_calls(fun)) expect_equal(length(body), 3) # last expression: the implicit return expression e3 <- body[[3]][[3]] expect_true(length(e3) > 1 && identical(as.character(e3[[2]][[1]]), c(":::", "covr", "count"))) }) test_that("functions with NULL bodies are traced correctly", { old <- options(keep.source = TRUE) on.exit(options(old)) fun <- function() NULL expect_null(trace_calls(fun)()) }) test_that("functions with curly curly syntax are traced correctly", { my_capture <- function(x) { rlang::expr({{ x }}) } expect_equal(my_capture(5 == 1), rlang::quo(5 == 1)) # behavior not changed by covr my_capture2 <- trace_calls(my_capture) expect_equal(my_capture2(5 == 1), rlang::quo(5 == 1)) # outer code traced traced with ({ }) expect_equal(as.character(body(my_capture2)[[2]][[1]]), "if") expect_equal(as.character(body(my_capture2)[[2]][[3]][[1]]), "{") expect_equal(as.character(body(my_capture2)[[2]][[3]][[2]][[1]]), c(":::", "covr", "count")) # no trace in the internal {{ }} expect_equal(as.character(body(my_capture2)[[2]][[3]][[3]][[2]][[1]]), "{") expect_equal(as.character(body(my_capture2)[[2]][[3]][[3]][[2]][[2]][[1]]), "{") }) test_that("functions that rely on implicit invisibility work the same", { f <- function(x) { x <- 1 } f2 <- trace_calls(f) expect_equal(withVisible(f2(1)), withVisible(f(1))) f3 <- function(x) { x + 1 } f4 <- trace_calls(f3) expect_equal(withVisible(f3(1)), withVisible(f4(1))) }) test_that("functions that use S3 dispatch work", { cov <- code_coverage( source_code = ' foo <- function(x) { UseMethod("foo") } foo.bar <- function(x) { x[[1]] + 1 } bar <- function(x) { structure(list(x), class = "bar") } ', test_code = ' stopifnot(foo(bar(1)) == 2) ') expect_equal(percent_coverage(cov), 100) }) ================================================ FILE: tests/testthat/test-utils.R ================================================ test_that("it throws error if no package", { expect_error(as_package("arst11234"), "`path` is invalid:.*arst11234") }) test_that("it returns the package if given the root or child directory", { expect_equal(as_package("TestS4")$package, "TestS4") expect_equal(as_package("TestS4/")$package, "TestS4") expect_equal(as_package("TestS4/R")$package, "TestS4") expect_equal(as_package("TestS4/tests")$package, "TestS4") expect_equal(as_package("TestS4/tests/testthat")$package, "TestS4") }) test_that("it works as expected", { with_mocked_bindings( system_output = function(...) {"test_branch "}, expect_equal(local_branch("TestSummary"), "test_branch") ) }) test_that("it works as expected", { with_mocked_bindings( system_output = function(...) {" test_hash"}, expect_equal(current_commit("TestSummary"), "test_hash") ) }) test_that("it works", { # R 4.0.0 changes this behavior so `getSrcFilename()` will actually return # "test-utils.R" skip_if(getRversion() >= "4.0.0") x <- eval(bquote(function() 1)) expect_identical(getSrcFilename(x), character()) expect_identical(get_source_filename(x), "") }) test_that("per_line removes blank lines and lines with only punctuation (#387)", { skip_on_cran() cov <- package_coverage(test_path("TestFunctional")) line_cov <- per_line(cov) expect_equal(line_cov[[1]]$coverage, c(NA, 0, 0, 2, NA, 1, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA)) }) test_that("split_on_line_directives returns NULL for input without directive (#588)", { expect_identical( split_on_line_directives(NULL), NULL ) expect_identical( split_on_line_directives(character()), NULL ) expect_identical( split_on_line_directives("aa"), NULL ) expect_identical( split_on_line_directives(c("abc", "def")), NULL ) }) test_that("split_on_line_directives does not simplify the result (#588)", { expect_identical( split_on_line_directives( c( '#line 1 "foo.R"', "abc", "def" ) ), list( "foo.R" = c("abc", "def") ) ) expect_identical( split_on_line_directives( c( '#line 1 "foo.R"', "abc", "def", '#line 4 "bar.R"', "ghi", "jkl" ) ), list( "foo.R" = c("abc", "def"), "bar.R" = c("ghi", "jkl") ) ) }) ================================================ FILE: tests/testthat/test-vectorized.R ================================================ s1 = tempfile() t1 = tempfile() writeLines(con = s1, 'scalar_func <- function(x,y) { z <- x + y } vector_func <- Vectorize(scalar_func,vectorize.args=c("x","y"),SIMPLIFY=TRUE)') writeLines(con = t1, "vector_func(1:10, 2)") on.exit(unlink(c(s1, t1))) test_that("it works on Vectorized functions", { cov <- file_coverage(s1, t1) cov_d <- as.data.frame(cov) expect_equal(cov_d$functions, "vector_func") expect_equal(cov_d$value, 10) }) ================================================ FILE: tests/testthat.R ================================================ # This file is part of the standard setup for testthat. # It is recommended that you do not modify it. # # Where should you do additional test configuration? # Learn more about the roles of various files in: # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview # * https://testthat.r-lib.org/articles/special-files.html library(testthat) library(covr) test_check("covr") ================================================ FILE: unshim_package.sh ================================================ #!/usr/bin/env sh perl -i -pe 's/\bcovrShim\b/covr/g;s/\bcovrShim_/covr_/g;s/_covrShim/_covr/g;' DESCRIPTION NAMESPACE R/* src/* tests/*R tests/testthat/*R ================================================ FILE: vignettes/how_it_works.Rmd ================================================ --- title: "How does covr work anyway?" author: "Jim Hester" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{How does covr work anyway} %\VignetteEngine{knitr::rmarkdown} \usepackage[utf8]{inputenc} --- ```{r setup, include = FALSE} library(covr) ``` # Introduction # The **covr** package provides a framework for measuring unit test coverage. Unit testing is one of the cornerstones of software development. Any piece of R code can be thought of as a software application with a certain set of behaviors. Unit testing means creating examples of how the code should behave _with a definition of the expected output_. This could include normal use, edge cases, and expected error cases. Unit testing is commonly facilitated by frameworks such as **testthat** and **RUnit**. Test _coverage_ is the _proportion_ of the source code that is executed when running these tests. Code coverage consists of: * instrumenting the source code so that it reports when it is run, * executing the unit test code to exercise the source code. Measuring code coverage allows developers to asses their progress in quality checking their own (or their collaborators) code. Measuring code coverage allows code consumers to have confidence in the measures taken by the package authors to verify high code quality. **covr** provides three functions to calculate test coverage. - `package_coverage()` performs coverage calculation on an R package. (Unit tests must be contained in the `"tests"` directory.) - `file_coverage()` performs coverage calculation on one or more R scripts by executing one or more R scripts. - `function_coverage()` performs coverage calculation on a single named function, using an expression provided. In 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. An interface for visually marking code with test coverage results allows a clear box view of the unit test suite. The clear box view can be accessed using online tools or a local report can be generated using `report()`. # Instrumenting R Source Code # ## Modifying the call tree ## The core function in **covr** is `trace_calls()`. This function was adapted from ideas in [_Advanced R - Walking the Abstract Syntax Tree with recursive functions_](http://adv-r.had.co.nz/Expressions.html#ast-funs). This recursive function modifies each of the leaves (atomic or name objects) of an R expression by applying a given function to them. If the expression is not a leaf the walker function calls itself recursively on elements of the expression instead. We can use this same framework to instead insert a trace statement before each call by replacing each call with a call to a counting function followed by the previous call. Braces (`{`) in R may seem like language syntax, but they are actually a Primitive function and you can call them like any other function. ```{r} identical(x = { 1 + 2; 3 + 4 }, y = `{`(1 + 2, 3 + 4)) ``` Remembering that braces always return the value of the last evaluated expression, we can call a counting function followed by the previous function substituting `as.call(recurse(x))` in our function above with. ```{r, eval = FALSE} `{`(count(), as.call(recurse(x))) ``` ## Source References ## Now that we have a way to add a counting function to any call in the Abstract Syntax Tree without changing the output we need a way to determine where in the code source that function came from. Luckily R has a built-in method to provide this information in the form of source references. When `option(keep.source = TRUE)` (the default for interactive sessions), a reference to the source code for functions is stored along with the function definition. This reference is used to provide the original formatting and comments for the given function source. In particular each call in a function contains a `srcref` attribute, which can then be used as a key to count just that call. The actual source for `trace_calls` is slightly more complicated because we want to initialize the counter for each call while we are walking the Abstract Syntax Tree and there are a few non-calls we also want to count. ## Refining Source References ## Each statement comes with a source reference. Unfortunately, the following is counted as one statement: ```r if (x) y() ``` To work around this, detailed parse data (obtained from a refined version of `getParseData`) is analyzed to impute source references at sub-statement level for `if`, `for`, `while` and `switch` constructs. ## Replacing Source In Place ## After we have our modified function definition, how do we re-define the function to use the updated definition, and ensure that all other functions which call the old function also use the new definition? You might try redefining the function directly. ```{r} f1 <- function() 1 f1 <- function() 2 f1() == 2 ``` While this does work for the simple case of calling the new function in the same environment, it fails if another function calls a function in a different environment. ```{r} env <- new.env() f1 <- function() 1 env$f2 <- function() f1() + 1 env$f1 <- function() 2 env$f2() == 3 ``` As modifying external environments and correctly restoring them can be tricky to get correct, we use the C function [`covr_reassign_function`](https://github.com/r-lib/covr/blob/40122df12bc9ef1e577dd0720a895b5340b1516f/src/reassign.c#L65-L135). This function takes a function name, environment, old definition, new definition and copies the formals, body, attributes and environment from the old function to the new function. This allows you to do an in-place replacement of a given function with a new function and ensure that all references to the old function will use the new definition. # Object Orientation # ## S3 Classes ## R's S3 object oriented classes simply define functions directly in the packages namespace, so they can be treated the same as any other function. ## S4 Classes ## S4 methods have a more complicated implementation than S3 classes. The function definitions are placed in an enclosing environment based on the generic method they implement. This makes getting the function definition more complicated. `replacements_S4` first gets all the generic functions for the package environment. Then for each generic function if finds the mangled meta package name and gets the corresponding environment from the base environment. All of the functions within this environment are then traced. ## Reference Classes ## Similarly to S4 classes reference classes (RC) define their methods in a special environment. A similar method is used to add the tracing calls to the class definition. These calls are then copied to the object methods when the generator function is run. # Compiled code # ## Gcov ## Test coverage of compiled code uses a completely different mechanism than that of R code. Fortunately we can take advantage of [Gcov](https://gcc.gnu.org/onlinedocs/gcc-4.1.2/gcc/Gcov.html#Gcov), the built-in coverage tool for [gcc](https://gcc.gnu.org/) and compatible reports from [clang](http://clang.llvm.org/) versions 3.5 and greater. Both of these compilers track execution coverage when given the `--coverage` flag. In addition it is necessary to turn off compiler optimization `-O0`, otherwise the coverage output is difficult or impossible to interpret as multiple lines can be optimized into one, functions can be inlined, etc. ## Makevars ## R passes flags defined in `PKG_CFLAGS` to the compiler, however it also has default flags including `-02` (defined in `$R_HOME/etc/Makeconf`), which need to be overridden. Unfortunately it is not possible to override the default flags with environment variables (as the new flags are added to the left of the defaults rather than the right). However if Make variables are defined in `~/.R/Makevars` they _are_ used in place of the defaults. Therefore, we need to temporarily add `-O0 --coverage` to the Makevars file, then restore the previous state after the coverage is run. ## Subprocess ## The last hurdle to getting compiled code coverage working properly is that the coverage output is only produced when the running process ends. Therefore you cannot run the tests and get the results in the same R process. **covr** runs a separate R process when running tests. However we need to modify the package code first before running the tests. **covr** installs the package to be tested in a temporary directory. Next, 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 which prints the coverage counts when the namespace is unloaded or the R process exits. These output files are then aggregated together to determine the coverage. This procedure works regardless of the number of child R processes used, so therefore also works with parallel code. # Output Formats # The output format returned by **covr** is an R object of class "coverage" containing the information gathered when executing the test suite. It 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). The value is the number of times that given expression was called and the source ref of the original call. ```{r} # an object to analyze f1 <- function(x) { x + 1 } # get results with no unit tests c1 <- function_coverage(fun = f1, code = NULL) c1 # get results with unit tests c2 <- function_coverage(fun = f1, code = f1(x = 1) == 2) c2 ``` An `as.data.frame` method is available to make subsetting by various features easy to do. While **covr** tracks coverage by expression, typically users expect coverage to be reported by line, so there are functions to convert to line oriented coverage. # Codecov.io and Coveralls.io # [Codecov](https://about.codecov.io/) and [Coveralls](https://coveralls.io/) are a web services to help you track your code coverage over time, and ensure that all new code is appropriately covered. They 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. # Prior Art # ## Overview ## Prior to writing **covr**, there were a handful of coverage tools for R code. [**R-coverage**](https://web.archive.org/web/20160611114452/http://r2d2.quartzbio.com/posts/r-coverage-docker.html) by Karl Forner and [**testCoverage**](https://github.com/MangoTheCat/testCoverage) by Tom Taverner, Chris Campbell & Suchen Jin. ## R-coverage ## **R-coverage** provides a very robust solution by modifying the R source code to instrument the code for each call. Unfortunately this requires you to patch the source of the R application itself. Getting the changes incorporated into the core R distribution would likely be challenging. ## Test Coverage ## **testCoverage** uses `getParseData`, R's alternate parser (from 3.0) to analyse the R source code. The package replaces symbols in the code to be tested with a unique identifier. This is then injected into a tracing function that will report each time the symbol is called. The first symbol at each level of the expression tree is traced, allowing the coverage of code branches to be checked. This is a complicated implementation I do not fully understand, which is one of the reasons I decided to write **covr**. ## Covr ## **covr** takes an approach in-between the two previous tools. Function definitions are modified by parsing the abstract syntax tree and inserting trace statements. These modified definitions are then transparently replaced in-place using C. This 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. # Conclusion # **covr** provides an accessible framework which will ease the communication of R unit test suites. **covr** can be integrated with continuous integration services where R developers are working on larger projects, or as part of multi-disciplinary teams. **covr** aims to be simple to use to make writing high quality code part of every R user's routine.