diff --git a/.github/workflows/comment-feature-test.yml b/.github/workflows/comment-feature-test.yml new file mode 100644 index 0000000..d4def20 --- /dev/null +++ b/.github/workflows/comment-feature-test.yml @@ -0,0 +1,30 @@ +name: comment feature test results + +on: + workflow_run: + workflows: ["test data"] + types: [completed] + +permissions: + actions: read + pull-requests: write + +jobs: + comment: + runs-on: ubuntu-latest + if: github.event.workflow_run.event == 'pull_request' + steps: + - name: download feature test results + uses: actions/download-artifact@v4 + with: + name: feature-test-results + run-id: ${{ github.event.workflow_run.id }} + github-token: ${{ secrets.GITHUB_TOKEN }} + + - name: comment on PR + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + GH_REPO: ${{ github.repository }} + run: | + PR_NUMBER=$(cat pr_number.txt) + gh pr comment "$PR_NUMBER" --body-file phoneme_feature_test_results.txt diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index a1729ea..9fec851 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -5,17 +5,39 @@ on: branches: [ master ] pull_request: branches: [ master ] - jobs: test-data: runs-on: ubuntu-latest + permissions: + contents: read steps: - uses: actions/checkout@v7 - uses: prefix-dev/setup-pixi@v0.10.1 with: pixi-version: v0.66.0 activate-environment: "ci" + ## The following steps are temporary until we fix the phoneme feature test to pass in CI. + ## Once the phoneme feature test passes, update the below run tests command and remove filter and invert, and delete the following steps. + - name: run feature test (write to PR comment) + working-directory: tests + run: | + Rscript -e "testthat::test_file('test-phonemes.R', reporter = 'summary')" > phoneme_feature_test_results.txt 2>&1 || true + ## Fork PRs get a read-only GITHUB_TOKEN here, so this job can't comment + ## directly. comment-feature-test.yml (triggered via workflow_run) does it instead. + - name: save PR number + if: github.event_name == 'pull_request' + working-directory: tests + run: echo "${{ github.event.pull_request.number }}" > pr_number.txt + - name: upload feature test results + if: github.event_name == 'pull_request' + uses: actions/upload-artifact@v4 + with: + name: feature-test-results + path: | + tests/phoneme_feature_test_results.txt + tests/pr_number.txt + ## Run the rest of the tests, excluding the phoneme feature test (which is run above). - name: run tests working-directory: tests run: | - Rscript -e "testthat::test_dir('.', stop_on_failure=TRUE)" + Rscript -e "testthat::test_dir('.', filter = 'phonemes', invert = TRUE, stop_on_failure = TRUE)" \ No newline at end of file diff --git a/pixi.toml b/pixi.toml index da4de45..c4a149a 100644 --- a/pixi.toml +++ b/pixi.toml @@ -6,6 +6,7 @@ platforms = ["linux-64"] version = "0.1.0" [tasks] +test = [{ task = "tests"}] [dependencies] r = "4.*" @@ -16,6 +17,7 @@ r-stringi = ">=1.8.7,<2" [feature.agg.tasks] aggregate = { cmd = "Rscript aggregate-raw-data.R", cwd = "scripts" } +add_features = { cmd = "Rscript add-features.R", cwd = "scripts" } [feature.ci.dependencies] r-dplyr = "1.1.1.*" @@ -26,6 +28,9 @@ r-stringr = ">=1.5.1,<2" r-testthat = ">=3.2.1.1,<4" r-withr = ">=3.0.0,<4" +[feature.ci.tasks] +tests = { cmd = "Rscript -e \"testthat::test_dir('.', stop_on_failure=TRUE)\"", cwd = "tests" } + [environments] agg = { features = ["agg"] } ci = { features = ["ci"] } diff --git a/scripts/add-features.R b/scripts/add-features.R index f5530b2..da5d865 100644 --- a/scripts/add-features.R +++ b/scripts/add-features.R @@ -144,6 +144,7 @@ make_feat_vec_from_mat <- function(feat_mat) { zero=TRUE) ## look up the combined base glyphs in the special_feats table base_vec <- special_feats[special_feats$segment == base_pair, ] + stopifnot(nrow(base_vec) == 1) ## populate the feature vector from the special_feats table feat_vec[feature_cols] <- base_vec[feature_cols] # delete two bases diff --git a/tests/test-cross-inventory-integrity.R b/tests/test-cross-inventory-integrity.R new file mode 100644 index 0000000..3c4f1d7 --- /dev/null +++ b/tests/test-cross-inventory-integrity.R @@ -0,0 +1,100 @@ +#! /usr/bin/env Rscript + +## Tests for cross-inventory integrity. Checks that: +## 1. No source accidentally split one language (Glottocode, LanguageName, SpecificDialect, BibtexKey) across two InventoryIDs +## 2. Every BibtexKey in the mapping file resolves to a real entry in +## phoible-references.bib. +## 3. Every InventoryID in the mapping files exists in the aggregated +## data, and vice versa. + +library(dplyr, warn.conflicts=FALSE) +library(testthat, warn.conflicts=FALSE) + +## load PHOIBLE data +phoible_data_file <- file.path("..", "data", "phoible.csv") +phoible_col_types <- readr::cols(InventoryID="c", Marginal="l", .default="c") +phoible <- readr::read_csv(phoible_data_file, col_types=phoible_col_types) + +bibtex_mapping_file <- file.path("..", "mappings", "InventoryID-Bibtex.csv") +bibtex_mapping <- readr::read_csv(bibtex_mapping_file, col_types=readr::cols(.default="c")) + +# Join the phoible data with the mapping file to get a combined dataset for testing +phoible_with_bibtex <- phoible %>% + left_join(bibtex_mapping, by="InventoryID", relationship="many-to-many") + +references_bib_file <- file.path("..", "mappings", "phoible-references.bib") + +context("Cross-inventory integrity") + +test_that("no source accidentally split one language across two InventoryIDs", { + ## Checks whether the same (Source, Glottocode, LanguageName, SpecificDialect, BibtexKey) tuple + ## appears in more than one InventoryID. + phoible_with_bibtex %>% + filter(!is.na(Glottocode)) %>% + distinct(InventoryID, Source, Glottocode, LanguageName, SpecificDialect, BibtexKey) %>% + group_by(Source, Glottocode, LanguageName, SpecificDialect, BibtexKey) %>% + filter(n_distinct(InventoryID) > 1) %>% + ungroup() -> + split_duplicates + + expect(nrow(split_duplicates) == 0, + paste(c("SAME (Source, Glottocode, LanguageName, SpecificDialect, BibtexKey) APPEARS IN MULTIPLE INVENTORYIDS:", + capture.output(print(split_duplicates, n=Inf))), + sep="\n") + ) + } +) + +test_that("every BibtexKey resolves to a real bib entry", { + ## Check that every BibtexKey in the mapping file resolves to a real entry in phoible-references.bib. + + ## regex to match BibTeX keys in the .bib file + citekey_re <- "(?m)^@\\w+\\s*\\{\\s*([^,]+?)\\s*," + + bib_keys <- stringr::str_match_all( + readr::read_file(references_bib_file), citekey_re + )[[1]][, 2] + + mapping_keys <- bibtex_mapping %>% pull(BibtexKey) %>% unique() + missing_keys <- setdiff(mapping_keys, bib_keys) + + # Exclude special case of InventoryID 201 (Arrente), which has "NO SOURCE GIVEN" as its BibtexKey + missing_keys <- setdiff(missing_keys, bibtex_mapping %>% filter(InventoryID == 201) %>% pull(BibtexKey)) + + ## report which InventoryID(s) cite each missing key + offending_rows <- bibtex_mapping %>% + filter(BibtexKey %in% missing_keys) %>% + arrange(BibtexKey, as.integer(InventoryID)) + offending_summary <- offending_rows %>% + group_by(BibtexKey) %>% + summarise(InventoryIDs = paste(InventoryID, collapse=", "), .groups="drop") + + expect(length(missing_keys) == 0, + paste(c(paste("BIBTEXKEYS WITH NO MATCHING ENTRY IN", + basename(references_bib_file)), + paste0(offending_summary$BibtexKey, " (InventoryID ", + offending_summary$InventoryIDs, ")")), + sep="\n") + ) + } +) + +test_that("mapping-file and aggregated-data InventoryIDs match in both directions", { + phoible_ids <- phoible %>% pull(InventoryID) %>% unique() + mapping_ids <- bibtex_mapping %>% pull(InventoryID) %>% as.integer() %>% unique() + + only_in_mapping <- setdiff(mapping_ids, phoible_ids) + only_in_phoible <- setdiff(phoible_ids, mapping_ids) + + expect(length(only_in_mapping) == 0, + paste(c("INVENTORYIDS IN InventoryID-Bibtex.csv BUT MISSING FROM", + "AGGREGATED DATA:", paste(only_in_mapping, collapse=" ")), + sep="\n") + ) + expect(length(only_in_phoible) == 0, + paste(c("INVENTORYIDS IN AGGREGATED DATA BUT MISSING FROM", + "InventoryID-Bibtex.csv:", paste(only_in_phoible, collapse=" ")), + sep="\n") + ) + } +) diff --git a/tests/test-inventory-metadata.R b/tests/test-inventory-metadata.R index 2aaca1a..754db28 100644 --- a/tests/test-inventory-metadata.R +++ b/tests/test-inventory-metadata.R @@ -141,6 +141,7 @@ test_that("glottocodes are valid", { glotto_url <- "https://github.com/glottolog/glottolog-cldf/blob/master/cldf/languages.csv?raw=true" glotto_table <- readr::read_csv(glotto_url, col_types=default_char_cols) glotto_valid <- pull(glotto_table, ID) + iso_valid_map <- pull(glotto_table, ISO639P3code) glotto_phoible <- pull(phoible, Glottocode) glotto_invalid <- setdiff(glotto_phoible, glotto_valid) @@ -166,6 +167,39 @@ test_that("glottocodes are valid", { collapse=" "), sep="\n") ) + + ## Check that the ISO code in glottolog matches phoible's ISO code, for + ## every inventory with a known Glottocode (i.e. excluding Djindewal). + has_glottocode <- !is.na(phoible$Glottocode) + + iso_from_glottolog <- iso_valid_map[match(phoible$Glottocode[has_glottocode], glotto_valid)] + iso_from_phoible <- phoible$ISO6393[has_glottocode] + + ## Exclude known glottolog-ISO mismatches + known_mismatches <- rbind( + c(868, "nepa1253", "kru"), # kxl (deprecated) merged into kru + c(1307, "krim1238", "bmf"), # krm (deprecated) merged into bmf + c(2750, "dira1238", "dif"), # dit (deprecated) merged into dif + c(2875, "band1337", "drl"), # bjd (deprecated) merged into drl + c(2256, "dark1243", "khk") # drh (deprecated) merged into khk + ) + + overridable <- phoible$Glottocode[has_glottocode] %in% known_mismatches[, 2] + override <- setNames(known_mismatches[, 3], known_mismatches[, 2]) + iso_from_glottolog[overridable] <- override[phoible$Glottocode[has_glottocode][overridable]] + + mismatch_indices <- which(iso_from_glottolog != iso_from_phoible) + + mismatch_ids <- phoible$InventoryID[has_glottocode][mismatch_indices] + mismatch_glottocodes <- phoible$Glottocode[has_glottocode][mismatch_indices] + mismatches <- unique(paste0(mismatch_ids, " (", mismatch_glottocodes, "): ", iso_from_phoible[mismatch_indices], + " - ", iso_from_glottolog[mismatch_indices])) + + expect(length(mismatches) == 0, + paste("MISMATCHED ISO CODES BETWEEN PHOIBLE AND GLOTTOLOG (InventoryID (glottocode)): phoible - glottolog):", + paste0("- ", mismatches, collapse="\n"), + sep="\n") + ) } ) diff --git a/tests/test-regression-c-cedilla.R b/tests/test-regression-c-cedilla.R new file mode 100644 index 0000000..785e9f4 --- /dev/null +++ b/tests/test-regression-c-cedilla.R @@ -0,0 +1,18 @@ +#! /usr/bin/env Rscript + +## Regression test for c-cedilla staying precomposed in order_ipa() +## (aggregation-helper-functions.R), rather than decomposing it. + +library(stringi, warn.conflicts=FALSE) +library(testthat, warn.conflicts=FALSE) + +source(file.path("..", "scripts", "aggregation-helper-functions.R")) + +context("Special-case exceptions regression") + +test_that("c-cedilla is unchanged by order_ipa()", { + ordered <- order_ipa("ç") + expect(identical(ordered, "ç"), + paste("Expected c-cedilla phoneme to be unchanged by order_ipa(), got", + shQuote(ordered))) +}) diff --git a/tests/test-regression-click-modifier.R b/tests/test-regression-click-modifier.R new file mode 100644 index 0000000..1615ec2 --- /dev/null +++ b/tests/test-regression-click-modifier.R @@ -0,0 +1,57 @@ +#! /usr/bin/env Rscript + +## Regression test for the click/modifier typing in order_ipa() (aggregation-helper-functions.R). +## Clicks are deliberately typed "M", the same glyph-type code as real modifier letters +## so they factor into feature-vector assignment the same way +## (see create_glyph_type_variables()/make_typestring()). + +library(stringi, warn.conflicts=FALSE) +library(testthat, warn.conflicts=FALSE) + +source(file.path("..", "scripts", "aggregation-helper-functions.R")) + +context("Click/modifier regression") + +test_that("a click is not deleted when followed by a modifier letter", { + ## dental click U+01C0 + aspirated U+02B0 both typed "M" + ## triggering the "MM" canonical-reordering block + result <- order_ipa("ǀʰ") + expect(stri_detect_fixed(result, "ǀ"), + paste("Click character was lost from", shQuote(result))) + expect(nchar(result) == 2, + paste("Expected a 2-character result, got", shQuote(result), + "(", nchar(result), "characters)")) +}) + +test_that("a click is not deleted when preceding a modifier letter", { + ## same "MM" span, reversed input order + result <- order_ipa("ʰǀ") + expect(stri_detect_fixed(result, "ǀ"), + paste("Click character was lost from", shQuote(result))) + expect(nchar(result) == 2, + paste("Expected a 2-character result, got", shQuote(result), + "(", nchar(result), "characters)")) +}) + +test_that("a click followed by a diacritic is not swapped the way a modifier would be", { + ## dental click + devoiced/ring-below diacritic (U+0325) - Typed "MD" + ## Should not be swapped to "DM" because the click is not a real modifier letter. + result <- order_ipa("ǀ̥") + expect(stri_detect_fixed(result, "ǀ"), + paste("Click character was lost from", shQuote(result))) + expect(identical(stri_sub(result, 1, 1), "ǀ"), + paste("Expected click to remain first, got", shQuote(result))) +}) + +test_that("a click preceding a real modifier+diacritic doesn't block their swap", { + ## typestring "MMD" with a click first, then a modifier letter, then a diacritic. + ## The modifier+diacritic pair should still be swapped, but the click should remain first. + result <- order_ipa("ǀʰ̥") + expect(stri_detect_fixed(result, "ǀ"), + paste("Click character was lost from", shQuote(result))) + expect(identical(stri_sub(result, 1, 1), "ǀ"), + paste("Expected click to remain first, got", shQuote(result))) + expect(identical(result, "ǀ̥ʰ"), + paste("Expected the modifier+diacritic pair to still be swapped", + "(click skip should not suppress it), got", shQuote(result))) +})