From 8d5ce2f68c40702076f0c0511b825ac0cdea364f Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Mon, 17 Mar 2025 17:59:22 +0100 Subject: [PATCH] feat: move selftests in `Alire.Selftest` to new Ada testsuite (#1893) * Move `Alire.Selftest` to new Ada testsuite * Update test script to run Ada testsuite * Document new testsuite * Remove selftests from Python testsuite * See what happens with external compiler * Self-review * Fix test * Fix build profile of testsuite --- .github/workflows/ci-docker.yml | 2 +- .github/workflows/ci-release.yml | 3 +- alire.toml | 4 +- scripts/ci-github.sh | 36 ++- src/alire/alire-selftest.adb | 213 ------------------ src/alire/alire-selftest.ads | 9 - src/alr/alr-commands-dev.adb | 10 - src/alr/alr-commands-dev.ads | 1 - testsuite/README.md | 23 +- testsuite/tests/debug/self-tests/test.py | 14 -- testsuite/tests/debug/self-tests/test.yaml | 1 - testsuite/tests_ada/.gitignore | 10 + testsuite/tests_ada/alire.toml | 12 + testsuite/tests_ada/alr_tests.gpr | 18 ++ .../src/alr_tests-assertions_enabled.adb | 11 + .../src/alr_tests-config_changes.adb | 45 ++++ .../src/alr_tests-email_identification.adb | 72 ++++++ .../src/alr_tests-git_to_http_transforms.adb | 35 +++ .../tests_ada/src/alr_tests-github_logins.adb | 31 +++ .../src/alr_tests-regex_escaping.adb | 45 ++++ testsuite/tests_ada/src_common/alr_tests.ads | 7 + 21 files changed, 342 insertions(+), 260 deletions(-) delete mode 100644 src/alire/alire-selftest.adb delete mode 100644 src/alire/alire-selftest.ads delete mode 100644 testsuite/tests/debug/self-tests/test.py delete mode 100644 testsuite/tests/debug/self-tests/test.yaml create mode 100644 testsuite/tests_ada/.gitignore create mode 100644 testsuite/tests_ada/alire.toml create mode 100644 testsuite/tests_ada/alr_tests.gpr create mode 100644 testsuite/tests_ada/src/alr_tests-assertions_enabled.adb create mode 100644 testsuite/tests_ada/src/alr_tests-config_changes.adb create mode 100644 testsuite/tests_ada/src/alr_tests-email_identification.adb create mode 100644 testsuite/tests_ada/src/alr_tests-git_to_http_transforms.adb create mode 100644 testsuite/tests_ada/src/alr_tests-github_logins.adb create mode 100644 testsuite/tests_ada/src/alr_tests-regex_escaping.adb create mode 100644 testsuite/tests_ada/src_common/alr_tests.ads diff --git a/.github/workflows/ci-docker.yml b/.github/workflows/ci-docker.yml index 09e3ed1e..13938528 100644 --- a/.github/workflows/ci-docker.yml +++ b/.github/workflows/ci-docker.yml @@ -46,7 +46,7 @@ jobs: uses: mosteo-actions/docker-run@v2 with: image: ghcr.io/alire-project/docker/gnat:${{matrix.tag}} - command: scripts/ci-github.sh + command: scripts/ci-github.sh use_external # Use external compiler already installed params: -v${PWD}:/alire -w /alire - name: Upload logs (if failed) diff --git a/.github/workflows/ci-release.yml b/.github/workflows/ci-release.yml index 8e811cc9..1c97c110 100644 --- a/.github/workflows/ci-release.yml +++ b/.github/workflows/ci-release.yml @@ -84,6 +84,7 @@ jobs: run: | sudo apt-get install -y gnat gprbuild echo ALIRE_TESTSUITE_DISABLE_DOCKER=true >> $GITHUB_ENV + echo USE_EXTERNAL=use_external >> $GITHUB_ENV # GNAT 10 has a bug that fails in the testsuite. Also, we need to disable # Docker tests on Ubuntu ARM. @@ -98,7 +99,7 @@ jobs: # The test script itself will build alr - name: Run test script - run: scripts/ci-github.sh + run: scripts/ci-github.sh $USE_EXTERNAL shell: bash env: BRANCH: ${{ github.base_ref }} diff --git a/alire.toml b/alire.toml index a0d7f3ad..43ce9d9d 100644 --- a/alire.toml +++ b/alire.toml @@ -10,7 +10,6 @@ maintainers-logins = ["mosteo", "Fabien-Chouteau"] # At some point we should have a separate alire/libalire crate for use of # alire.gpr only. For now this crate is not intended as a dependency but to be # used to build alr. -auto-gpr-with = false project-files = ["alr.gpr"] executables = ["alr"] @@ -134,3 +133,6 @@ command = ["pwsh", "scripts/version-patcher.ps1"] type = "pre-build" command = ["scripts/version-patcher.sh"] +[test] +runner = "alire" +directory = "testsuite/tests_ada" diff --git a/scripts/ci-github.sh b/scripts/ci-github.sh index 135adce1..1183c2c2 100755 --- a/scripts/ci-github.sh +++ b/scripts/ci-github.sh @@ -1,5 +1,10 @@ #!/usr/bin/env bash +# Parameters (optional): +# skip_build : skip alr build +# skip_test : skip testsuites +# use_external : use the system external compiler for the Ada testsuite + trap 'echo "ERROR at line ${LINENO} (code: $?)" >&2' ERR trap 'echo "Interrupted" >&2 ; exit 1' INT @@ -35,8 +40,8 @@ if [ "$(get_OS)" == "macos" ]; then ALR_LINKER_ARGS="-static-libgcc" fi -# Build alr if no argument is "build=false" -if [[ " $* " == *" build=false "* ]]; then +# Build alr if "skip_build" is not passed" +if [[ " $* " == *" skip_build "* ]]; then echo "Skipping alr build, explicitly disabled via arguments" else export ALIRE_OS=$(get_OS) @@ -77,8 +82,8 @@ echo ALR SEARCH: alr -q -d search --list --external echo ............................ -# Exit without testing if some argument is "test=false" -if [[ " $* " == *" test=false "* ]]; then +# Exit without testing if some argument is "skip_test" +if [[ " $* " == *" skip_test "* ]]; then echo "SKIPPING testsuite, explicitly disabled via arguments" exit 0 fi @@ -113,7 +118,26 @@ echo Check Finalize exception handling : $run_python ../scripts/python/check_finalize_exceptions.py ../src echo ............................ -echo Running test suite now: -$run_python ./run.py --show-time-info -E || { echo Test suite failures, unstable build!; exit 1; } +echo Running Python test suite now: +$run_python ./run.py --show-time-info -E || { echo Python test suite failures, unstable build!; exit 1; } cd .. echo ............................ + +# Run Ada testsuite last as re-building alr in validation mode is +# time-consuming and we want to catch any issues with the Python testsuite +# first. Also, as we want to keep the already built alr for the artifacts and +# possible releases, we preserve the current alr and restore it afterwards. +# This also allows Windows to generate a new executable (otherwise it cannot +# overwrite the running binary). + +# if use_external is passed, we select the system external compiler + +if [[ " $* " == *" use_external "* ]]; then + echo "Selecting external compiler" + alr toolchain --select gnat_external gprbuild +fi + +mkdir bak && cp bin/alr* bak +echo Running Ada test suite now: +bak/alr test || { echo Ada test suite failures, unstable build!; exit 1; } +rm -rf bin/alr* && mv bak/alr* bin diff --git a/src/alire/alire-selftest.adb b/src/alire/alire-selftest.adb deleted file mode 100644 index a0e10ffb..00000000 --- a/src/alire/alire-selftest.adb +++ /dev/null @@ -1,213 +0,0 @@ -with Alire.Settings.Edit; -with Alire.Utils.Regex; -with Alire.VCSs.Git; - -with GNAT.Regpat; - -package body Alire.Selftest is - - -- Tests are Check_* procedures that end normally or raise some exception. - - procedure Check_Config_Changes is - -- Ensure that configuration set in a run is also stored in memory - Key : constant String := "test_key"; - Val : constant String := "nominal"; - begin - Settings.Edit.Set_Globally (Key, Val); - pragma Assert (Settings.DB.Defined (Key)); - pragma Assert (Settings.DB.Get (Key, "snafu") = Val); - - -- Check typed storing - - -- Raw storing of integer - Settings.Edit.Set_Globally (Key, "777"); - pragma Assert (Integer (Settings.DB.Get (Key, 0)) = 777); - - -- Raw storing of boolean - Settings.Edit.Set_Globally (Key, "true"); - pragma Assert (Settings.DB.Get (Key, False) = True); - - -- Typed storing of boolean - Settings.Edit.Set_Boolean (Settings.Global, Key, False); - pragma Assert (Settings.DB.Get (Key, True) = False); - - -- Raw storing of boolean with wrong type - Settings.Edit.Set_Globally (Key, "True"); - -- This causes a string to be stored, as in TOML only "true" is bool - pragma Assert (Settings.DB.Get (Key, "False") = "True"); - - end Check_Config_Changes; - - ------------------------ - -- Check_Email_Checks -- - ------------------------ - - procedure Check_Email_Checks is - use Utils; - begin - -- Check valid emails that must be accepted: - - pragma Assert - (Could_Be_An_Email ("first@last.com", With_Name => False)); - - pragma Assert - (Could_Be_An_Email ("first@last.es", With_Name => False)); - - pragma Assert - (Could_Be_An_Email ("first@a-bcd--ef.com", With_Name => False)); - - pragma Assert - (Could_Be_An_Email ("a@xn--espaa-rta.com.es", With_Name => False)); - -- españa as IDN - - pragma Assert - (Could_Be_An_Email ("first+middle@last.es", With_Name => False)); - - pragma Assert - (Could_Be_An_Email ("+++___@last.es", With_Name => False)); - - pragma Assert - (Could_Be_An_Email ("al.ej.an.dro.@last.com", With_Name => False)); - - pragma Assert - (Could_Be_An_Email ("alan%$dro@last.com", With_Name => False)); - - pragma Assert - (Could_Be_An_Email ("Álex ", With_Name => True)); - -- Non-ascii in name. - - pragma Assert - (Could_Be_An_Email ("First M. Last ", - With_Name => True)); - - -- Check invalid emails that should be rejected: - - pragma Assert - (not Could_Be_An_Email ("first@last", With_Name => False)); - -- Missing at least 2 subdomains - - pragma Assert - (not Could_Be_An_Email ("first@-last.com", With_Name => False)); - -- Leading dash - - pragma Assert - (not Could_Be_An_Email ("first@la False)); - -- Invalid char in domain - - pragma Assert - (not Could_Be_An_Email ("First ", - With_Name => False)); -- With_Name should be true - - pragma Assert - (not Could_Be_An_Email ("Álex", - With_Name => True)); -- Missing space before '<' - end Check_Email_Checks; - - ------------------------- - -- Check_GitHub_Logins -- - ------------------------- - - procedure Check_GitHub_Logins is - function Valid (User : String) return Boolean - renames Utils.Is_Valid_GitHub_Username; - begin - -- Examples taken from https://github.com/shinnn/github-username-regex - - pragma Assert (Valid ("a")); - pragma Assert (Valid ("0")); - pragma Assert (Valid ("a-b")); - pragma Assert (Valid ("a-b-123")); - pragma Assert (Valid ((1 .. 39 => 'a'))); - - pragma Assert (not Valid ("")); - pragma Assert (not Valid ("a_b")); - pragma Assert (not Valid ("a--b")); - pragma Assert (not Valid ("a-b-")); - pragma Assert (not Valid ("-a-b")); - pragma Assert (not Valid ((1 .. 40 => 'a'))); - end Check_GitHub_Logins; - - ----------------------- - -- Check_Git_To_HTTP -- - ----------------------- - - procedure Check_Git_To_HTTP is - use VCSs.Git; - begin - -- Proper transform starting without .git - pragma Assert (Transform_To_Public ("git@github.com:user/project") = - "git+https://github.com/user/project"); - - -- Proper transform starting with .git - pragma Assert (Transform_To_Public ("git@github.com:user/project.git") = - "git+https://github.com/user/project.git"); - - -- GitLab - pragma Assert (Transform_To_Public ("git@gitlab.com:user/project") = - "git+https://gitlab.com/user/project"); - - -- Unknown site, not transformed - pragma Assert (Transform_To_Public ("git@ggithub.com:user/project") = - "git@ggithub.com:user/project"); - - -- No-op for HTTPS - pragma Assert (Transform_To_Public ("https://github.com/user/project") = - "https://github.com/user/project"); - end Check_Git_To_HTTP; - - -------------------------- - -- Check_Regex_Escaping -- - -------------------------- - - procedure Check_Regex_Escaping is - begin - -- See issue #1545 - - -- This should succeed - declare - Match : constant String := Utils.Regex.First_Match - ("^" - & Utils.Regex.Escape ("libstdc++-static") - & "[^\s]*\s+(?:\d+:)?([0-9.]+)", - "libstdc++-static.x86_64 1:2.3.4-5.fc33 updates"); - begin - pragma Assert (Match = "2.3.4", "Match was: " & Match); - end; - - -- This should "fail" - begin - declare - Match : constant String := Utils.Regex.First_Match - ("^libstdc++-static" - & "[^\s]*\s+(?:\d+:)?([0-9.]+)", - "libstdc++-static.x86_64 1:2.3.4-5.fc33 updates") - with Unreferenced; - begin - raise Program_Error with "Previous call should have raised"; - end; - exception - when GNAT.Regpat.Expression_Error => - null; -- Expected - end; - end Check_Regex_Escaping; - - --------- - -- Run -- - --------- - - procedure Run is - begin - Check_Config_Changes; - Check_Email_Checks; - Check_GitHub_Logins; - Check_Git_To_HTTP; - Check_Regex_Escaping; - - Trace.Detail ("Self-checks passed"); - exception - when others => - Trace.Error ("Self-checks failed"); - raise; - end Run; - -end Alire.Selftest; diff --git a/src/alire/alire-selftest.ads b/src/alire/alire-selftest.ads deleted file mode 100644 index 59128c1c..00000000 --- a/src/alire/alire-selftest.ads +++ /dev/null @@ -1,9 +0,0 @@ -package Alire.Selftest is - - procedure Run; - -- Runs all self-tests. Should end silently or raise some exception on - -- failure. - - -- This should eventually be moved to an Ada-based unit testing suite - -end Alire.Selftest; diff --git a/src/alr/alr-commands-dev.adb b/src/alr/alr-commands-dev.adb index 444f3ad1..239ee082 100644 --- a/src/alr/alr-commands-dev.adb +++ b/src/alr/alr-commands-dev.adb @@ -1,7 +1,6 @@ with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; with Ada.Finalization; -with Alire.Selftest; with Alire.Utils; package body Alr.Commands.Dev is @@ -81,10 +80,6 @@ package body Alr.Commands.Dev is Raise_From_Finalization; end if; - if Cmd.Self_Test then - Alire.Selftest.Run; - end if; - if Cmd.UTF_8_Test then Print_UTF_8_Sequence; end if; @@ -138,11 +133,6 @@ package body Alr.Commands.Dev is "", "--raise-finalization", "Raise an exception from a finalization procedure"); - Define_Switch (Config, - Cmd.Self_Test'Access, - "", "--test", - "Run self-tests"); - Define_Switch (Config, Cmd.UTF_8_Test'Access, "", "--utf8", diff --git a/src/alr/alr-commands-dev.ads b/src/alr/alr-commands-dev.ads index bebb54a6..3ac94e66 100644 --- a/src/alr/alr-commands-dev.ads +++ b/src/alr/alr-commands-dev.ads @@ -37,7 +37,6 @@ private Error : aliased Boolean := False; -- Create a recoverable error Raise_Except : aliased Boolean := False; Raise_Final : aliased Boolean := False; - Self_Test : aliased Boolean := False; UTF_8_Test : aliased Boolean := False; -- Produce some UTF-8 output end record; diff --git a/testsuite/README.md b/testsuite/README.md index 5a4b92b7..f8aad00f 100644 --- a/testsuite/README.md +++ b/testsuite/README.md @@ -2,7 +2,24 @@ Alire/ALR's testsuite ===================== This directory intends to host a comprehensive testsuite for Alire/ALR as a -library/tool. The testsuite framework currently requires a Python 3 interpreter +library/tool. There are actually two testsuites: one in Python, which tests +behaviors of `alr` as a user would use it, and another one in Ada, that tests +internal aspects of the codebase. + +# Ada testsuite + +The Ada testsuite leverages the built-in test facilities of `alr`, and hence is +run simply by issuing `alr test` from anywhere inside the crate. + +To add tests to this testsuite, you add new procedures under +`testsuite/tests_ada/src`. You can easily edit all tests by running `alr edit` +from within then `testsuite/tests_ada` folder. + +The remainder of this document deals with the Python testsuite. + +# Python testsuite + +The Python testsuite framework currently requires a Python 3 interpreter with the [e3-testsuite](https://e3-testsuite.readthedocs.io) package (from PyPI) installed. @@ -40,14 +57,14 @@ $ pip install -r requirements.txt $ ./run.py ``` -# Creating tests +## Creating tests All tests are based on running a Python script. There are these test drivers: - `python-script`: run in host in both sandboxed and shared build mode. - The build mode can be narrowed down with the `build_mode` attribute. - `docker-wrapper`: run in a pristine docker Ubuntu image in shared build mode. -# Environment variables +## Environment variables The following variables can be used to modify testsuite behavior. For `ALIRE_TESTSUITE_DISABLE_*` variables, their mere existence activates their diff --git a/testsuite/tests/debug/self-tests/test.py b/testsuite/tests/debug/self-tests/test.py deleted file mode 100644 index 1c03763c..00000000 --- a/testsuite/tests/debug/self-tests/test.py +++ /dev/null @@ -1,14 +0,0 @@ -""" -Do internal self-tests that are simpler to do in Ada code than with a fully- -fledged test case. -""" - -from glob import glob - -from drivers.alr import run_alr - -p = run_alr('dev', '--test', complain_on_error=True, quiet=True) -assert p.status == 0, "alr should have error code 0" - - -print('SUCCESS') diff --git a/testsuite/tests/debug/self-tests/test.yaml b/testsuite/tests/debug/self-tests/test.yaml deleted file mode 100644 index 32c747b3..00000000 --- a/testsuite/tests/debug/self-tests/test.yaml +++ /dev/null @@ -1 +0,0 @@ -driver: python-script diff --git a/testsuite/tests_ada/.gitignore b/testsuite/tests_ada/.gitignore new file mode 100644 index 00000000..2a8a28f8 --- /dev/null +++ b/testsuite/tests_ada/.gitignore @@ -0,0 +1,10 @@ +/alire/ +/bin/ +/config/ +/lib/ +/obj/ + +*.a +*.ali +*.o +*.so diff --git a/testsuite/tests_ada/alire.toml b/testsuite/tests_ada/alire.toml new file mode 100644 index 00000000..a0f585cd --- /dev/null +++ b/testsuite/tests_ada/alire.toml @@ -0,0 +1,12 @@ +name = 'alr_tests' +description = '' +version = '0.0.0-test' + +[[depends-on]] +alr = '*' + +[[pins]] +alr = { path = '../..' } + +[build-profiles] +"*" = 'validation' diff --git a/testsuite/tests_ada/alr_tests.gpr b/testsuite/tests_ada/alr_tests.gpr new file mode 100644 index 00000000..2f081695 --- /dev/null +++ b/testsuite/tests_ada/alr_tests.gpr @@ -0,0 +1,18 @@ +with "config/alr_tests_config.gpr"; +with "config/alr_tests_list_config.gpr"; + +project Alr_Tests is + for Source_Dirs use ("src/", "src_common/", "config/"); + for Object_Dir use "obj/" & Alr_Tests_Config.Build_Profile; + for Create_Missing_Dirs use "True"; + for Exec_Dir use "bin"; + for Main use Alr_Tests_List_Config.Test_Files; + + package Compiler is + for Default_Switches ("Ada") use Alr_Tests_Config.Ada_Compiler_Switches; + end Compiler; + + package Binder is + for Switches ("Ada") use ("-Es"); -- Symbolic traceback + end Binder; +end Alr_Tests; diff --git a/testsuite/tests_ada/src/alr_tests-assertions_enabled.adb b/testsuite/tests_ada/src/alr_tests-assertions_enabled.adb new file mode 100644 index 00000000..d6d9d67f --- /dev/null +++ b/testsuite/tests_ada/src/alr_tests-assertions_enabled.adb @@ -0,0 +1,11 @@ +procedure Alr_Tests.Assertions_Enabled is +begin + -- Ensure assertions are enabled and working as expected + begin + pragma Assert (False, "should always raise"); + exception + when others => + return; -- Assert raised as expected and we are done + end; + raise Program_Error with "assertion was not honored"; +end Alr_Tests.Assertions_Enabled; diff --git a/testsuite/tests_ada/src/alr_tests-config_changes.adb b/testsuite/tests_ada/src/alr_tests-config_changes.adb new file mode 100644 index 00000000..9feb346d --- /dev/null +++ b/testsuite/tests_ada/src/alr_tests-config_changes.adb @@ -0,0 +1,45 @@ +with Alire.Settings.Edit; + +procedure Alr_Tests.Config_Changes is + + -------------------------- + -- Check_Config_Changes -- + -------------------------- + + procedure Check_Config_Changes is + -- Ensure that configuration set in a run is also stored in memory + Key : constant String := "test_key"; + Val : constant String := "nominal"; + begin + Settings.Edit.Set_Globally (Key, Val); + pragma Assert (Settings.DB.Defined (Key)); + pragma Assert (Settings.DB.Get (Key, "snafu") = Val); + + -- Check typed storing + + -- Raw storing of integer + Settings.Edit.Set_Globally (Key, "777"); + pragma Assert (Integer (Settings.DB.Get (Key, 0)) = 777); + + -- Raw storing of boolean + Settings.Edit.Set_Globally (Key, "true"); + pragma Assert (Settings.DB.Get (Key, False) = True); + + -- Typed storing of boolean + Settings.Edit.Set_Boolean (Settings.Global, Key, False); + pragma Assert (Settings.DB.Get (Key, True) = False); + + -- Raw storing of boolean with wrong type + Settings.Edit.Set_Globally (Key, "True"); + -- This causes a string to be stored, as in TOML only "true" is bool + pragma Assert (Settings.DB.Get (Key, "False") = "True"); + + -- Remove test key + Settings.Edit.Unset (Settings.Global, Key); + pragma Assert (Settings.DB.Get (Key, "unset") = "unset"); + + end Check_Config_Changes; + +begin + Check_Config_Changes; +end Alr_Tests.Config_Changes; diff --git a/testsuite/tests_ada/src/alr_tests-email_identification.adb b/testsuite/tests_ada/src/alr_tests-email_identification.adb new file mode 100644 index 00000000..9099a49e --- /dev/null +++ b/testsuite/tests_ada/src/alr_tests-email_identification.adb @@ -0,0 +1,72 @@ +with Alire.Utils; + +procedure Alr_Tests.Email_Identification is + + ------------------------ + -- Check_Email_Checks -- + ------------------------ + + procedure Check_Email_Checks is + use Utils; + begin + -- Check valid emails that must be accepted: + + pragma Assert + (Could_Be_An_Email ("first@last.com", With_Name => False)); + + pragma Assert + (Could_Be_An_Email ("first@last.es", With_Name => False)); + + pragma Assert + (Could_Be_An_Email ("first@a-bcd--ef.com", With_Name => False)); + + pragma Assert + (Could_Be_An_Email ("a@xn--espaa-rta.com.es", With_Name => False)); + -- españa as IDN + + pragma Assert + (Could_Be_An_Email ("first+middle@last.es", With_Name => False)); + + pragma Assert + (Could_Be_An_Email ("+++___@last.es", With_Name => False)); + + pragma Assert + (Could_Be_An_Email ("al.ej.an.dro.@last.com", With_Name => False)); + + pragma Assert + (Could_Be_An_Email ("alan%$dro@last.com", With_Name => False)); + + pragma Assert + (Could_Be_An_Email ("Álex ", With_Name => True)); + -- Non-ascii in name. + + pragma Assert + (Could_Be_An_Email ("First M. Last ", + With_Name => True)); + + -- Check invalid emails that should be rejected: + + pragma Assert + (not Could_Be_An_Email ("first@last", With_Name => False)); + -- Missing at least 2 subdomains + + pragma Assert + (not Could_Be_An_Email ("first@-last.com", With_Name => False)); + -- Leading dash + + pragma Assert + (not Could_Be_An_Email ("first@la False)); + -- Invalid char in domain + + pragma Assert + (not Could_Be_An_Email ("First ", + With_Name => False)); -- With_Name should be true + + pragma Assert + (not Could_Be_An_Email ("Álex", + With_Name => True)); -- Missing space before '<' + end Check_Email_Checks; + +begin + Check_Email_Checks; +end Alr_Tests.Email_Identification; diff --git a/testsuite/tests_ada/src/alr_tests-git_to_http_transforms.adb b/testsuite/tests_ada/src/alr_tests-git_to_http_transforms.adb new file mode 100644 index 00000000..66be2fdf --- /dev/null +++ b/testsuite/tests_ada/src/alr_tests-git_to_http_transforms.adb @@ -0,0 +1,35 @@ +with Alire.VCSs.Git; + +procedure Alr_Tests.Git_To_HTTP_Transforms is + + ----------------------- + -- Check_Git_To_HTTP -- + ----------------------- + + procedure Check_Git_To_HTTP is + use VCSs.Git; + begin + -- Proper transform starting without .git + pragma Assert (Transform_To_Public ("git@github.com:user/project") = + "git+https://github.com/user/project"); + + -- Proper transform starting with .git + pragma Assert (Transform_To_Public ("git@github.com:user/project.git") = + "git+https://github.com/user/project.git"); + + -- GitLab + pragma Assert (Transform_To_Public ("git@gitlab.com:user/project") = + "git+https://gitlab.com/user/project"); + + -- Unknown site, not transformed + pragma Assert (Transform_To_Public ("git@ggithub.com:user/project") = + "git@ggithub.com:user/project"); + + -- No-op for HTTPS + pragma Assert (Transform_To_Public ("https://github.com/user/project") = + "https://github.com/user/project"); + end Check_Git_To_HTTP; + +begin + Check_Git_To_HTTP; +end Alr_Tests.Git_To_HTTP_Transforms; diff --git a/testsuite/tests_ada/src/alr_tests-github_logins.adb b/testsuite/tests_ada/src/alr_tests-github_logins.adb new file mode 100644 index 00000000..7dd108d9 --- /dev/null +++ b/testsuite/tests_ada/src/alr_tests-github_logins.adb @@ -0,0 +1,31 @@ +with Alire.Utils; + +procedure Alr_Tests.Github_Logins is + + ------------------------- + -- Check_GitHub_Logins -- + ------------------------- + + procedure Check_GitHub_Logins is + function Valid (User : String) return Boolean + renames Utils.Is_Valid_GitHub_Username; + begin + -- Examples taken from https://github.com/shinnn/github-username-regex + + pragma Assert (Valid ("a")); + pragma Assert (Valid ("0")); + pragma Assert (Valid ("a-b")); + pragma Assert (Valid ("a-b-123")); + pragma Assert (Valid ((1 .. 39 => 'a'))); + + pragma Assert (not Valid ("")); + pragma Assert (not Valid ("a_b")); + pragma Assert (not Valid ("a--b")); + pragma Assert (not Valid ("a-b-")); + pragma Assert (not Valid ("-a-b")); + pragma Assert (not Valid ((1 .. 40 => 'a'))); + end Check_GitHub_Logins; + +begin + Check_GitHub_Logins; +end Alr_Tests.Github_Logins; diff --git a/testsuite/tests_ada/src/alr_tests-regex_escaping.adb b/testsuite/tests_ada/src/alr_tests-regex_escaping.adb new file mode 100644 index 00000000..05c457a8 --- /dev/null +++ b/testsuite/tests_ada/src/alr_tests-regex_escaping.adb @@ -0,0 +1,45 @@ +with Alire.Utils.Regex; + +with GNAT.Regpat; + +procedure Alr_Tests.Regex_Escaping is + + -------------------------- + -- Check_Regex_Escaping -- + -------------------------- + + procedure Check_Regex_Escaping is + begin + -- See issue #1545 + + -- This should succeed + declare + Match : constant String := Utils.Regex.First_Match + ("^" + & Utils.Regex.Escape ("libstdc++-static") + & "[^\s]*\s+(?:\d+:)?([0-9.]+)", + "libstdc++-static.x86_64 1:2.3.4-5.fc33 updates"); + begin + pragma Assert (Match = "2.3.4", "Match was: " & Match); + end; + + -- This should "fail" + begin + declare + Match : constant String := Utils.Regex.First_Match + ("^libstdc++-static" + & "[^\s]*\s+(?:\d+:)?([0-9.]+)", + "libstdc++-static.x86_64 1:2.3.4-5.fc33 updates") + with Unreferenced; + begin + raise Program_Error with "Previous call should have raised"; + end; + exception + when GNAT.Regpat.Expression_Error => + null; -- Expected + end; + end Check_Regex_Escaping; + +begin + Check_Regex_Escaping; +end Alr_Tests.Regex_Escaping; diff --git a/testsuite/tests_ada/src_common/alr_tests.ads b/testsuite/tests_ada/src_common/alr_tests.ads new file mode 100644 index 00000000..443bedea --- /dev/null +++ b/testsuite/tests_ada/src_common/alr_tests.ads @@ -0,0 +1,7 @@ +pragma Warnings (Off); +with Alire; use Alire; +pragma Warnings (On); + +package Alr_Tests is + +end Alr_Tests; -- 2.39.5