From d6ea245a32bcc74383dc71c2ef933206d471a69e Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Wed, 18 Aug 2021 12:28:45 +0200 Subject: [PATCH] Binary crates, toolchain management and use (#775) * Implement sha256 and hash use test (#765) * Implement binary origins and their deployment * `alr install` for shared installations Essentially, we have a second location for dependencies at ${ALR_CONFIG}/cache. In following PRs the releases therein will be available during dependency resolution, to be reused. `alr install` for manual crate installation Installed crates are used by the solver Autodiscover installed releases Show differences due to changed install status Install: implement release removal * Toolchain configuration assistant Menu for choosing among multiple options Show actual compiler versions to the user Install and remember the user choice User_Input: Take a possible Ctrl-D into account * Re-enable "provides" in index and use them in alr New, more flexible provides type WIP: going back to provides as list of deps All but loading of "provides" Loading of provides Installed provides are used during solving They're not yet used for regular dependencies Display provider in the `alr with` variants Prevent solving of conflicting dependencies If two releases provide the same crate, they cannot be simultaneously in a solution. solver tweaks for provides + externals Improvements to solution space by reusing releases When adding a release to a solution, check whether other dependencies can be satisfied by this same release. Not a big deal, could be disabled if too costly in the future. * Use toolchain in solve/build/environment Insert explicit dependency on the configured gnat Do not explicitly insert dependency on toolchain Instead, we simply coerce when given a generic gnat dependency into the configured one. This is less intrusive as the user does not see unexpected dependencies on the compiler in the solution (unless explicitly requested). Extra info in `alr install` list Generalized assistant for all tools in toolchain * Rename install command to toolchain * Implement "provides" for external detectors For now this is restricted to a single alternate crate name. By necessity, the equivalence has to be to the same version, whereas provides for regular releases are more general as they can rely on precise versions which are known in advance. * Tweaks for new GNAT crate names * Solver: reuse known GNAT on generic gnat= dep * Integrate external gnats in shared releases This is logical because these are always available in all configurations. But the important benefit is that the solver can use them in preference to a remote native compiler. * Documentation in doc/, `alr help` * Fixed circularity, Config.Edit is now untangled * Tweaks to pass existing tests * Self-review fixes and clean-up * New tests for toolchains and related features * Windows-specific testsuite fixes * Review fixes In particular, the avoidance of downloading a compiler for a generic gnat dependency. This is tested in testsuite/tests/solver/compiler-installed --- .gitmodules | 3 + alire.gpr | 3 +- alire.toml | 9 +- alr_env.gpr | 1 + config/alr_config.gpr | 2 + deps/aaa | 2 +- deps/si_units | 1 + doc/catalog-format-spec.md | 67 ++- doc/toolchains.md | 80 +++ doc/user-changes.md | 29 + scripts/alr-completion.bash | 2 +- .../alire-conditional_trees-case_nodes.adb | 28 + src/alire/alire-conditional_trees.adb | 44 ++ src/alire/alire-conditional_trees.ads | 20 + src/alire/alire-config-edit.ads | 7 +- src/alire/alire-config.ads | 11 + src/alire/alire-containers.ads | 102 ---- src/alire/alire-crates.adb | 32 +- src/alire/alire-crates.ads | 7 +- src/alire/alire-dependencies-containers.adb | 32 + src/alire/alire-dependencies-containers.ads | 19 + src/alire/alire-dependencies-graphs.adb | 8 +- src/alire/alire-dependencies-states.adb | 9 +- src/alire/alire-dependencies-states.ads | 110 +++- src/alire/alire-dependencies.ads | 19 +- src/alire/alire-directories.adb | 126 ++-- src/alire/alire-directories.ads | 15 +- src/alire/alire-environment.adb | 28 +- src/alire/alire-environment.ads | 4 +- src/alire/alire-expressions-maps.adb | 16 + src/alire/alire-expressions-maps.ads | 4 + src/alire/alire-externals-from_output.adb | 7 +- src/alire/alire-externals-from_output.ads | 3 +- src/alire/alire-externals-from_system.adb | 7 +- src/alire/alire-externals-from_system.ads | 2 +- src/alire/alire-externals-lists.adb | 6 +- src/alire/alire-externals-lists.ads | 3 +- src/alire/alire-externals-unindexed.ads | 5 +- src/alire/alire-externals.adb | 31 +- src/alire/alire-externals.ads | 18 +- src/alire/alire-hashes-sha256_impl.ads | 9 + src/alire/alire-hashes.ads | 8 +- src/alire/alire-index.adb | 130 ++++- src/alire/alire-index.ads | 20 +- src/alire/alire-milestones-containers.ads | 12 + src/alire/alire-milestones-holders.ads | 4 - src/alire/alire-milestones.ads | 10 +- ...alire-origins-deployers-source_archive.adb | 2 +- .../alire-origins-deployers-system-apt.adb | 4 +- .../alire-origins-deployers-system-pacman.adb | 4 +- ...-origins-deployers-system-rpm_wrappers.adb | 4 +- src/alire/alire-origins-deployers-system.adb | 2 +- src/alire/alire-origins-deployers.adb | 8 +- src/alire/alire-origins-deployers.ads | 2 + src/alire/alire-origins.adb | 549 +++++++++++++++--- src/alire/alire-origins.ads | 189 +++--- src/alire/alire-paths.ads | 2 + src/alire/alire-platform.ads | 2 +- .../alire-properties-actions-executor.adb | 30 +- src/alire/alire-provides.adb | 77 +++ src/alire/alire-provides.ads | 37 ++ ...ners.adb => alire-releases-containers.adb} | 153 +++-- src/alire/alire-releases-containers.ads | 105 ++++ src/alire/alire-releases.adb | 180 +++++- src/alire/alire-releases.ads | 91 ++- src/alire/alire-root.adb | 22 + src/alire/alire-root.ads | 4 + src/alire/alire-roots-editable.adb | 11 +- src/alire/alire-roots-editable.ads | 22 +- src/alire/alire-roots-optional.adb | 2 +- src/alire/alire-roots.adb | 168 +++--- src/alire/alire-roots.ads | 7 +- src/alire/alire-shared.adb | 279 +++++++++ src/alire/alire-shared.ads | 38 ++ src/alire/alire-solutions-diffs.adb | 60 +- src/alire/alire-solutions.adb | 513 ++++++++++++++-- src/alire/alire-solutions.ads | 347 ++--------- src/alire/alire-solver.adb | 514 +++++++++++----- src/alire/alire-solver.ads | 12 +- src/alire/alire-toml_adapters.adb | 2 +- src/alire/alire-toml_index.adb | 7 + src/alire/alire-toml_load.adb | 16 + src/alire/alire-toml_load.ads | 6 +- src/alire/alire-toolchains-solutions.adb | 51 ++ src/alire/alire-toolchains-solutions.ads | 18 + src/alire/alire-toolchains.adb | 286 +++++++++ src/alire/alire-toolchains.ads | 84 +++ src/alire/alire-uri.adb | 38 ++ src/alire/alire-uri.ads | 28 - src/alire/alire-user_pins.adb | 2 +- src/alire/alire-user_pins.ads | 4 +- src/alire/alire-utils-tty.ads | 26 + src/alire/alire-utils-user_input.adb | 127 ++++ src/alire/alire-utils-user_input.ads | 9 +- src/alire/alire-utils.ads | 3 + src/alire/alire-vcss-git.adb | 8 +- src/alire/alire-vcss-git.ads | 8 + src/alire/alire-vcss-hg.ads | 2 + src/alire/alire.adb | 5 +- src/alire/alire.ads | 16 +- src/alire/os_windows/alire-platform.adb | 1 + src/alr/alr-commands-help.adb | 13 +- src/alr/alr-commands-search.adb | 24 +- src/alr/alr-commands-show.adb | 23 +- src/alr/alr-commands-test.adb | 16 +- src/alr/alr-commands-toolchain.adb | 249 ++++++++ src/alr/alr-commands-toolchain.ads | 61 ++ src/alr/alr-commands.adb | 49 +- src/alr/alr-commands.ads | 22 +- testsuite/drivers/alr.py | 15 +- testsuite/drivers/asserts.py | 11 + testsuite/drivers/helpers.py | 15 +- testsuite/fix-versions.sh | 4 +- testsuite/fixtures/basic_index/index.toml | 2 +- testsuite/fixtures/cases_index/index.toml | 2 +- testsuite/fixtures/checked_index/index.toml | 2 +- testsuite/fixtures/git_index/index.toml | 2 +- testsuite/fixtures/native_index/index.toml | 2 +- testsuite/fixtures/run_index/index.toml | 2 +- testsuite/fixtures/solver_index/index.toml | 2 +- .../cr/crate_clash/crate_clash-1.0.0.toml | 10 + .../cr/crate_equiv/crate_equiv-2.0.0.toml | 10 + .../cr/crate_lone/crate_lone-1.0.0.toml | 12 + .../cr/crate_lone/crate_lone-2.0.0.toml | 10 + .../gn/gnat_cross_1/gnat_cross_1-1.0.0.toml | 11 + .../gnat_cross_1/gnat_cross_1-9999.0.0.toml | 11 + .../gn/gnat_cross_2/gnat_cross_2-1.0.0.toml | 11 + .../gnat_external/gnat_external-external.toml | 12 + .../gn/gnat_native/gnat_native-1.0.0.toml | 11 + .../gn/gnat_native/gnat_native-2.0.0.toml | 11 + testsuite/fixtures/toolchain_index/index.toml | 1 + .../local-index/my_index/index/index.toml | 2 +- .../basic/my_index/index/index.toml | 2 +- .../gen_control/my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../tests/get/build/my_index/index/index.toml | 2 +- .../my_index/index.toml | 2 +- .../get/external-tool-dependency/test.py | 1 + .../indirect-link/my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../bad-config-vars/my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../bad-license/my_index/index/index.toml | 2 +- .../index/bad-tag/my_index/index/index.toml | 2 +- .../check-enums/my_index/index/index.toml | 2 +- .../index/empty-tag/my_index/index/index.toml | 2 +- .../environment/my_index/index/index.toml | 2 +- .../external-available/my_index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../index/external-hint/my_index/index.toml | 2 +- .../index/external-msys2/my_index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../index/long-tag/my_index/index/index.toml | 2 +- .../maint-bad-email/my_index/index/index.toml | 2 +- .../maint-bad-login/my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../bad_index_1/index.toml | 2 +- .../bad_index_2/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/cr/crate/crate-1.0.0.toml | 15 + .../my_index/index/cr/crate/crate-2.0.0.toml | 16 + .../misc/hashes/my_index/index/index.toml | 1 + testsuite/tests/misc/hashes/test.py | 23 + testsuite/tests/misc/hashes/test.yaml | 5 + .../tests/pin/all/my_index/index/index.toml | 2 +- .../tests/pin/change-type/my_index/index.toml | 2 +- .../pin/downgrade/my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../pin-dir-with-regular/my_index/index.toml | 2 +- .../tests/pin/pin-dir/my_index/index.toml | 2 +- .../pin/post-update/my_index/index/index.toml | 2 +- .../pin/twice-in-manifest/my_index/index.toml | 2 +- .../unneeded-held/my_index/index/index.toml | 2 +- .../double-set/my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../linked-paths/my_index/index/index.toml | 2 +- .../check-build/my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../my_index/index/index.toml | 2 +- .../tarball-repo/my_index/index/index.toml | 2 +- .../tests/solver/compiler-installed/test.py | 78 +++ .../tests/solver/compiler-installed/test.yaml | 4 + .../tests/solver/compiler-mixing/test.py | 87 +++ .../tests/solver/compiler-mixing/test.yaml | 4 + .../tests/solver/compiler-priorities/test.py | 113 ++++ .../solver/compiler-priorities/test.yaml | 4 + .../tests/solver/compiler-selected/test.py | 36 ++ .../tests/solver/compiler-selected/test.yaml | 4 + .../solver/equivalences-conflict/test.py | 26 + .../solver/equivalences-conflict/test.yaml | 4 + testsuite/tests/solver/equivalences/test.py | 41 ++ testsuite/tests/solver/equivalences/test.yaml | 4 + .../action-test/my_index/index/index.toml | 2 +- .../tests/toolchain/bad-switches/test.py | 20 + .../tests/toolchain/bad-switches/test.yaml | 4 + testsuite/tests/toolchain/basic/test.py | 55 ++ testsuite/tests/toolchain/basic/test.yaml | 4 + testsuite/tests/toolchain/directories/test.py | 63 ++ .../tests/toolchain/directories/test.yaml | 4 + testsuite/tests/toolchain/select/test.py | 28 + testsuite/tests/toolchain/select/test.yaml | 4 + .../selective/my_index/index/index.toml | 2 +- .../my_index/updated/index/index.toml | 2 +- .../auto-gpr-with/basic/my_index/index.toml | 2 +- .../gpr_in_subdir/my_index/index.toml | 2 +- .../narrow-pre1/my_index/index/index.toml | 2 +- .../with/pin-dir/my_index/index/index.toml | 2 +- .../action-command/my_index/index/index.toml | 2 +- .../tests/workflows/edit/my_index/index.toml | 2 +- 217 files changed, 5339 insertions(+), 1357 deletions(-) create mode 160000 deps/si_units create mode 100644 doc/toolchains.md create mode 100644 src/alire/alire-hashes-sha256_impl.ads create mode 100644 src/alire/alire-milestones-containers.ads delete mode 100644 src/alire/alire-milestones-holders.ads create mode 100644 src/alire/alire-provides.adb create mode 100644 src/alire/alire-provides.ads rename src/alire/{alire-containers.adb => alire-releases-containers.adb} (51%) create mode 100644 src/alire/alire-releases-containers.ads create mode 100644 src/alire/alire-shared.adb create mode 100644 src/alire/alire-shared.ads create mode 100644 src/alire/alire-toolchains-solutions.adb create mode 100644 src/alire/alire-toolchains-solutions.ads create mode 100644 src/alire/alire-toolchains.adb create mode 100644 src/alire/alire-toolchains.ads create mode 100644 src/alire/alire-uri.adb create mode 100644 src/alr/alr-commands-toolchain.adb create mode 100644 src/alr/alr-commands-toolchain.ads create mode 100644 testsuite/fixtures/toolchain_index/cr/crate_clash/crate_clash-1.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/cr/crate_equiv/crate_equiv-2.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/cr/crate_lone/crate_lone-1.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/cr/crate_lone/crate_lone-2.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/gn/gnat_cross_1/gnat_cross_1-1.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/gn/gnat_cross_1/gnat_cross_1-9999.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/gn/gnat_cross_2/gnat_cross_2-1.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/gn/gnat_external/gnat_external-external.toml create mode 100644 testsuite/fixtures/toolchain_index/gn/gnat_native/gnat_native-1.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/gn/gnat_native/gnat_native-2.0.0.toml create mode 100644 testsuite/fixtures/toolchain_index/index.toml create mode 100644 testsuite/tests/misc/hashes/my_index/index/cr/crate/crate-1.0.0.toml create mode 100644 testsuite/tests/misc/hashes/my_index/index/cr/crate/crate-2.0.0.toml create mode 100644 testsuite/tests/misc/hashes/my_index/index/index.toml create mode 100644 testsuite/tests/misc/hashes/test.py create mode 100644 testsuite/tests/misc/hashes/test.yaml create mode 100644 testsuite/tests/solver/compiler-installed/test.py create mode 100644 testsuite/tests/solver/compiler-installed/test.yaml create mode 100644 testsuite/tests/solver/compiler-mixing/test.py create mode 100644 testsuite/tests/solver/compiler-mixing/test.yaml create mode 100644 testsuite/tests/solver/compiler-priorities/test.py create mode 100644 testsuite/tests/solver/compiler-priorities/test.yaml create mode 100644 testsuite/tests/solver/compiler-selected/test.py create mode 100644 testsuite/tests/solver/compiler-selected/test.yaml create mode 100644 testsuite/tests/solver/equivalences-conflict/test.py create mode 100644 testsuite/tests/solver/equivalences-conflict/test.yaml create mode 100644 testsuite/tests/solver/equivalences/test.py create mode 100644 testsuite/tests/solver/equivalences/test.yaml create mode 100644 testsuite/tests/toolchain/bad-switches/test.py create mode 100644 testsuite/tests/toolchain/bad-switches/test.yaml create mode 100644 testsuite/tests/toolchain/basic/test.py create mode 100644 testsuite/tests/toolchain/basic/test.yaml create mode 100644 testsuite/tests/toolchain/directories/test.py create mode 100644 testsuite/tests/toolchain/directories/test.yaml create mode 100644 testsuite/tests/toolchain/select/test.py create mode 100644 testsuite/tests/toolchain/select/test.yaml diff --git a/.gitmodules b/.gitmodules index d67ac924..c3e76908 100644 --- a/.gitmodules +++ b/.gitmodules @@ -42,3 +42,6 @@ [submodule "deps/toml_slicer"] path = deps/toml_slicer url = https://github.com/mosteo/toml_slicer +[submodule "deps/si_units"] + path = deps/si_units + url = https://github.com/HeisenbugLtd/si_units.git diff --git a/alire.gpr b/alire.gpr index 32084138..3c929f64 100644 --- a/alire.gpr +++ b/alire.gpr @@ -8,10 +8,11 @@ with "minirest"; with "optional"; with "semantic_versioning"; with "simple_logging"; +with "si_units"; +with "spdx"; with "toml_slicer"; with "uri"; with "xml_ez_out"; -with "spdx"; library project Alire is diff --git a/alire.toml b/alire.toml index b6ecc284..fa806da8 100644 --- a/alire.toml +++ b/alire.toml @@ -24,6 +24,8 @@ minirest = "~0.2" optional = "~0.0.0" semantic_versioning = "^2" simple_logging = "^1.2" +si_units = "~0.2" +toml_slicer = "~0.1" uri_ada = "^1" spdx = "~0.2" @@ -33,13 +35,14 @@ macos = { OS = "macOS" } # Most dependencies require precise versions during the development cycle: [[pins]] -aaa = { url = "https://github.com/mosteo/aaa.git", commit = "ccb78861bd7589dfcce08a70b69cdc72169bbf4a" } +aaa = { url = "https://github.com/mosteo/aaa.git", commit = "32ee4c80001ae388d8ae43b8a3aac94ccba30614" } ada_toml = { url = "https://github.com/pmderodat/ada-toml.git", commit = "ade3cc905cef405dbf53e16a54f6fb458482710f" } ajunitgen = { url = "https://github.com/mosteo/ajunitgen.git", commit = "e5d01db5e7834d15c4066f0a8e33d780deae3cc9" } ansiada = { url = "https://github.com/mosteo/ansi-ada.git", commit = "acf9afca3afe1f8b8843c061f3cef860d7567307" } gnatcoll = { url = "https://github.com/alire-project/gnatcoll-core.git", commit = "f3bd1c51d12962879f52733e790b394f5bbfe05f" } minirest = { url = "https://github.com/mosteo/minirest.git", commit = "4550aa356d55b9cd55f26acd34701f646021c5ff" } -optional = { url = "https://github.com/mosteo/optional.git", commit = "eb929e67ccd357881997d4eed5e4477144923d7c" } -semantic_versioning = { url = "https://github.com/alire-project/semantic_versioning.git", commit = "85689acb6dfde74d00473b41563b75adf76f4881" } +optional = { url = "https://github.com/mosteo/optional.git", commit = "0c7d20c0c8b48ccb6b25fb648d48382e598c25c3" } +semantic_versioning = { url = "https://github.com/alire-project/semantic_versioning.git", commit = "fe4e72e40786589a66d53662639f894fcdb3419c" } simple_logging = { url = "https://github.com/alire-project/simple_logging.git", commit = "02a7de7568af6af7cedd1048901fae8e9477b1d9" } +toml_slicer = { url = "https://github.com/mosteo/toml_slicer.git", commit = "1c0286bd724c6f257a36fc89412fcefd4f555228" } uri_ada = { url = "https://github.com/mosteo/uri-ada.git", commit = "b61eba59099b3ab39e59e228fe4529927f9e849e" } diff --git a/alr_env.gpr b/alr_env.gpr index e1e5e9a6..2d2cb420 100644 --- a/alr_env.gpr +++ b/alr_env.gpr @@ -12,6 +12,7 @@ aggregate project Alr_Env is "deps/optional", "deps/semantic_versioning", "deps/simple_logging", + "deps/si_units", "deps/toml_slicer", "deps/uri-ada", "deps/xmlezout", diff --git a/config/alr_config.gpr b/config/alr_config.gpr index 802354b4..ee511511 100644 --- a/config/alr_config.gpr +++ b/config/alr_config.gpr @@ -6,8 +6,10 @@ with "gnatcoll.gpr"; with "minirest.gpr"; with "optional.gpr"; with "semantic_versioning.gpr"; +with "si_units.gpr"; with "simple_logging.gpr"; with "spdx.gpr"; +with "toml_slicer.gpr"; with "uri.gpr"; abstract project alr_Config is diff --git a/deps/aaa b/deps/aaa index 594a7d58..32ee4c80 160000 --- a/deps/aaa +++ b/deps/aaa @@ -1 +1 @@ -Subproject commit 594a7d58350ce7e7eb8dbc25fa1c1d0cb1ef4477 +Subproject commit 32ee4c80001ae388d8ae43b8a3aac94ccba30614 diff --git a/deps/si_units b/deps/si_units new file mode 160000 index 00000000..39de6478 --- /dev/null +++ b/deps/si_units @@ -0,0 +1 @@ +Subproject commit 39de6478ba6d63c24dd34dd7205a6ce2cb971703 diff --git a/doc/catalog-format-spec.md b/doc/catalog-format-spec.md index f924b6f7..11ddcba7 100644 --- a/doc/catalog-format-spec.md +++ b/doc/catalog-format-spec.md @@ -261,6 +261,10 @@ static, i.e. they cannot depend on the context. project documentation on [extended version sets](https://github.com/alire-project/semantic_versioning#types). + See also the [section on compiler dependencies](#compiler-versions-and-cross-compilers) + for more details on how to use the `depends-on` property for cross-compiling or + compiler version selection. + - `project-files`: optional list of strings. Each is a path, relative to the root of the source directory, to a `.gpr` project file to be made available. Expressions are accepted. For instance: @@ -425,7 +429,7 @@ static, i.e. they cannot depend on the context. notes = "Experimental version" ``` - - `configuration` optional table to control crate configuration code + - `configuration`: optional table to control crate configuration code generators: For more information on crate configuration, see [Using crate @@ -449,7 +453,7 @@ static, i.e. they cannot depend on the context. GPR file configuration (default: `true`). - - `configuration.variables` optional table of crate configuration variable + - `configuration.variables`: optional table of crate configuration variable definitions. For more information on crate configuration, see [Using crate @@ -508,6 +512,18 @@ static, i.e. they cannot depend on the context. crate_2.var1 = "Debug" ``` + - `provides`: specifies a list of releases of another crate for which the + current release is a drop-in replacement. I.e., the crate is either + API-compatible or call-compatible, depending on how it is to be used (as a + source library, or providing some command-line tool). + + Example: + ```toml + name = "foo" + provides = ["bar=1.1"] + # A crate depending on `bar^1` might find this `foo` release in its solution instead. + ``` + ## Work-in-progress dependency overrides It is usual to develop several interdependent crates at the same time. In this scenario, it is often impractical to rely on indexed releases which are not intended to be modified. Instead, one would prefer to use a work-in-progress version of a crate to fulfill some dependency. @@ -627,6 +643,12 @@ version-regexp = "^GNAT ([\\d\\.]+).*|^GNAT Community ([\\d]{4}).*" # TOML-escaped GNAT.Regpat-compatible regular expression. Parenthesized # matches will cause the matched expression to be parsed as the Semantic # Version of the tool. + +provides = "another_crate_name" +# This crate will be equivalent to `another_crate_name` for the solver. The +# version will be the same as detected for the current external. For example, +# all GNAT compilers provide the "gnat" crate, and so there cannot be two +# compilers in the same solution. ``` ### External kinds: system packages @@ -837,6 +859,47 @@ It can be used in the main GPR file like so: With the files `test-sort__bubble.adb`, `test-sort__quick.adb` and `test-sort__merge.adb` each implementing a different algorithm. +## Compiler versions and cross-compilers + +Dependencies in Alire are used also to deal with compiler versions and +cross-compilers. Also related is the information on toolchains available in the +[Toolchain management](./toolchains.md) document or via `alr help toolchains`. + +### Excluding compiler versions + +One may know that a particular compiler version has a problem with some code. +This may be expressed with dependencies on the generic `gnat` crate, which +although is not found in the catalog, is a crate that all GNAT compilers +provide. (Such a crate without actual releases, but provided by other crates, +is called a virtual crate.) For example: + +```toml +gnat = ">=7" # We require a minimum compiler version +gnat = "/=7.3" # We know a precise version is incompatible +``` + +Since only one dependency on a same crate may appear, the relational operators +`&` (and), `|` (or) can be used instead: + +```toml +[[depends-on]] +gnat = "/=7.3 & >=7" +``` + +### Requesting a compiler for a concrete target + +The other use of compiler dependencies is to specify that a compiler for a +particular target is needed. (Note that the project file **also** has to +specify the proper target and runtime.) This way Alire can configure the +appropriate environment for the build. For example: + +```toml +gnat_arm_elf = "*" # Any compiler targeting ARM +``` + +Dependencies on cross-compilers should **only** be used in crates that actually +require a concrete target (e.g., final binaries) to avoid preventing their use +as general libraries with any compiler. ## Further reading ## diff --git a/doc/toolchains.md b/doc/toolchains.md new file mode 100644 index 00000000..124e5347 --- /dev/null +++ b/doc/toolchains.md @@ -0,0 +1,80 @@ +# Toolchain management + +Toolchains are comprised by a GNAT compiler and a `gprbuild` project file +processor. Alire strives to simplify the availability of GNAT releases, which +are packaged to be retrieved and used with ease. Still, the compiler preferred +by the user might not be appropriate for some crates, which may cause subtle +interactions that this section explains. + +Some crates may require particular GNAT compilers (for example for +cross-compilation). Note that, independently of the compiler finally made +available by `alr` in the environment, the crate project file still must define +an appropriate `Target` attribute for the desired compiler. At the moment, Alire +does not examine project file contents to identify necessary compilers, and +relies only on regular `depends-on` dependencies. + +There are two sides to toolchain use by `alr`. On the one hand, a solution may +or may not have dependencies on GNAT compilers. On the other hand, the user may +or may have not selected a default toolchain for use via `alr toolchain +--select`. The interaction between these two features is explained next. + +Before going into the details, there are two kind of dependencies on GNAT +compilers: generic dependencies on the `gnat` crate, which apply to every +compiler, and dependencies on a precise native or cross-compiler, e.g., +`gnat_native` or `gnat_riscv_elf`. + +## Identifying available compilers + +Available compilers can be listed with `alr search --full --external-detect +gnat_`. They will also be shown by the selection assistant, `alr toolchain +--select`. + +## Specifying dependencies on GNAT compilers + +From the point of view of a user preparing a release for publication, these +are the considerations to bear in mind: + +- Do not use any dependency on a compiler if you do not have a reason to do so. +- Use dependencies on `gnat` to specify known compiler version restrictions. +- Use dependencies on a precise gnat cross-compiler (e.g., `gnat_riscv_elf`) + when your crate is purposely only available for such a target. +- There is no reason to specify a dependency on the native compiler + (`gnat_native`) as that would unnecessarily limit the availability of a + library crate that might be useful to dependent cross-target crates. + +## Interactions with a selected toolchain + +From the point of view of a user wanting to compile some release, there will be +an interaction between the solution dependency on compilers and a selected +default compiler. + +The simplest and most usual scenario for native compilation is as follows: + +- Solution without dependencies on `gnat`: + - If a default compiler has been configured: the compiler will be included in the + PATH provided by `alr printenv` and used for the build. + - No compiler has been configured: `alr` will attempt to use whatever toolchain is + available in the user's environment prior to running `alr`. + - Note that compilers deployed with `alr toolchain --install` but not + selected as the default will not be used in this case. + +For crates with dependencies on GNAT compilers, the following two cases simultaneously apply: + +- Solution with generic dependencies on `gnat`: The solver will provide a + concrete GNAT to satisfy this dependency, applying the following + prioritization: + 1. A target-specific compiler that is already a dependency. + 1. The default compiler, if it has been defined. + 1. A native compiler that is already deployed. + 1. A cross-compiler that is already deployed. + 1. A native compiler from the index, that will be deployed with the rest of dependencies. + 1. A cross-compiler from the index, that will be deployed with the rest of dependencies. + +- Solution with dependencies on a target-specific GNAT (`gnat_native`, `gnat_ricv_elf`, + etc.): The `alr` solver will provide one compiler in the environment, applying the + following prioritization: + 1. A matching compiler that is already deployed, explicitly via `alr + toolchain --select`/`alr toolchain --install`, or implicitly during a previous + solving. + 1. A compiler that satisfies the dependency available in the catalog, + which will be deployed as part of regular dependency retrieval. diff --git a/doc/user-changes.md b/doc/user-changes.md index 2725c48f..89a89893 100644 --- a/doc/user-changes.md +++ b/doc/user-changes.md @@ -6,6 +6,35 @@ stay on top of `alr` new features. ## Release `1.1` +### Toolchain management + +PR [#775](https://github.com/alire-project/alire/pull/775) + +A variety of GNAT compilers (native and cross-target) is now available through +Alire. These compilers are managed with the `alr toolchain` new command. The +available compilers can be listed with `alr search --full gnat_`. + +Toolchain configuration is common to all crates in the active configuration +prefix (which can be switched with the global `-c` option or by providing a +path with the `ALR_CONFIG` environment variable). + +The `alr toolchain --select` subcommand allows selecting the preferred default +compiler (or none at all, to continue using the previous mode of operation) for +crates that do not specify one. + +Crates that require a particular cross-compiler may now specify it as a regular +dependency on, e.g., `gnat_riscv_elf`. + +In addition to a default compiler, the preferred version of a compiler for a +target may be made available with `alr toolchain --install `. +When launching a build, Alire will use preferably the default selected compiler +or, if the default is for a different target, one of the other installed +compilers. If no installed compiler is available for the crate target, Alire +will offer to download the appropriate cross-target compiler. + +Finally, running `alr toolchain` without arguments will list the currently +installed compilers and gprbuild versions. + ### Pins to git branches PR [#754](https://github.com/alire-project/alire/pull/754) diff --git a/scripts/alr-completion.bash b/scripts/alr-completion.bash index 990b34d1..bc86f91f 100755 --- a/scripts/alr-completion.bash +++ b/scripts/alr-completion.bash @@ -46,7 +46,7 @@ function _alr_completion() { # Command-specific completions $found &&\ case $cmd in - get | show) + get | show | toolchain) # Suggest crate names COMPREPLY+=($(compgen -W "$_alr_crates" -- $curr)) ;; diff --git a/src/alire/alire-conditional_trees-case_nodes.adb b/src/alire/alire-conditional_trees-case_nodes.adb index c502d5af..3e527e7c 100644 --- a/src/alire/alire-conditional_trees-case_nodes.adb +++ b/src/alire/alire-conditional_trees-case_nodes.adb @@ -30,6 +30,11 @@ package body Alire.Conditional_Trees.Case_Nodes is Verbose : Boolean; Sorted : Boolean); + overriding + procedure Recursive_Traversal + (This : in out Case_Node; + Apply : access procedure (Value : in out Values)); + overriding procedure To_TOML (This : Case_Node; Parent : TOML.TOML_Value); @@ -197,6 +202,29 @@ package body Alire.Conditional_Trees.Case_Nodes is return Flat.Root; end Flatten; + ------------------------- + -- Recursive_Traversal -- + ------------------------- + + overriding + procedure Recursive_Traversal + (This : in out Case_Node; + Apply : access procedure (Value : in out Values)) + is + + ----------------- + -- Local_Apply -- + ----------------- + + procedure Local_Apply (Value : in out Tree) is + begin + Value.Visit_All (Apply); + end Local_Apply; + + begin + This.Cases.Visit_All (Local_Apply'Access); + end Recursive_Traversal; + ------------- -- To_TOML -- ------------- diff --git a/src/alire/alire-conditional_trees.adb b/src/alire/alire-conditional_trees.adb index 3811a488..2db4efaa 100644 --- a/src/alire/alire-conditional_trees.adb +++ b/src/alire/alire-conditional_trees.adb @@ -627,4 +627,48 @@ package body Alire.Conditional_Trees is return Tree is (Tree'(To_Holder (Element (Pos)))); + ------------------------- + -- Recursive_Traversal -- + ------------------------- + + overriding + procedure Recursive_Traversal + (This : in out Leaf_Node; + Apply : access procedure (Value : in out Values)) + is + begin + Apply (This.Value.Reference); + end Recursive_Traversal; + + ------------------------- + -- Recursive_Traversal -- + ------------------------- + + overriding + procedure Recursive_Traversal + (This : in out Vector_Node; + Apply : access procedure (Value : in out Values)) + is + begin + for Node of This.Values loop + Node.Recursive_Traversal (Apply); + end loop; + end Recursive_Traversal; + + --------------- + -- Visit_All -- + --------------- + + procedure Visit_All + (This : in out Tree; + Apply : access procedure (Value : in out Values)) + is + begin + if This.Is_Empty then + return; + else + This.Reference.Recursive_Traversal (Apply); + end if; + end Visit_All; + end Alire.Conditional_Trees; diff --git a/src/alire/alire-conditional_trees.ads b/src/alire/alire-conditional_trees.ads index a042ea0f..d39aae26 100644 --- a/src/alire/alire-conditional_trees.ads +++ b/src/alire/alire-conditional_trees.ads @@ -68,6 +68,11 @@ package Alire.Conditional_Trees with Preelaborate is -- Recursively merge all subtree elements in a single value or vector. -- Since it cannot result in an empty tree, it returns a proper node. + procedure Recursive_Traversal + (This : in out Node; + Apply : access procedure (Value : in out Values)) is abstract; + -- Enables full traversal with modification of children + procedure To_TOML (This : Node; Parent : TOML.TOML_Value) is abstract with Pre'Class => Parent.Kind = TOML.TOML_Table; @@ -216,6 +221,11 @@ package Alire.Conditional_Trees with Preelaborate is function Conjunction (This : Tree) return Conjunctions with Pre => This.Root in Vector_Node; + procedure Visit_All + (This : in out Tree; + Apply : access procedure (Value : in out Values)); + -- Depth-first recursive traversal of all values, irrespective of node type + -- Following iterators/accessors are used during dependency resolution, and -- for that reason they will fail for conditional trees. @@ -327,6 +337,11 @@ private Verbose : Boolean; Sorted : Boolean := False); + overriding + procedure Recursive_Traversal + (This : in out Leaf_Node; + Apply : access procedure (Value : in out Values)); + overriding procedure To_TOML (This : Leaf_Node; Parent : TOML.TOML_Value); @@ -422,6 +437,11 @@ private Verbose : Boolean; Sorted : Boolean); + overriding + procedure Recursive_Traversal + (This : in out Vector_Node; + Apply : access procedure (Value : in out Values)); + overriding procedure To_TOML (This : Vector_Node; Parent : TOML.TOML_Value); diff --git a/src/alire/alire-config-edit.ads b/src/alire/alire-config-edit.ads index 66944653..2aaf8681 100644 --- a/src/alire/alire-config-edit.ads +++ b/src/alire/alire-config-edit.ads @@ -140,7 +140,12 @@ private (+Keys.Warning_Caret, Cfg_Bool, +("If true, Alire will warn about the use of caret (^) " - & "for pre-1 dependencies.")) + & "for pre-1 dependencies.")), + + (+Keys.Toolchain_Assistant, + Cfg_Bool, + +("If true, and assistant to select the default toolchain will run " + & "when first needed.")) ); diff --git a/src/alire/alire-config.ads b/src/alire/alire-config.ads index f15cd15e..1d777c5b 100644 --- a/src/alire/alire-config.ads +++ b/src/alire/alire-config.ads @@ -91,6 +91,17 @@ package Alire.Config with Preelaborate is -- When true, `alr with` will substitute "any" dependencies by the -- appropriate caret/tilde. + Toolchain_Assistant : constant Config_Key := "toolchain.assistant"; + -- When true (default), on first `Requires_Valid_Session`, the + -- assistant to select a gnat compiler and corresponding gprbuild + -- will be launched. + + Toolchain_Use : constant Config_Key := "toolchain.use"; + -- We use this key internally to store the configured tools picked + -- up by the user. Not really intended to be set up by users, so + -- not listed as a built-in. Each tool is a child of this key, + -- e.g.: toolchain.use.gnat, toolchain.use.gprbuild + Update_Manually : constant Config_Key := "update-manually-only"; -- Used by `get --only` to flag a workspace to not autoupdate itself -- despite having no solution in the lockfile. diff --git a/src/alire/alire-containers.ads b/src/alire/alire-containers.ads index 3b3a4f13..af78037d 100644 --- a/src/alire/alire-containers.ads +++ b/src/alire/alire-containers.ads @@ -1,110 +1,8 @@ -with Ada.Containers.Indefinite_Doubly_Linked_Lists; -with Ada.Containers.Indefinite_Holders; -with Ada.Containers.Indefinite_Ordered_Maps; with Ada.Containers.Indefinite_Ordered_Sets; -with Alire.Conditional; -with Alire.Dependencies; -with Alire.Milestones; -with Alire.Properties; -with Alire.Releases; - package Alire.Containers is package Crate_Name_Sets is new Ada.Containers.Indefinite_Ordered_Sets (Crate_Name); - package Dependency_Lists - is new Ada.Containers.Indefinite_Doubly_Linked_Lists - (Dependencies.Dependency, - Dependencies."="); - - package Dependency_Maps - is new Ada.Containers.Indefinite_Ordered_Maps - (Crate_Name, Dependencies.Dependency, - "<", Dependencies."="); - - type Dependency_Map is new Dependency_Maps.Map with null record; - - Empty_Dependency_Map : constant Dependency_Map; - - function Enumerate (These : Conditional.Dependencies) return Dependency_Map; - -- Eliminate OR branches in These by recursive enumeration; that is, all OR - -- branches will appear in the result. - - procedure Merge (This : in out Dependency_Map; - Dep : Dependencies.Dependency); - -- If the dependency is already in map, create a combined dependency that - -- ANDs both. - - package Milestone_Sets - is new Ada.Containers.Indefinite_Ordered_Sets (Milestones.Milestone, - Milestones."<", - Milestones."="); - - package Release_Sets - is new Ada.Containers.Indefinite_Ordered_Sets (Releases.Release, - Releases."<", - Releases."="); - subtype Release_Set is Release_Sets.Set; - - package Release_Holders - is new Ada.Containers.Indefinite_Holders (Releases.Release, - Releases."="); - subtype Release_H is Release_Holders.Holder; - - package Crate_Release_Maps is new Ada.Containers.Indefinite_Ordered_Maps - (Crate_Name, Releases.Release, "<", Releases."="); - type Release_Map is new Crate_Release_Maps.Map with null record; - - Empty_Release_Map : constant Release_Map; - - function Excluding (Map : Release_Map; - Name : Crate_Name) - return Release_Map; - - function Including (Map : Release_Map; - Release : Releases.Release) - return Release_Map; - -- Finds the current release (if existing) and replaces/adds the new - -- Release. - - procedure Insert (Dst : in out Release_Map; Src : Releases.Release); - -- Insert a release under its name as key - - procedure Insert (Dst : in out Release_Map; Src : Release_Map); - - function Inserting (Dst : Release_Map; - Src : Release_Map) - return Release_Map; - - function Inserting (Dst : Release_Map; - Src : Releases.Release) - return Release_Map; - -- Those insert both under the actual crate name and Provides, if - -- different. - - function To_Dependencies (Map : Release_Map) - return Conditional.Dependencies; - -- Will filter out duplicates under Provides key (only actual crates will - -- remain). - - function Whenever (Map : Release_Map; - Props : Properties.Vector) return Release_Map; - -- Replace every release with one that has no case expressions, using - -- environment Props. - - function To_Map (R : Releases.Release) return Release_Map; - - function To_Release_H (R : Releases.Release) return Release_H - renames Release_Holders.To_Holder; - -private - - Empty_Dependency_Map : constant Dependency_Map := - (Dependency_Maps.Empty_Map with null record); - - Empty_Release_Map : constant Release_Map := - (Crate_Release_Maps.Empty_Map with null record); - end Alire.Containers; diff --git a/src/alire/alire-crates.adb b/src/alire/alire-crates.adb index dae448d5..48b73034 100644 --- a/src/alire/alire-crates.adb +++ b/src/alire/alire-crates.adb @@ -1,5 +1,7 @@ +with Alire.Index; with Alire.Origins; with Alire.Properties.Labeled; +with Alire.Provides; with Alire.TOML_Keys; with Alire.TOML_Load; with Alire.User_Pins.Maps; @@ -28,7 +30,7 @@ package body Alire.Crates is -- Keys -- ---------- - package Keys is new Containers.Release_Sets.Generic_Keys + package Keys is new Alire.Releases.Containers.Release_Sets.Generic_Keys (Semantic_Versioning.Version, Alire.Releases.Version, Semantic_Versioning."<"); @@ -67,7 +69,9 @@ package body Alire.Crates is Version : Semantic_Versioning.Version) return Boolean is begin - return Keys.Contains (This.Releases, Version); + return Keys.Contains + (Alire.Releases.Containers.Release_Sets.Set (This.Releases), + Version); end Contains; --------------- @@ -128,6 +132,19 @@ package body Alire.Crates is Strict)); end loop; end if; + + -- Register any aliased in the detectors for this crate, so we + -- know when to detect. Also the trivial equivalence, for the + -- benefit of queries in the index. + + Index.Register_External_Alias (This.Name, This.Name); + + for Detector of This.Externals.Detectors loop + for Alias of Detector.Equivalences loop + Index.Register_External_Alias (Provider => This.Name, + Providing => Alias); + end loop; + end loop; end if; end Load_Externals_Array; @@ -145,6 +162,7 @@ package body Alire.Crates is declare Unused_Avail : Conditional.Availability; Unused_Deps : Conditional.Dependencies; + Unused_Equiv : Provides.Equivalences; Unused_Pins : User_Pins.Maps.Map; Properties : Conditional.Properties; begin @@ -154,6 +172,7 @@ package body Alire.Crates is From => From, Props => Properties, Deps => Unused_Deps, + Equiv => Unused_Equiv, Pins => Unused_Pins, Avail => Unused_Avail); @@ -260,8 +279,9 @@ package body Alire.Crates is -- Releases -- -------------- - function Releases (This : Crate) return Containers.Release_Set is - (This.Releases); + function Releases (This : Crate) + return Alire.Releases.Containers.Release_Set + is (This.Releases); ------------- -- Replace -- @@ -271,7 +291,9 @@ package body Alire.Crates is Release : Alire.Releases.Release) is begin - Keys.Replace (This.Releases, Release.Version, Release); + Keys.Replace (Alire.Releases.Containers.Release_Sets.Set (This.Releases), + Release.Version, + Release); end Replace; end Alire.Crates; diff --git a/src/alire/alire-crates.ads b/src/alire/alire-crates.ads index cdb019be..0baa755d 100644 --- a/src/alire/alire-crates.ads +++ b/src/alire/alire-crates.ads @@ -1,8 +1,7 @@ with Alire.Conditional; -with Alire.Containers; with Alire.Externals.Lists; with Alire.Policies; -with Alire.Releases; +with Alire.Releases.Containers; with Alire.TOML_Adapters; with Alire.Utils; @@ -84,7 +83,7 @@ package Alire.Crates is -- Merge external definitions from both crates, applying some index merging -- policy. - function Releases (This : Crate) return Containers.Release_Set; + function Releases (This : Crate) return Releases.Containers.Release_Set; procedure Replace (This : in out Crate; Release : Alire.Releases.Release) with Pre => @@ -108,7 +107,7 @@ private type Crate (Len : Natural) is tagged record Name : Crate_Name (Len); Externals : External_Data; - Releases : Containers.Release_Set; + Releases : Alire.Releases.Containers.Release_Set; end record; end Alire.Crates; diff --git a/src/alire/alire-dependencies-containers.adb b/src/alire/alire-dependencies-containers.adb index afb90524..f44700c6 100644 --- a/src/alire/alire-dependencies-containers.adb +++ b/src/alire/alire-dependencies-containers.adb @@ -1,5 +1,37 @@ package body Alire.Dependencies.Containers is + ----------- + -- Merge -- + ----------- + + procedure Merge (This : in out Map; + Dep : Dependencies.Dependency) + is + use type Semantic_Versioning.Extended.Version_Set; + begin + if This.Contains (Dep.Crate) then + declare + Old : constant Dependencies.Dependency := This (Dep.Crate); + begin + if Old /= Dep then + -- Include should work to replace the dependency, but I'm + -- getting a tampering error using it (?) + This.Delete (Dep.Crate); + This.Insert (Dep.Crate, + Dependencies.New_Dependency + (Dep.Crate, + Old.Versions and Dep.Versions)); + end if; + end; + else + This.Insert (Dep.Crate, Dep); + end if; + end Merge; + + ------------ + -- To_Set -- + ------------ + function To_Set (This : List) return Sets.Set is begin return Result : Set do diff --git a/src/alire/alire-dependencies-containers.ads b/src/alire/alire-dependencies-containers.ads index 52b8ce99..2266103b 100644 --- a/src/alire/alire-dependencies-containers.ads +++ b/src/alire/alire-dependencies-containers.ads @@ -1,10 +1,25 @@ with Ada.Containers.Indefinite_Doubly_Linked_Lists; +with Ada.Containers.Indefinite_Ordered_Maps; with Ada.Containers.Indefinite_Ordered_Sets; with Optional.Values; package Alire.Dependencies.Containers with Preelaborate is + package Maps + is new Ada.Containers.Indefinite_Ordered_Maps + (Crate_Name, Dependencies.Dependency, + "<", Dependencies."="); + + type Map is new Maps.Map with null record; + + Empty_Map : constant Map; + + procedure Merge (This : in out Map; + Dep : Dependencies.Dependency); + -- If the dependency is already in map, create a combined dependency that + -- ANDs both. + package Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists (Dependency); @@ -23,4 +38,8 @@ package Alire.Dependencies.Containers with Preelaborate is function To_Set (This : List) return Sets.Set; -- For presentation, we prefer dependencies to be shown in order +private + + Empty_Map : constant Map := (Maps.Empty_Map with null record); + end Alire.Dependencies.Containers; diff --git a/src/alire/alire-dependencies-graphs.adb b/src/alire/alire-dependencies-graphs.adb index 8e1bab3a..35f0a67b 100644 --- a/src/alire/alire-dependencies-graphs.adb +++ b/src/alire/alire-dependencies-graphs.adb @@ -1,4 +1,3 @@ -with Alire.Conditional; with Alire.Directories; with Alire.OS_Lib.Subprocess; with Alire.Paths; @@ -41,8 +40,7 @@ package body Alire.Dependencies.Graphs is is begin return Result : Graph := This do - for Dep of Conditional.Enumerate (R.Dependencies.Evaluate (Env)) - loop + for Dep of R.Flat_Dependencies (Env) loop Result.Include (New_Dependency (R.Name, Dep.Crate)); end loop; end return; @@ -104,9 +102,9 @@ package body Alire.Dependencies.Graphs is if Solution.State (Dependee).Has_Release then if For_Plot then - return Solution.State (Dependee).Release.Milestone.Image; + return Solution.State (Dependee).Milestone_Image (Color => False); else - return Solution.State (Dependee).Release.Milestone.TTY_Image + return Solution.State (Dependee).Milestone_Image & " (" & TTY.Version (Solution.Dependency (Dependent, Dependee).Versions.Image) diff --git a/src/alire/alire-dependencies-states.adb b/src/alire/alire-dependencies-states.adb index b0632867..e7026bf4 100644 --- a/src/alire/alire-dependencies-states.adb +++ b/src/alire/alire-dependencies-states.adb @@ -42,7 +42,8 @@ package body Alire.Dependencies.States is & " at " & TTY.URL (Workspace)); end if; else - return (Containers.Release_Holders.Empty_Holder with null record); + return (Releases.Containers.Release_Holders.Empty_Holder + with null record); end if; end Optional_Release; @@ -56,6 +57,7 @@ package body Alire.Dependencies.States is Pin_Version : constant String := "pin_version"; Pinned : constant String := "pinned"; Release : constant String := "release"; + Shared : constant String := "shared"; Transitivity : constant String := "transitivity"; Versions : constant String := "versions"; @@ -112,6 +114,8 @@ package body Alire.Dependencies.States is "release: " & (+Crate)), Manifest.Index, Strict => False)); -- because it may come from elsewhere + Data.Shared := + From.Checked_Pop (Keys.Shared, TOML_Boolean).As_Boolean; end case; return Data; @@ -176,6 +180,9 @@ package body Alire.Dependencies.States is (Keys.Release, This.Fulfilled.Release.Constant_Reference.To_TOML (Manifest.Index)); + Table.Set + (Keys.Shared, + Create_Boolean (This.Fulfilled.Shared)); end case; end To_TOML; diff --git a/src/alire/alire-dependencies-states.ads b/src/alire/alire-dependencies-states.ads index edf18016..19f9fdee 100644 --- a/src/alire/alire-dependencies-states.ads +++ b/src/alire/alire-dependencies-states.ads @@ -1,7 +1,6 @@ -private with Ada.Containers.Indefinite_Holders; +private with AAA.Containers.Indefinite_Holders; -private with Alire.Containers; -with Alire.Releases; +with Alire.Releases.Containers; with Alire.TOML_Adapters; with Alire.User_Pins; @@ -26,12 +25,6 @@ package Alire.Dependencies.States is type State (<>) is new Dependency with private; - overriding function "=" (L, R : State) return Boolean; - -- For some unclear reason, the default implementation reports differences - -- for identical states. Suspecting the Indefinite_Holders therein to be - -- the culprits. We override to rely on the same information the user sees, - -- thus avoiding any inconsistent "want to confirm?" empty updates. - ------------------ -- Constructors -- ------------------ @@ -65,10 +58,11 @@ package Alire.Dependencies.States is return State; -- Modify transitivity in a copy of Base - function Solving (Base : State; - Using : Releases.Release) + function Solving (Base : State; + Using : Releases.Release; + Shared : Boolean := False) return State - with Pre => Base.Crate = Using.Name; + with Pre => Using.Provides (Base.Crate); -- Uses release to fulfill this dependency in a copy of Base function Unlinking (Base : State) return State; @@ -102,6 +96,11 @@ package Alire.Dependencies.States is function Is_Pinned (This : State) return Boolean; + function Is_Provided (This : State) return Boolean; + -- True when the release name is different from the dependency crate + + function Is_Shared (This : State) return Boolean; + function Is_User_Pinned (This : State) return Boolean; -- From the POV of users, pinning to version or linking to dir is a pin @@ -129,6 +128,13 @@ package Alire.Dependencies.States is overriding function Image (This : State) return String; + function Milestone_Image (This : State; + Color : Boolean := True) + return String + with Pre => This.Has_Release; + -- Will use the dep name if it differs from the dependency (due to + -- equivalences). + overriding function TTY_Image (This : State) return String; ------------------- @@ -143,7 +149,7 @@ private use type Semantic_Versioning.Extended.Version_Set; - type Stored_Release is new Containers.Release_H with null record; + type Stored_Release is new Releases.Containers.Release_H with null record; -- New type to simplify comparison of optional stored releases overriding function "=" (L, R : Stored_Release) return Boolean; @@ -177,6 +183,14 @@ private Version : Semantic_Versioning.Version) return State; + overriding + function New_Dependency (Milestone : Milestones.Milestone; + Updatable : Boolean := False) + return State; + -- Create a dependency from a milestone. If Updatable, use the appropriate + -- caret/tilde versions set modifier; otherwise depend on the exact + -- milestone. + -- Helper types overriding @@ -186,7 +200,7 @@ private return State; package Link_Holders is - new Ada.Containers.Indefinite_Holders (Softlink, User_Pins."="); + new AAA.Containers.Indefinite_Holders (Softlink); type Link_Holder is new Link_Holders.Holder with null record; @@ -199,6 +213,7 @@ private Opt_Rel : Stored_Release; -- This might not be filled-in when Solved => Release : Stored_Release; -- This is always valid + Shared : Boolean; -- The release is from shared install when others => null; end case; end record; @@ -220,15 +235,6 @@ private Transitivity : Transitivities := Unknown; end record; - --------- - -- "=" -- - --------- - - overriding function "=" (L, R : State) return Boolean - is (L.Image = R.Image); - -- TODO: this is likely not efficient. We should dig more to find why some - -- apparently identical states are reported as different. - ------------------- -- As_Dependency -- ------------------- @@ -293,6 +299,9 @@ private else "") & (if This.Has_Release then ",release" + else "") + & (if This.Is_Shared + then ",installed" else "") else "") & (if This.Pinning.Pinned @@ -322,6 +331,12 @@ private function Is_Pinned (This : State) return Boolean is (This.Pinning.Pinned); + function Is_Provided (This : State) return Boolean + is (This.Has_Release and then This.Release.Name /= This.Crate); + + function Is_Shared (This : State) return Boolean + is (This.Fulfilled.Fulfillment = Solved and then This.Fulfilled.Shared); + function Is_Solved (This : State) return Boolean is (This.Fulfilled.Fulfillment = Solved); @@ -365,6 +380,27 @@ private Pinning => Base.Pinning, Transitivity => Base.Transitivity); + --------------------- + -- Milestone_Image -- + --------------------- + + function Milestone_Image (This : State; + Color : Boolean := True) + return String + is (if Color then + TTY.Name (This.Crate) + & "=" + & TTY.Version (This.Release.Version.Image) + & (if This.Crate /= This.Release.Name + then " (" & TTY.Italic (This.Release.Name.As_String) & ")" + else "") + else + (+This.Crate) & "=" & This.Release.Version.Image + & (if This.Crate /= This.Release.Name + then " (" & This.Release.Name.As_String & ")" + else "") + ); + ------------- -- Missing -- ------------- @@ -397,6 +433,23 @@ private return State is (New_State (Dependencies.New_Dependency (Crate, Versions))); + -------------------- + -- New_Dependency -- + -------------------- + + overriding + function New_Dependency (Milestone : Milestones.Milestone; + Updatable : Boolean := False) + return State + is (New_State + (if Updatable then + Dependencies.New_Dependency + (Milestone.Crate, + Semantic_Versioning.Updatable (Milestone.Version)) + else + Dependencies.New_Dependency + (Milestone.Crate, Milestone.Version))); + --------------- -- New_State -- --------------- @@ -456,13 +509,15 @@ private -- Solving -- ------------- - function Solving (Base : State; - Using : Releases.Release) + function Solving (Base : State; + Using : Releases.Release; + Shared : Boolean := False) return State is (Base.As_Dependency with Name_Len => Base.Name_Len, Fulfilled => (Fulfillment => Solved, - Release => To_Holder (Using)), + Release => To_Holder (Using), + Shared => Shared), Pinning => Base.Pinning, Transitivity => Base.Transitivity); @@ -497,6 +552,9 @@ private & (if This.Has_Release then "," & TTY.OK ("release") else "") + & (if This.Is_Shared + then "," & TTY.Emph ("installed") + else "") else "") & (if This.Pinning.Pinned then "," & TTY.Emph ("pin") diff --git a/src/alire/alire-dependencies.ads b/src/alire/alire-dependencies.ads index ec27e574..824ca029 100644 --- a/src/alire/alire-dependencies.ads +++ b/src/alire/alire-dependencies.ads @@ -1,4 +1,5 @@ with Alire.Interfaces; +with Alire.Milestones; with Alire.Utils; with Semantic_Versioning.Basic; @@ -29,6 +30,12 @@ package Alire.Dependencies with Preelaborate is Version : Semantic_Versioning.Version) return Dependency; + function New_Dependency (Milestone : Milestones.Milestone; + Updatable : Boolean := False) + return Dependency; + -- Return either an exact crate=version or a safely upgradable crate^1.x + -- dependency for the given milestone. + function From_String (Spec : String) return Dependency; -- Intended to parse command-line dependencies given as crate[subset]: -- alr^1.0, alr=1.0, alr~0.7, etc. If no subset is specified, Any version @@ -98,7 +105,17 @@ private is (New_Dependency (Crate, Semantic_Versioning.Extended.To_Extended - (Semantic_Versioning.Basic.Exactly (Version)))); + (Semantic_Versioning.Basic.Exactly (Version)))); + + function New_Dependency (Milestone : Milestones.Milestone; + Updatable : Boolean := False) + return Dependency + is (if Updatable + then + New_Dependency (Milestone.Crate, + Semantic_Versioning.Updatable (Milestone.Version)) + else + New_Dependency (Milestone.Crate, Milestone.Version)); function Crate (Dep : Dependency) return Crate_Name is (Dep.Crate); diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index 9cc4d3cf..472791e9 100644 --- a/src/alire/alire-directories.adb +++ b/src/alire/alire-directories.adb @@ -1,13 +1,14 @@ +with AAA.Directories; + with Ada.Exceptions; with Ada.Numerics.Discrete_Random; -with Ada.Text_IO; with Ada.Unchecked_Deallocation; +with Alire.Errors; with Alire.OS_Lib.Subprocess; with Alire.Paths; with Alire.Platform; -with Alire.Properties; -with Alire.Roots; +with Alire.TTY; with GNATCOLL.VFS; @@ -15,46 +16,6 @@ package body Alire.Directories is package Adirs renames Ada.Directories; - ------------------------ - -- Report_Deprecation -- - ------------------------ - - procedure Report_Deprecation with No_Return; - -- We give some minimal guidelines about what to do with the metadata - -- changes, and redirect to a wiki page for more details. - - procedure Report_Deprecation is - Old_Manifest : constant String := - Directories.Find_Single_File ("alire", "toml"); - use Ada.Text_IO; -- To bypass any -q or verbosity configuration - begin - New_Line; - Put_Line ("WARNING: Deprecated metadata possibly detected at " - & Old_Manifest); - New_Line; - Put_Line ("Due to recent changes to Alire's way of storing metadata,"); - Put_Line ("you need to reinitialize or migrate the workspace."); - Put_Line - ("Please check here for details on how to migrate your metadata:"); - New_Line; - Put_Line (" https://github.com/alire-project/alire/wiki/" - & "2020-Metadata-format-migration"); - Put_Line (""); - Put_Line ("How to reinitialize, in a nutshell:"); - New_Line; - Put_Line (" - Delete the old manifest file at 'alire/*.toml'"); - Put_Line (" - run one of"); - Put_Line (" $ alr init --in-place --bin "); - Put_Line (" $ alr init --in-place --lib "); - Put_Line (" - Re-add any necessary dependencies using one or more "); - Put_Line (" $ alr with "); - New_Line; - - -- This happens too early during elaboration and otherwise a stack trace - -- is produced, so: - GNAT.OS_Lib.OS_Exit (1); - end Report_Deprecation; - ------------------------ -- Backup_If_Existing -- ------------------------ @@ -117,6 +78,16 @@ package body Alire.Directories is End_Search (Search); end Copy; + ----------------- + -- Create_Tree -- + ----------------- + + procedure Create_Tree (Path : Any_Path) is + use GNATCOLL.VFS; + begin + Make_Dir (Create (+Path)); + end Create_Tree; + ----------------- -- Delete_Tree -- ----------------- @@ -143,24 +114,13 @@ package body Alire.Directories is function Find_Candidate_Folder (Path : Any_Path) return Any_Path is - Possible_Root : constant Roots.Root := Roots.New_Root - (Name => +"unused", - Path => Path, - Env => Properties.No_Properties); begin Trace.Debug ("Looking for alire metadata at: " & Path); if - Exists (Possible_Root.Crate_File) and then - Kind (Possible_Root.Crate_File) = Ordinary_File + Exists (Path / Paths.Crate_File_Name) and then + Kind (Path / Paths.Crate_File_Name) = Ordinary_File then return Path; - elsif GNAT.OS_Lib.Is_Directory ("alire") and then - Directories.Find_Single_File ("alire", "toml") /= "" and then - not Utils.Ends_With (Directories.Find_Single_File ("alire", "toml"), - "config.toml") and then - not GNAT.OS_Lib.Is_Regular_File ("alire" / "alr_env.gpr") - then - Report_Deprecation; else return Find_Candidate_Folder (Containing_Directory (Path)); end if; @@ -203,6 +163,8 @@ package body Alire.Directories is procedure Force_Delete (Path : Any_Path) is use Ada.Directories; + use GNATCOLL.VFS; + Success : Boolean := False; begin if Exists (Path) then if Kind (Path) = Ordinary_File then @@ -210,8 +172,18 @@ package body Alire.Directories is Delete_File (Path); elsif Kind (Path) = Directory then Trace.Debug ("Deleting temporary folder " & Path & "..."); + Ensure_Deletable (Path); - Delete_Tree (Path); + + -- Ada.Directories fails when there are softlinks in a tree, so we + -- use GNATCOLL instead. + GNATCOLL.VFS.Remove_Dir (Create (+Path), + Recursive => True, + Success => Success); + if not Success then + raise Program_Error with + Errors.Set ("Could not delete: " & TTY.URL (Path)); + end if; end if; end if; end Force_Delete; @@ -473,6 +445,16 @@ package body Alire.Directories is Delete_Tree (This.Filename); end if; end if; + + -- Remove temp dir if empty to keep things tidy, and avoid modifying + -- lots of tests. + + if Ada.Directories.Simple_Name (Parent (This.Filename)) = + Paths.Temp_Folder_Inside_Working_Folder + then + AAA.Directories.Remove_Folder_If_Empty (Parent (This.Filename)); + end if; + exception when E : others => Log_Exception (E); @@ -515,6 +497,36 @@ package body Alire.Directories is Go_Down'Access); end Traverse_Tree; + --------------- + -- Tree_Size -- + --------------- + + function Tree_Size (Path : Any_Path) return Ada.Directories.File_Size is + + use Ada.Directories; + Result : File_Size := 0; + + ---------------- + -- Accumulate -- + ---------------- + + procedure Accumulate (Item : Directory_Entry_Type; + Stop : in out Boolean) + is + begin + Stop := False; + if Kind (Item) = Ordinary_File then + Result := Result + Size (Item); + end if; + end Accumulate; + + begin + Traverse_Tree (Path, + Doing => Accumulate'Access, + Recurse => True); + return Result; + end Tree_Size; + --------------- -- With_Name -- --------------- diff --git a/src/alire/alire-directories.ads b/src/alire/alire-directories.ads index 8e561607..38f04c01 100644 --- a/src/alire/alire-directories.ads +++ b/src/alire/alire-directories.ads @@ -1,17 +1,17 @@ with Ada.Directories; +with Alire.OS_Lib; with Alire.Utils; private with Ada.Finalization; package Alire.Directories is - function "/" (L, R : String) return String - is (Ada.Directories.Compose (L, R)); + function "/" (L, R : String) return String renames OS_Lib."/"; -- Package to enable easy use of "/" package Operators is - function "/" (L, R : String) return String renames Directories."/"; + function "/" (L, R : String) return String renames OS_Lib."/"; end Operators; procedure Backup_If_Existing (File : Any_Path; @@ -28,10 +28,16 @@ package Alire.Directories is function Current return String renames Ada.Directories.Current_Directory; + function Parent (Path : Any_Path) return String + renames Ada.Directories.Containing_Directory; + function Detect_Root_Path (Starting_At : Absolute_Path := Current) return String; -- Return either the valid enclosing root folder, or "" + procedure Create_Tree (Path : Any_Path); + -- Create Path and all necessary intermediate folders + procedure Delete_Tree (Path : Any_Path); -- Equivalent to Ensure_Deletable + Ada.Directories.Delete_Tree @@ -75,6 +81,9 @@ package Alire.Directories is -- the directory entry is passed before entering it "." and ".." are -- ignored. If Stop is set to True, traversal will not continue. + function Tree_Size (Path : Any_Path) return Ada.Directories.File_Size; + -- Size of files under a given point, in bytes. + ---------------- -- GUARD TYPE -- ---------------- diff --git a/src/alire/alire-environment.adb b/src/alire/alire-environment.adb index 4f43f170..a800b10c 100644 --- a/src/alire/alire-environment.adb +++ b/src/alire/alire-environment.adb @@ -10,8 +10,9 @@ with Alire.OS_Lib; with Alire.GPR; with Alire.Properties.Scenarios; with Alire.Releases; -with Alire.Roots; +with Alire.Roots.Editable; with Alire.Solutions; +with Alire.Toolchains.Solutions; with Alire.Utils; with Alire.Utils.TTY; with Alire.Platform; @@ -88,8 +89,14 @@ package body Alire.Environment is procedure Load (This : in out Context; Root : in out Alire.Roots.Root) is - Solution : constant Solutions.Solution := Root.Solution; + Solution : constant Solutions.Solution := + Toolchains.Solutions.Add_Toolchain (Root.Solution); + Tool_Root : Roots.Editable.Root := + Roots.Editable.New_Root (Root); + -- We use a copy of the base root to add the toolchain elements that + -- might be missing from its solution begin + Tool_Root.Set (Solution); -- Load platform environment Alire.Platform.Load_Environment (This); @@ -120,7 +127,8 @@ package body Alire.Environment is -- supplied project files. declare - Sorted_Paths : constant Alire.Utils.String_Set := Root.Project_Paths; + Sorted_Paths : constant Alire.Utils.String_Set := + Tool_Root.Current.Project_Paths; begin if not Sorted_Paths.Is_Empty then for Path of Sorted_Paths loop @@ -132,7 +140,7 @@ package body Alire.Environment is -- Custom definitions provided by each release for Rel of Solution.Releases.Including (Root.Release) loop - This.Load (Root => Root, + This.Load (Root => Tool_Root, Crate => Rel.Name); end loop; @@ -144,20 +152,22 @@ package body Alire.Environment is ---------- procedure Load (This : in out Context; - Root : in out Roots.Root; + Root : in out Roots.Editable.Root; Crate : Crate_Name) is - Rel : constant Releases.Release := Root.Release (Crate); + Env : constant Properties.Vector := Root.Current.Environment; + Rel : constant Releases.Release := Root.Current.Release (Crate); Origin : constant String := Rel.Name_Str; begin Trace.Debug ("Loading environment for release: " & TTY.Name (Crate)); -- Environment variables defined in the crate manifest - for Act of Rel.Environment (Root.Environment) loop + for Act of Rel.Environment (Env) loop begin declare Value : constant String := - Formatting.Format (Root.Release_Base (Rel.Name), Act.Value); + Formatting.Format (Root.Current.Release_Base (Rel.Name), + Act.Value); begin case Act.Action is @@ -184,7 +194,7 @@ package body Alire.Environment is end loop; -- Environment variables for GPR external scenario variables - for Property of Rel.On_Platform_Properties (Root.Environment) loop + for Property of Rel.On_Platform_Properties (Env) loop if Property in Alire.Properties.Scenarios.Property'Class then declare use all type Alire.GPR.Variable_Kinds; diff --git a/src/alire/alire-environment.ads b/src/alire/alire-environment.ads index 1b0ce32c..0049ddab 100644 --- a/src/alire/alire-environment.ads +++ b/src/alire/alire-environment.ads @@ -2,7 +2,7 @@ with Ada.Strings.Unbounded; with Alire.Properties; with Alire.Platforms; -limited with Alire.Roots; +limited with Alire.Roots.Editable; private with Ada.Strings.Unbounded.Hash; private with Ada.Containers.Vectors; @@ -92,7 +92,7 @@ private procedure Add (This : in out Context; Name : String; Action : Env_Action); procedure Load (This : in out Context; - Root : in out Roots.Root; + Root : in out Roots.Editable.Root; Crate : Crate_Name); -- Load the environment variables of a release (GPR_PROJECT_PATH and custom -- variables) in the context. diff --git a/src/alire/alire-expressions-maps.adb b/src/alire/alire-expressions-maps.adb index 6612f486..3069c2e2 100644 --- a/src/alire/alire-expressions-maps.adb +++ b/src/alire/alire-expressions-maps.adb @@ -75,4 +75,20 @@ package body Alire.Expressions.Maps is end return; end Size; + --------------- + -- Visit_All -- + --------------- + + procedure Visit_All (M : in out Map; + Apply : access procedure (E : in out Elements)) is + begin + for Elem of M.Entries loop + Apply (Elem); + end loop; + + for Elem of M.Other loop + Apply (Elem); + end loop; + end Visit_All; + end Alire.Expressions.Maps; diff --git a/src/alire/alire-expressions-maps.ads b/src/alire/alire-expressions-maps.ads index 152d9cae..e250db1b 100644 --- a/src/alire/alire-expressions-maps.ads +++ b/src/alire/alire-expressions-maps.ads @@ -56,6 +56,10 @@ package Alire.Expressions.Maps with Preelaborate is Post => M.Other = E; -- Set the default mapping for this map + procedure Visit_All (M : in out Map; + Apply : access procedure (E : in out Elements)); + -- Visits all elements in the map, including the others value + private package Maps is diff --git a/src/alire/alire-externals-from_output.adb b/src/alire/alire-externals-from_output.adb index 6840130d..bcf2bd38 100644 --- a/src/alire/alire-externals-from_output.adb +++ b/src/alire/alire-externals-from_output.adb @@ -16,7 +16,7 @@ package body Alire.Externals.From_Output is overriding function Detect (This : External; - Name : Crate_Name) return Containers.Release_Set + Name : Crate_Name) return Releases.Containers.Release_Set is Location : GNAT.OS_Lib.String_Access := GNAT.OS_Lib.Locate_Exec_On_Path @@ -26,7 +26,7 @@ package body Alire.Externals.From_Output is Trace.Debug ("External not detected because executable is not in PATH: " & This.Command.First_Element); - return Containers.Release_Sets.Empty_Set; + return (Releases.Containers.Release_Sets.Empty_Set with null record); else GNAT.OS_Lib.Free (Location); end if; @@ -40,7 +40,7 @@ package body Alire.Externals.From_Output is This.Command.Tail).Flatten ("" & ASCII.LF); -- ASCII.LF is used by Regpat for new lines begin - return Releases : Containers.Release_Set do + return Releases : Alire.Releases.Containers.Release_Set do Trace.Debug ("Looking for external in version string: " & Output); Match (This.Regexp, Output, Matches); @@ -59,6 +59,7 @@ package body Alire.Externals.From_Output is Releases.Insert (Index.Crate (Name).Base .Retagging (Semantic_Versioning.Parse (Version)) + .Providing (This.Provides) .Replacing (Origins.New_External ("path " & Path)) .Replacing (Notes => "Detected at " -- length is 12 & Utils.Shorten diff --git a/src/alire/alire-externals-from_output.ads b/src/alire/alire-externals-from_output.ads index e182ba98..3a0ffaa0 100644 --- a/src/alire/alire-externals-from_output.ads +++ b/src/alire/alire-externals-from_output.ads @@ -10,7 +10,8 @@ package Alire.Externals.From_Output is overriding function Detect (This : External; - Name : Crate_Name) return Containers.Release_Set; + Name : Crate_Name) + return Releases.Containers.Release_Set; overriding function Image (This : External) return String; diff --git a/src/alire/alire-externals-from_system.adb b/src/alire/alire-externals-from_system.adb index 03925dde..4fe9f880 100644 --- a/src/alire/alire-externals-from_system.adb +++ b/src/alire/alire-externals-from_system.adb @@ -15,7 +15,7 @@ package body Alire.Externals.From_System is overriding function Detect (This : External; - Name : Crate_Name) return Containers.Release_Set + Name : Crate_Name) return Releases.Containers.Release_Set is package System renames Origins.Deployers.System; begin @@ -23,13 +23,13 @@ package body Alire.Externals.From_System is if not Platform.Distribution_Is_Known then Trace.Detail ("Cannot look for system packages for crate " & (+Name) & "in unknown distribution"); - return Containers.Release_Sets.Empty_Set; + return (Releases.Containers.Release_Sets.Empty_Set with null record); end if; Trace.Debug ("Looking for system packages that provide crate: " & (+Name)); - return Releases : Containers.Release_Set do + return Releases : Alire.Releases.Containers.Release_Set do declare Origin : constant Conditional_Packages.Tree := This.Origin.Evaluate (Root.Platform_Properties); @@ -52,6 +52,7 @@ package body Alire.Externals.From_System is Releases.Insert (Index.Crate (Name).Base .Retagging (Result.Value) + .Providing (This.Provides) .Replacing (Origins.New_System (Candidate)) .Replacing (Notes => "Provided by system package: " & Candidate)); diff --git a/src/alire/alire-externals-from_system.ads b/src/alire/alire-externals-from_system.ads index 273e4e93..fcaf75ac 100644 --- a/src/alire/alire-externals-from_system.ads +++ b/src/alire/alire-externals-from_system.ads @@ -15,7 +15,7 @@ package Alire.Externals.From_System is overriding function Detect (This : External; - Name : Crate_Name) return Containers.Release_Set; + Name : Crate_Name) return Releases.Containers.Release_Set; overriding function Image (This : External) return String; diff --git a/src/alire/alire-externals-lists.adb b/src/alire/alire-externals-lists.adb index fae8ae8f..189e7079 100644 --- a/src/alire/alire-externals-lists.adb +++ b/src/alire/alire-externals-lists.adb @@ -12,21 +12,21 @@ package body Alire.Externals.Lists is function Detect (This : List; Name : Crate_Name; Env : Properties.Vector) - return Containers.Release_Set + return Releases.Containers.Release_Set is begin -- Avoid the log message if there's nothing to detect if This.Is_Empty then - return Containers.Release_Sets.Empty_Set; + return (Releases.Containers.Release_Sets.Empty_Set with null record); end if; declare Busy : Simple_Logging.Ongoing := Simple_Logging.Activity ("Looking for external crate: " & (+Name)); begin - return Detected : Containers.Release_Set do + return Detected : Releases.Containers.Release_Set do for External of This loop if External.Available.Is_Available (Env) then Trace.Debug ("Attempting detection of available external: " diff --git a/src/alire/alire-externals-lists.ads b/src/alire/alire-externals-lists.ads index 331bc740..53e362ed 100644 --- a/src/alire/alire-externals-lists.ads +++ b/src/alire/alire-externals-lists.ads @@ -13,7 +13,8 @@ package Alire.Externals.Lists is function Detect (This : List; Name : Crate_Name; - Env : Properties.Vector) return Containers.Release_Set; + Env : Properties.Vector) + return Releases.Containers.Release_Set; -- Goes over the externals defined in List and, when Available, performs -- their Detect call. diff --git a/src/alire/alire-externals-unindexed.ads b/src/alire/alire-externals-unindexed.ads index b813dabb..d5f48d81 100644 --- a/src/alire/alire-externals-unindexed.ads +++ b/src/alire/alire-externals-unindexed.ads @@ -7,8 +7,9 @@ package Alire.Externals.Unindexed is overriding function Detect (This : External; - Unused_Name : Crate_Name) return Containers.Release_Set is - (Containers.Release_Sets.Empty_Set); + Unused_Name : Crate_Name) + return Releases.Containers.Release_Set is + (Releases.Containers.Release_Sets.Empty_Set with null record); overriding function Image (This : External) return String is ("Externally provided"); diff --git a/src/alire/alire-externals.adb b/src/alire/alire-externals.adb index efcac40e..1a811bee 100644 --- a/src/alire/alire-externals.adb +++ b/src/alire/alire-externals.adb @@ -4,6 +4,7 @@ with Alire.Crates; with Alire.Externals.From_Output; with Alire.Externals.From_System; with Alire.Externals.Unindexed; +with Alire.Provides; with Alire.TOML_Keys; with Alire.TOML_Load; with Alire.User_Pins.Maps; @@ -38,6 +39,20 @@ package body Alire.Externals is when System => From_System.From_TOML (From), when Version_Output => From_Output.From_TOML (From)); + ------------------- + -- Load_Provides -- + ------------------- + -- Pops and loads the provides = "crate" special external case + procedure Load_Provides (This : in out External'Class; + From : TOML_Adapters.Key_Queue) + is + use TOML; + begin + This.Provides.Insert + (To_Name + (From.Checked_Pop (TOML_Keys.Provides, TOML_String).As_String)); + end Load_Provides; + Kind : TOML.TOML_Value; OK : constant Boolean := From.Pop (TOML_Keys.External_Kind, Kind); @@ -60,8 +75,10 @@ package body Alire.Externals is end if; end Validate; - Unused_Deps : Conditional.Dependencies; - Unused_Pins : User_Pins.Maps.Map; + -- These cannot appear in externals: + Unused_Deps : Conditional.Dependencies; + Unused_Equiv : Provides.Equivalences; + Unused_Pins : User_Pins.Maps.Map; begin @@ -75,6 +92,15 @@ package body Alire.Externals is From_TOML (Kinds'Value (TOML_Adapters.Adafy (Kind.As_String))) do + -- Deal with the special provides of an external, which cannot have + -- a version as it is yet unknown. + + if Ext not in Unindexed.External'Class and then + From.Contains (TOML_Keys.Provides) + then + Load_Provides (Ext, From); + end if; + -- Load common external fields TOML_Load.Load_Crate_Section @@ -83,6 +109,7 @@ package body Alire.Externals is From => From, Props => Ext.Properties, Deps => Unused_Deps, + Equiv => Unused_Equiv, Pins => Unused_Pins, Avail => Ext.Available); diff --git a/src/alire/alire-externals.ads b/src/alire/alire-externals.ads index 6993480a..8787658b 100644 --- a/src/alire/alire-externals.ads +++ b/src/alire/alire-externals.ads @@ -2,6 +2,7 @@ with Alire.Conditional; with Alire.Containers; with Alire.Platforms; with Alire.Properties; +with Alire.Releases.Containers; with Alire.TOML_Adapters; with Alire.Utils; @@ -14,7 +15,7 @@ package Alire.Externals is type External is abstract tagged private; function Detect (This : External; - Name : Crate_Name) return Containers.Release_Set + Name : Crate_Name) return Releases.Containers.Release_Set is abstract; -- Perform detection and return all matching releases. Empty set must be -- returned if nothing can be detected. Checked_Error must be raised if @@ -62,11 +63,26 @@ package Alire.Externals is Env : Properties.Vector) return External'Class; -- Evaluate Properties and Available fields under the given environment + function Equivalences (This : External'Class) + return Containers.Crate_Name_Sets.Set; + -- An external may have a "provides" for another crate, always matching + -- the same version. Used ATM for GNAT compilers, including system ones, + -- to provide the "gnat" crate. + private type External is abstract tagged record Properties : Conditional.Properties; + Provides : Containers.Crate_Name_Sets.Set; Available : Conditional.Availability; end record; + ------------------ + -- Equivalences -- + ------------------ + + function Equivalences (This : External'Class) + return Containers.Crate_Name_Sets.Set + is (This.Provides); + end Alire.Externals; diff --git a/src/alire/alire-hashes-sha256_impl.ads b/src/alire/alire-hashes-sha256_impl.ads new file mode 100644 index 00000000..1dbfa33a --- /dev/null +++ b/src/alire/alire-hashes-sha256_impl.ads @@ -0,0 +1,9 @@ +with Alire.Hashes.Common; + +with GNAT.SHA256; + +package Alire.Hashes.SHA256_Impl is new Alire.Hashes.Common + (Kind => SHA256, + Context => GNAT.SHA256.Context, + Update => GNAT.SHA256.Update, + Digest => GNAT.SHA256.Digest); diff --git a/src/alire/alire-hashes.ads b/src/alire/alire-hashes.ads index f0c10297..7f5ff84e 100644 --- a/src/alire/alire-hashes.ads +++ b/src/alire/alire-hashes.ads @@ -7,10 +7,10 @@ package Alire.Hashes with Preelaborate is -- type and value is the actual hash representation emitted by the GNAT.* -- hashing functions. E.g.: "sha1:5c16c1c74ae8236770644b69f2e4cf1ccc88adad" - type Kinds is (SHA512); - -- Recognized hashes that we are able to compute/verify. - -- To add a new kind, instance the Alire.Hashes.Common generic and with it - -- in Alire.TOML_Index body. + type Kinds is (SHA256, SHA512); + -- Recognized hashes that we are able to compute/verify. To add a new kind, + -- instance the Alire.Hashes.Common generic and with it in Alire.TOML_Index + -- body. Default : constant Kinds := SHA512; -- In the event we introduce several hashes, this default is considered the diff --git a/src/alire/alire-index.adb b/src/alire/alire-index.adb index a6840b9b..d933a2b1 100644 --- a/src/alire/alire-index.adb +++ b/src/alire/alire-index.adb @@ -1,10 +1,38 @@ +with Ada.Containers.Indefinite_Ordered_Maps; with Ada.Containers.Indefinite_Ordered_Sets; +with Alire.Containers; +with Alire.TTY; + package body Alire.Index is + package Release_Set_Maps is new + Ada.Containers.Indefinite_Ordered_Maps + (Crate_Name, Releases.Containers.Release_Set, + "<", Releases.Containers."="); + subtype Release_Alias_Map is Release_Set_Maps.Map; + + package External_Alias_Maps is new + Ada.Containers.Indefinite_Ordered_Maps (Crate_Name, + Containers.Crate_Name_Sets.Set, + "<", + Containers.Crate_Name_Sets."="); + subtype External_Alias_Map is External_Alias_Maps.Map; + use all type Semantic_Versioning.Version; Contents : aliased Alire.Crates.Containers.Maps.Map; + -- Regular mapping from crate name to its releases + + Aliases : Release_Alias_Map; + -- Mapping from crate name to any release that satisfies it. Currently, + -- releases are duplicated in memory. These two collections could be made + -- to share releases via some indirection or pointers. + + External_Aliases : External_Alias_Map; + -- For external crates that provide another crate, we need to be aware + -- when external detection is requested. This mapping goes in the direction + -- Provided -> Providers. --------- -- Add -- @@ -48,10 +76,32 @@ package body Alire.Index is Policy : Policies.For_Index_Merging := Policies.Merge_Priorizing_Existing) is + + ----------------- + -- Add_Aliases -- + ----------------- + + procedure Add_Aliases is + begin + for Mil of Release.Provides loop + declare + Crate : Releases.Containers.Release_Set := + (if Aliases.Contains (Mil.Crate) + then Aliases (Mil.Crate) + else Releases.Containers.Empty_Release_Set); + begin + Crate.Include (Release); + Aliases.Include (Mil.Crate, Crate); + end; + end loop; + end Add_Aliases; + Crate : Crates.Crate := Crates.New_Crate (Release.Name); begin Crate.Add (Release); Add (Crate, Policy); + + Add_Aliases; end Add; -------------------------- @@ -80,14 +130,20 @@ package body Alire.Index is if Already_Detected.Contains (Name) then Trace.Debug ("Not redoing detection of externals for crate " & (+Name)); - elsif not Exists (Name) then - Trace.Debug ("Skipping external detection for unindexed crate"); + elsif not External_Aliases.Contains (Name) then + Trace.Debug ("Skipping detection for crate without externals: " + & TTY.Name (Name)); else Already_Detected.Insert (Name); Trace.Debug ("Looking for externals for crate: " & (+Name)); - for Release of Contents (Name).Externals.Detect (Name, Env) loop - Trace.Debug ("Adding external: " & Release.Milestone.Image); - Contents (Name).Add (Release); + + for Provider of External_Aliases (Name) loop + Trace.Debug ("Detecting via provider " & TTY.Name (Provider)); + for Release of Contents (Provider).Externals.Detect (Provider, Env) + loop + Trace.Debug ("Adding external: " & Release.Milestone.Image); + Add (Release); + end loop; end loop; end if; end Detect_Externals; @@ -157,6 +213,30 @@ package body Alire.Index is & (+Name) & "=" & Semantic_Versioning.Image (Version); end Find; + ------------------- + -- Has_Externals -- + ------------------- + + function Has_Externals (Name : Crate_Name) return Boolean + is (External_Aliases.Contains (Name)); + + ----------------------------- + -- Register_External_Alias -- + ----------------------------- + + procedure Register_External_Alias (Provider : Crate_Name; + Providing : Crate_Name) + is + begin + if External_Aliases.Contains (Providing) then + External_Aliases (Providing).Include (Provider); + else + External_Aliases.Insert + (Providing, + Containers.Crate_Name_Sets.To_Set (Provider)); + end if; + end Register_External_Alias; + ------------------- -- Release_Count -- ------------------- @@ -170,4 +250,44 @@ package body Alire.Index is end return; end Release_Count; + ------------------------- + -- Releases_Satisfying -- + ------------------------- + + function Releases_Satisfying (Dep : Dependencies.Dependency; + Env : Properties.Vector; + Use_Equivalences : Boolean := True; + Available : Boolean := True) + return Releases.Containers.Release_Set + is + Result : Releases.Containers.Release_Set; + begin + + -- Regular crates + + if Exists (Dep.Crate) then + for Release of Crate (Dep.Crate).Releases loop + if Release.Satisfies (Dep) + and then (not Available or else Release.Is_Available (Env)) + then + Result.Insert (Release); + end if; + end loop; + end if; + + -- And any aliases via Provides + + if Use_Equivalences and then Aliases.Contains (Dep.Crate) then + for Release of Aliases (Dep.Crate) loop + if Release.Satisfies (Dep) + and then (not Available or else Release.Is_Available (Env)) + then + Result.Include (Release); + end if; + end loop; + end if; + + return Result; + end Releases_Satisfying; + end Alire.Index; diff --git a/src/alire/alire-index.ads b/src/alire/alire-index.ads index f680b83b..2165515c 100644 --- a/src/alire/alire-index.ads +++ b/src/alire/alire-index.ads @@ -2,9 +2,10 @@ private with Alire_Early_Elaboration; pragma Unreferenced (Alire_Early_Elaboration); with Alire.Crates.Containers; +with Alire.Dependencies; with Alire.Policies; with Alire.Properties; -with Alire.Releases; +with Alire.Releases.Containers; with Alire.Utils; with Semantic_Versioning; @@ -38,7 +39,7 @@ package Alire.Index is and then Branch_String (Branch_String'Last) /= '-' and then (for some C of Branch_String => C = '-'); - Community_Branch : constant String := "stable-1.0"; + Community_Branch : constant String := "devel-1.1"; -- The branch used for the community index Version : constant Semantic_Versioning.Version := @@ -69,6 +70,10 @@ package Alire.Index is -- Add only the externals of this crate. This has effect only the first -- time it is called for a crate. + procedure Register_External_Alias (Provider : Crate_Name; + Providing : Crate_Name); + -- Register that Provider has external detectors for Providing + --------------------- -- BASIC QUERIES -- --------------------- @@ -84,6 +89,17 @@ package Alire.Index is Version : Semantic_Versioning.Version) return Boolean; + function Has_Externals (Name : Crate_Name) return Boolean; + + function Releases_Satisfying (Dep : Dependencies.Dependency; + Env : Properties.Vector; + Use_Equivalences : Boolean := True; + Available : Boolean := True) + return Releases.Containers.Release_Set; + -- Return all releases in the catalog able to provide this dependency, + -- also optionally considering their "provides" equivalences, and also + -- optionally including unavailable on the platform. + function Find (Name : Crate_Name; Version : Semantic_Versioning.Version) return Release with Pre => diff --git a/src/alire/alire-milestones-containers.ads b/src/alire/alire-milestones-containers.ads new file mode 100644 index 00000000..1e1c95e4 --- /dev/null +++ b/src/alire/alire-milestones-containers.ads @@ -0,0 +1,12 @@ +with Ada.Containers.Indefinite_Doubly_Linked_Lists; +with Ada.Containers.Indefinite_Ordered_Sets; + +package Alire.Milestones.Containers with Preelaborate is + + package Lists is new + Ada.Containers.Indefinite_Doubly_Linked_Lists (Milestones.Milestone); + + package Sets is new + Ada.Containers.Indefinite_Ordered_Sets (Milestones.Milestone); + +end Alire.Milestones.Containers; diff --git a/src/alire/alire-milestones-holders.ads b/src/alire/alire-milestones-holders.ads deleted file mode 100644 index 331f11b3..00000000 --- a/src/alire/alire-milestones-holders.ads +++ /dev/null @@ -1,4 +0,0 @@ -with Ada.Containers.Indefinite_Holders; - -package Alire.Milestones.Holders is - new Ada.Containers.Indefinite_Holders (Milestone); diff --git a/src/alire/alire-milestones.ads b/src/alire/alire-milestones.ads index 4d03a3c3..aae4cfca 100644 --- a/src/alire/alire-milestones.ads +++ b/src/alire/alire-milestones.ads @@ -14,6 +14,9 @@ package Alire.Milestones with Preelaborate is Version : Semantic_Versioning.Version) return Milestone; + function New_Milestone (Image : String) return Milestone; + -- Attempt to parse a valid crate=version milestone + function Crate (M : Milestone) return Crate_Name; function Version (M : Milestone) return Semantic_Versioning.Version; @@ -42,7 +45,12 @@ private function New_Milestone (Name : Crate_Name; Version : Semantic_Versioning.Version) return Milestone - is (Name.Length, Name, Version); + is (Name.Length, Name, Version); + + function New_Milestone (Image : String) return Milestone + is (New_Milestone + (Name => To_Name (Utils.Head (Image, '=')), + Version => Semantic_Versioning.New_Version (Utils.Tail (Image, '=')))); function Crate (M : Milestone) return Crate_Name is (M.Name); diff --git a/src/alire/alire-origins-deployers-source_archive.adb b/src/alire/alire-origins-deployers-source_archive.adb index 673f1610..c1a41a94 100644 --- a/src/alire/alire-origins-deployers-source_archive.adb +++ b/src/alire/alire-origins-deployers-source_archive.adb @@ -138,7 +138,7 @@ package body Alire.Origins.Deployers.Source_Archive is if URI.Scheme (This.Base.Archive_URL) in URI.File_Schemes then if not Dirs.Exists (Folder) then - Dirs.Create_Directory (Folder); + Alire.Directories.Create_Tree (Folder); end if; Ada.Directories.Copy_File diff --git a/src/alire/alire-origins-deployers-system-apt.adb b/src/alire/alire-origins-deployers-system-apt.adb index 4e05789d..c28711ec 100644 --- a/src/alire/alire-origins-deployers-system-apt.adb +++ b/src/alire/alire-origins-deployers-system-apt.adb @@ -82,7 +82,9 @@ package body Alire.Origins.Deployers.System.Apt is end if; end loop; - return Version_Outcomes.Outcome_Failure ("could not be detected"); + Trace.Debug ("System deployer could not detect: " & This.Base.Image); + return Version_Outcomes.Outcome_Failure ("could not be detected", + Report => False); end Detect; ------------- diff --git a/src/alire/alire-origins-deployers-system-pacman.adb b/src/alire/alire-origins-deployers-system-pacman.adb index b6bb086a..4ba4b02f 100644 --- a/src/alire/alire-origins-deployers-system-pacman.adb +++ b/src/alire/alire-origins-deployers-system-pacman.adb @@ -102,7 +102,9 @@ package body Alire.Origins.Deployers.System.Pacman is end if; end if; - return Version_Outcomes.Outcome_Failure ("could not be detected"); + Trace.Debug ("System deployer could not detect: " & This.Base.Image); + return Version_Outcomes.Outcome_Failure ("could not be detected", + Report => False); end Detect; ------------- diff --git a/src/alire/alire-origins-deployers-system-rpm_wrappers.adb b/src/alire/alire-origins-deployers-system-rpm_wrappers.adb index 0b87d694..8bf9333e 100644 --- a/src/alire/alire-origins-deployers-system-rpm_wrappers.adb +++ b/src/alire/alire-origins-deployers-system-rpm_wrappers.adb @@ -98,7 +98,9 @@ package body Alire.Origins.Deployers.System.RPM_Wrappers is end if; end loop; - return Version_Outcomes.Outcome_Failure ("could not be detected"); + Trace.Debug ("System deployer could not detect: " & This.Base.Image); + return Version_Outcomes.Outcome_Failure ("could not be detected", + Report => False); end Detect; ------------- diff --git a/src/alire/alire-origins-deployers-system.adb b/src/alire/alire-origins-deployers-system.adb index ae12873f..129ab732 100644 --- a/src/alire/alire-origins-deployers-system.adb +++ b/src/alire/alire-origins-deployers-system.adb @@ -101,7 +101,7 @@ package body Alire.Origins.Deployers.System is with Wrapper => System.RPM_Wrappers.Dnf, others => <>)); - -- TODO: add here other native package managers as they get + -- NOTE: add here other native package managers as they get -- implemented. ------------------------- diff --git a/src/alire/alire-origins-deployers.adb b/src/alire/alire-origins-deployers.adb index df655310..74bc7458 100644 --- a/src/alire/alire-origins-deployers.adb +++ b/src/alire/alire-origins-deployers.adb @@ -27,6 +27,10 @@ package body Alire.Origins.Deployers is function New_Deployer (From : Origin) return Deployer'Class is begin case From.Kind is + when Origins.Binary_Archive => + -- We can reuse the Source_Archive.Deployer + return Source_Archive.Deployer'(Deployer'(Base => From) + with null record); when Origins.External => return External.Deployer'(Deployer'(Base => From) with null record); @@ -144,7 +148,7 @@ package body Alire.Origins.Deployers is if This.Supports_Hashing then -- Emit a note if we might profit from hashes: - if This.Base.Data.Hashes.Is_Empty then + if This.Base.Get_Hashes.Is_Empty then Trace.Warning ("No integrity hashes provided for " & This.Base.Image); -- TODO: make this an error once all crates are updated with @@ -154,7 +158,7 @@ package body Alire.Origins.Deployers is end if; -- Compute hashes from downloaded release and verify: - for Index_Hash of This.Base.Data.Hashes loop + for Index_Hash of This.Base.Get_Hashes loop Trace.Debug ("Computing " & Hashes.Kind (Index_Hash)'Img & "..."); declare use type Hashes.Any_Digest; diff --git a/src/alire/alire-origins-deployers.ads b/src/alire/alire-origins-deployers.ads index 8fe0cf1c..ffac40f1 100644 --- a/src/alire/alire-origins-deployers.ads +++ b/src/alire/alire-origins-deployers.ads @@ -21,6 +21,8 @@ package Alire.Origins.Deployers is -- create and redispatch the necessary concrete Deployer implementation. -- Since it may fail during normal operation (e.g. network down) it -- contains any unexpected error and returns an Outcome. + -- To deploy a regular Release though, with action execution, the + -- intended way is to call Release.Deploy which will in turn call this one. -------------- -- Deployer -- diff --git a/src/alire/alire-origins.adb b/src/alire/alire-origins.adb index 8e7b671f..dc7d62b3 100644 --- a/src/alire/alire-origins.adb +++ b/src/alire/alire-origins.adb @@ -1,5 +1,7 @@ +with Ada.Directories; + +with Alire.Root; with Alire.URI; -with Alire.VCSs.Git; package body Alire.Origins is @@ -10,6 +12,7 @@ package body Alire.Origins is package Keys is -- TOML keys for serialization Archive_Name : constant String := "archive-name"; + Binary : constant String := "binary"; Commit : constant String := "commit"; Hashes : constant String := "hashes"; Origin : constant String := "origin"; @@ -21,6 +24,156 @@ package body Alire.Origins is -- Try to get a basename for the given URL. Return an empty string on -- failure. + ------------- + -- As_Data -- + ------------- + + function As_Data (This : Conditional_Archive) return Archive_Data'Class + is + -- Resolve the value that applies currently + Evaluated : constant Conditional_Archive := + This.Evaluate (Alire.Root.Platform_Properties); + begin + if Evaluated.Is_Empty then + Raise_Checked_Error + ("Binary archive is unavailable on current platform"); + else + return Conditional_Archives.Tree (Evaluated).Value; + end if; + end As_Data; + + ------------------ + -- New_External -- + ------------------ + + function New_External (Description : String) return Origin is + (Data => (External, Description => +Description, Hashes => <>)); + + -------------------- + -- New_Filesystem -- + -------------------- + + function New_Filesystem (Path : String) return Origin is + (Data => (Filesystem, + Path => +Ada.Directories.Full_Name (Path), + Hashes => <>)); + + ------------- + -- New_Git -- + ------------- + + function New_Git (URL : Alire.URL; + Commit : Git_Commit) + return Origin is + (Data => (Git, Repo_URL => +URL, Commit => +Commit, Hashes => <>)); + + ------------ + -- New_Hg -- + ------------ + + function New_Hg (URL : Alire.URL; + Commit : Hg_Commit) + return Origin is + (Data => (Hg, Repo_URL => +URL, Commit => +Commit, Hashes => <>)); + + ------------- + -- New_SVN -- + ------------- + + function New_SVN (URL : Alire.URL; Commit : String) return Origin is + (Data => (SVN, Repo_URL => +URL, Commit => +Commit, Hashes => <>)); + + ---------------- + -- New_System -- + ---------------- + + function New_System (System_Package_Name : String) return Origin is + (Data => (System, Package_Name => +System_Package_Name, Hashes => <>)); + + ---------- + -- Kind -- + ---------- + + function Kind (This : Origin) return Kinds is (This.Data.Kind); + + --------- + -- URL -- + --------- + + function URL (This : Origin) return Alire.URL is + (Alire.URL (+This.Data.Repo_URL)); + ------------ + -- Commit -- + ------------ + + function Commit (This : Origin) return String is + (+This.Data.Commit); + + --------------------- + -- URL_With_Commit -- + --------------------- + + function URL_With_Commit (This : Origin) return Alire.URL is + (This.URL & "#" & This.Commit); + + ------------------------- + -- TTY_URL_With_Commit -- + ------------------------- + + function TTY_URL_With_Commit (This : Origin) return String is + (TTY.URL (This.URL) & "#" & TTY.Emph (This.Commit)); + + ---------- + -- Path -- + ---------- + + function Path (This : Origin) return String is (+This.Data.Path); + + ----------------- + -- Archive_URL -- + ----------------- + + function Archive_URL (This : Origin) return Alire.URL is + (if This.Kind in Source_Archive + then +This.Data.Src_Archive.URL + else +This.Data.Bin_Archive.As_Data.URL); + + ------------------ + -- Archive_Name -- + ------------------ + + function Archive_Name (This : Origin) return String is + (if This.Kind in Source_Archive + then +This.Data.Src_Archive.Name + else +This.Data.Bin_Archive.As_Data.Name); + + -------------------- + -- Archive_Format -- + -------------------- + + function Archive_Format (This : Origin) return Known_Source_Archive_Format + is (if This.Kind in Source_Archive + then This.Data.Src_Archive.Format + else This.Data.Bin_Archive.As_Data.Format); + + ------------------ + -- Package_Name -- + ------------------ + + function Package_Name (This : Origin) return String is + (+This.Data.Package_Name); + + ------------- + -- Get_URL -- + ------------- + + function Get_URL (This : Origin) return Alire.URL + is (case This.Kind is + when Filesystem => This.Path, + when Source_Archive => This.Archive_URL, + when VCS_Kinds => This.URL, + when others => raise Checked_Error with "Origin has no URL"); + -------------- -- Add_Hash -- -------------- @@ -28,9 +181,72 @@ package body Alire.Origins is procedure Add_Hash (This : in out Origin; Hash : Hashes.Any_Hash) is begin - This.Data.Hashes.Append (Hash); + case This.Kind is + when Filesystem => + This.Data.Hashes.Append (Hash); + when Binary_Archive => + -- This case should not happen, as publishing assistant doesn't + -- work for conditional binary origins. + raise Program_Error with Errors.Set + ("Unintended use of Alire.Origins.Add_Hash"); + when Source_Archive => + This.Data.Src_Archive.Hashes.Append (Hash); + when others => + Raise_Checked_Error ("Cannot add hash to origin kind " + & This.Kind'Image); + end case; end Add_Hash; + ---------------- + -- Get_Hashes -- + ---------------- + + function Get_Hashes (This : Origin) return Hash_Vectors.Vector + is (case This.Kind is + when Filesystem => This.Data.Hashes, + when Binary_Archive => This.Data.Bin_Archive.As_Data.Hashes, + when Source_Archive => This.Data.Src_Archive.Hashes, + when others => Hash_Vectors.Empty_Vector); + + ---------------- + -- Add_Hashes -- + ---------------- + -- Load hash information into the given origin + function Add_Hashes (This : in out Hash_Vectors.Vector; + Parent : TOML_Adapters.Key_Queue) return Outcome is + Val : TOML.TOML_Value; + begin + if Parent.Pop (Keys.Hashes, Val) then + if Val.Kind /= TOML.TOML_Array then + return Parent.Failure + (Keys.Hashes & " must be an array of hash values"); + end if; + + for I in 1 .. Val.Length loop + if Val.Item (I).Kind /= TOML.TOML_String then + return Parent.Failure + ("hash must be a 'kind:digest' formatted string"); + end if; + + declare + Hash : constant String := Val.Item (I).As_String; + begin + if not Hashes.Is_Well_Formed (Hash) then + return Parent.Failure + ("malformed or unknown hash: " & Hash); + end if; + + This.Append (Hashes.Any_Hash (Hash)); + end; + end loop; + else + return Parent.Failure + ("missing mandatory " & Keys.Hashes & " field"); + end if; + + return Outcome_Success; + end Add_Hashes; + ------------------ -- URL_Basename -- ------------------ @@ -108,11 +324,19 @@ package body Alire.Origins is "Unable to determine archive format from file extension"; end if; + -- We add the "file:" to have a proper URI and simplify things for + -- Windows absolute paths with drive letter. return (Data => (Source_Archive, - Hashes => <>, - Archive_URL => +URL, - Archive_Name => +Archive_Name, - Archive_Format => Format)); + Src_Archive => + (URL => + +(if URI.Scheme (URL) in URI.File_Schemes + then "file:" & Ada.Directories.Full_Name + (URI.Local_Path (URL)) + else URL), + Name => +Archive_Name, + Format => Format, + Binary => False, + Hashes => <>))); end New_Source_Archive; ----------------- @@ -196,62 +420,127 @@ package body Alire.Origins is -- From_TOML -- --------------- - overriding - function From_TOML (This : in out Origin; - From : TOML_Adapters.Key_Queue) - return Outcome + function From_TOML (From : TOML_Adapters.Key_Queue) + return Conditional_Archives.Tree is + use TOML; + Archive : TOML_Value; + Table : constant TOML_Adapters.Key_Queue := + From.Descend (From.Checked_Pop (Keys.Origin, TOML_Table), + Context => "data"); + begin + -- Optional filename checks: + if Table.Pop (Keys.Archive_Name, Archive) then + if Archive.Kind /= TOML.TOML_String then + Table.Checked_Error ("archive name must be a string"); + end if; + end if; - ---------------- - -- Add_Hashes -- - ---------------- - - function Add_Hashes (Parent : TOML_Adapters.Key_Queue) return Outcome is - Val : TOML.TOML_Value; + declare + Archive_Origin : Origin := + New_Source_Archive + (URL => Table.Checked_Pop + (Keys.URL, TOML_String).As_String, + Name => (if Archive.Is_Present + then Archive.As_String + else "")); begin - if Parent.Pop (Keys.Hashes, Val) then - if Val.Kind /= TOML.TOML_Array then - return Parent.Failure - (Keys.Hashes & " must be an array of hash values"); - end if; + Add_Hashes (Archive_Origin.Data.Src_Archive.Hashes, Table).Assert; - for I in 1 .. Val.Length loop - if Val.Item (I).Kind /= TOML.TOML_String then - return Parent.Failure - ("hash must be a 'kind:digest' formatted string"); - end if; + if Table.Unwrap.Has (Keys.Binary) then + Archive_Origin.Data.Src_Archive.Binary := + Table.Checked_Pop (Keys.Binary, TOML_Boolean).As_Boolean; + end if; - declare - Hash : constant String := Val.Item (I).As_String; - begin - if not Hashes.Is_Well_Formed (Hash) then - return Parent.Failure - ("malformed or unknown hash: " & Hash); - end if; + Table.Report_Extra_Keys; + + -- Wrap as a conditional tree + return Conditional_Archives.New_Leaf + (Archive_Origin.Data.Src_Archive); + end; + exception + when Unknown_Source_Archive_Name_Error => + Table.Checked_Error + ("unable to determine archive name from URL: " + & "please specify one with '" + & Keys.Archive_Name & "'"); + end From_TOML; - This.Add_Hash (Hashes.Any_Hash (Hash)); - end; - end loop; - else - return Parent.Failure - ("missing mandatory " & Keys.Hashes & " field"); - end if; + --------------- + -- From_TOML -- + --------------- - return Outcome_Success; - end Add_Hashes; + function From_TOML (From : TOML_Adapters.Key_Queue) return Archive_Data + is (Archive_Data + (Conditional_Archive' + (Conditional_Archives.Tree'(From_TOML (From)) with null record) + .As_Data)); + + --------------- + -- From_TOML -- + --------------- + + overriding + function From_TOML (This : in out Origin; + From : TOML_Adapters.Key_Queue) + return Outcome + is use TOML; use all type URI.Schemes; - Archive : TOML_Value; Table : constant TOML_Adapters.Key_Queue := From.Descend (From.Checked_Pop (Keys.Origin, TOML_Table), - Context => Keys.Origin); - URL : constant String := - Table.Checked_Pop (Keys.URL, TOML_String).As_String; - Scheme : constant URI.Schemes := URI.Scheme (URL); - Hashed : constant Boolean := Table.Unwrap.Has (Keys.Hashes); + Context => Keys.Origin); + + ----------------- + -- Mark_Binary -- + ----------------- + + procedure Mark_Binary (Data : in out Archive_Data) is + begin + Data.Binary := True; + end Mark_Binary; + begin - case Scheme is + -- Check if we are seeing a conditional binary origin, or a regular + -- static one. If the former, divert to the dynamic loader; else + -- continue loading normally. + + if (for some Key of Table.Unwrap.Keys => + Utils.Starts_With (+Key, "case(")) + or else + (Table.Unwrap.Has (Keys.Binary) and then + Table.Unwrap.Get (Keys.Binary).As_Boolean) + then + This := (Data => Origin_Data' + (Kind => Binary_Archive, + Bin_Archive => (Binary_Loader.Load + (From => Table.Descend + (Keys.Origin, + Table.Unwrap, + Context => "binary archive"), + Loader => From_TOML'Access, + Resolve => True, + Strict => False) with null record))); + + -- Mark these as explicitly binary, because they're in a case, even + -- if the maintainer omitted the binary field. This saves some noise + -- in the manifest files. + + This.Data.Bin_Archive.Visit_All (Mark_Binary'Access); + + return Outcome_Success; + end if; + + -- Regular static loading of other origin kinds + + declare + URL : constant String := + Table.Checked_Pop (Keys.URL, TOML_String).As_String; + Scheme : constant URI.Schemes := URI.Scheme (URL); + Hashed : constant Boolean := Table.Unwrap.Has (Keys.Hashes); + begin + case Scheme is when External => This := New_External (URI.Path (URL)); @@ -261,7 +550,7 @@ package body Alire.Origins is end if; This := New_Filesystem (URI.Local_Path (URL)); - when URI.VCS_Schemes => null; + when URI.VCS_Schemes => declare Commit : constant String := Table.Checked_Pop (Keys.Commit, TOML_String).As_String; @@ -270,47 +559,44 @@ package body Alire.Origins is end; when HTTP => - -- Optional filename checks: - if Table.Pop (Keys.Archive_Name, Archive) then - if Archive.Kind /= TOML.TOML_String then - return Table.Failure ("archive name must be a string"); - end if; - end if; - - begin - This := New_Source_Archive - (URL => URL, - Name => (if Archive.Is_Present - then Archive.As_String - else "")); - exception - when Unknown_Source_Archive_Name_Error => - return Table.Failure - ("unable to determine archive name from URL: " - & "please specify one with '" - & Keys.Archive_Name & "'"); - end; - + -- Reinsert the URL so we can reuse the dynamic archive loader: + Table.Unwrap.Set (Keys.URL, Create_String (URL)); + + -- And load + This := (Data => (Kind => Source_Archive, + Src_Archive => From_TOML + (Table.Descend + (Keys.Origin, + Table.Unwrap, + Context => "source archive")), + Hashes => <>)); when System => This := New_System (URI.Path (URL)); when Unknown => From.Checked_Error ("unsupported scheme in URL: " & URL); - end case; + end case; - -- Check hashes existence appropriateness + -- Check hashes existence appropriateness - case This.Kind is + case This.Kind is when Filesystem => if Hashed then - return Add_Hashes (Table); + Add_Hashes (This.Data.Hashes, Table).Assert; end if; -- Hashes are mandatory only for source archives. This is checked -- on deployment, since at this moment we do not have the proper -- absolute patch + when Binary_Archive => + -- Should not happen, as we have loaded this particular case above + raise Program_Error with + Errors.Set ("This case should be unreachable"); + when Source_Archive => - return Add_Hashes (Table); -- mandatory + -- Hashes already loaded by the archive data loader + Assert (not This.Data.Src_Archive.Hashes.Is_Empty, + Or_Else => "source archive hashes missing"); when others => if Hashed then @@ -318,11 +604,42 @@ package body Alire.Origins is ("hashes cannot be provided for origins of kind " & Utils.To_Mixed_Case (This.Kind'Img)); end if; - end case; + end case; - return Table.Report_Extra_Keys; + return Table.Report_Extra_Keys; + end; end From_TOML; + ----------- + -- Image -- + ----------- + + function Image (This : Origin) return String is + ((case This.Kind is + when VCS_Kinds => + "commit " & S (This.Data.Commit) + & " from " & S (This.Data.Repo_URL), + when Archive_Kinds => + (if This.Kind in Source_Archive then + Source_Image (This.Data.Src_Archive) + elsif This.Data.Bin_Archive.Is_Value then + Binary_Image (This.Data.Bin_Archive.As_Data) + else + This.Data.Bin_Archive.Image_One_Line), + when System => + "system package from platform software manager: " + & This.Package_Name, + when Filesystem => + "path " & S (This.Data.Path), + when External => + "external " & S (This.Data.Description)) + & (if This.Get_Hashes.Is_Empty + then "" + elsif This.Get_Hashes.Last_Index = 1 + then " with hash " & This.Image_Of_Hashes + else " with hashes " & This.Image_Of_Hashes) + ); + --------------------- -- Image_Of_Hashes -- --------------------- @@ -330,12 +647,12 @@ package body Alire.Origins is function Image_Of_Hashes (This : Origin) return String is -- Recursively concatenate all hashes: - function Reduce (I : Natural := This.Data.Hashes.Last_Index) + function Reduce (I : Natural := This.Get_Hashes.Last_Index) return String is (if I = 0 then "" elsif I > 1 then Reduce (I => I - 1) & ", " - & String (This.Data.Hashes.Element (I)) - else String (This.Data.Hashes.Element (I))); + & String (This.Get_Hashes.Element (I)) + else String (This.Get_Hashes.Element (I))); begin return Reduce; @@ -356,8 +673,8 @@ package body Alire.Origins is function Short_Unique_Id (This : Origin) return String is (Short_Commit - (if This.Kind = Source_Archive - then Utils.Tail (String (This.Data.Hashes.First_Element), ':') + (if This.Kind in Source_Archive | Binary_Archive + then Utils.Tail (String (This.Get_Hashes.First_Element), ':') else This.Commit)); ------------- @@ -366,7 +683,7 @@ package body Alire.Origins is overriding function To_TOML (This : Origin) return TOML.TOML_Value is use TOML_Adapters; - Table : constant TOML.TOML_Value := TOML.Create_Table; + Table : TOML.TOML_Value := TOML.Create_Table; begin case This.Kind is when Filesystem => @@ -387,24 +704,23 @@ package body Alire.Origins is Table.Set (Keys.URL, +(Prefixes (This.Kind).all & (+This.Data.Description))); + when Binary_Archive => + Table := TOML.Merge (Table, + This.Data.Bin_Archive.As_Data.To_TOML); + when Source_Archive => - Table.Set (Keys.URL, +This.Archive_URL); - if This.Archive_Name /= "" and then - This.Archive_Name /= URL_Basename (This.Archive_URL) - then - Table.Set (Keys.Archive_Name, +This.Archive_Name); - end if; + Table := TOML.Merge (Table, This.Data.Src_Archive.To_TOML); when System => Table.Set (Keys.URL, +(Prefixes (This.Kind).all & This.Package_Name)); end case; - if not This.Data.Hashes.Is_Empty then + if not This.Get_Hashes.Is_Empty then declare Hashes : constant TOML.TOML_Value := TOML.Create_Array; begin - for Hash of This.Data.Hashes loop + for Hash of This.Get_Hashes loop Hashes.Append (+String (Hash)); end loop; @@ -415,4 +731,53 @@ package body Alire.Origins is return Table; end To_TOML; + ------------- + -- To_TOML -- + ------------- + + overriding + function To_TOML (This : Archive_Data) return TOML.TOML_Value is + use TOML; + Table : constant TOML.TOML_Value := TOML.Create_Table; + begin + Table.Set (Keys.URL, Create_String (This.URL)); + + if This.Name /= "" and then + This.Name /= URL_Basename (+This.URL) + then + Table.Set (Keys.Archive_Name, Create_String (This.Name)); + end if; + + if This.Binary then + Table.Set (Keys.Binary, Create_Boolean (This.Binary)); + end if; + + return Table; + end To_TOML; + + -------------- + -- Whenever -- + -------------- + + function Whenever (This : Origin; Env : Properties.Vector) return Origin is + begin + if This.Kind = Binary_Archive then + return Result : Origin := This do + Result.Data.Bin_Archive := This.Data.Bin_Archive.Evaluate (Env); + end return; + else + return This; + end if; + end Whenever; + + ------------------ + -- Is_Available -- + ------------------ + + function Is_Available (This : Origin; Env : Properties.Vector) + return Boolean + is (This.Kind /= Binary_Archive + or else + not This.Data.Bin_Archive.Evaluate (Env).Is_Empty); + end Alire.Origins; diff --git a/src/alire/alire-origins.ads b/src/alire/alire-origins.ads index 5e91b5eb..a9c16133 100644 --- a/src/alire/alire-origins.ads +++ b/src/alire/alire-origins.ads @@ -1,7 +1,13 @@ +private with Alire.Conditional_Trees.TOML_Load; +with Alire.Errors; with Alire.Hashes; with Alire.Interfaces; +with Alire.Properties; with Alire.TOML_Adapters; +private with Alire.TOML_Keys; with Alire.Utils.TTY; +with Alire.VCSs.Git; +with Alire.VCSs.Hg; private with Ada.Containers.Indefinite_Vectors; private with Ada.Strings.Unbounded; @@ -13,7 +19,8 @@ package Alire.Origins is package TTY renames Alire.Utils.TTY; type Kinds is - (External, -- A do-nothing origin, with some custom description + (Binary_Archive, -- A pre-compiled binary (dynamic expr + source archive) + External, -- A do-nothing origin, with some custom description Filesystem, -- Not really an origin, but a working copy of a release Git, -- Remote git repo Hg, -- Remote hg repo @@ -26,11 +33,14 @@ package Alire.Origins is type Prefix_Array is array (Kinds) of String_Access; Prefixes : constant Prefix_Array; - subtype VCS_Kinds is Kinds range Git .. SVN; + subtype Archive_Kinds is Kinds + with Static_Predicate => Archive_Kinds in Binary_Archive | Source_Archive; subtype External_Kinds is Kinds with Static_Predicate => External_Kinds in External | System; + subtype VCS_Kinds is Kinds range Git .. SVN; + type Source_Archive_Format is (Unknown, Tarball, Zip_Archive); subtype Known_Source_Archive_Format is Source_Archive_Format range Tarball .. Source_Archive_Format'Last; @@ -43,6 +53,14 @@ package Alire.Origins is function Kind (This : Origin) return Kinds; + function Whenever (This : Origin; Env : Properties.Vector) return Origin; + -- Resolve expressions in the origin + + function Is_Available (This : Origin; Env : Properties.Vector) + return Boolean; + -- For a binary origin, true iif there is a value for the environment. True + -- for the rest of kinds. + ------------------- -- member data -- ------------------- @@ -61,11 +79,11 @@ package Alire.Origins is with Pre => This.Kind = Filesystem; function Archive_URL (This : Origin) return Alire.URL - with Pre => This.Kind = Source_Archive; + with Pre => This.Kind in Archive_Kinds; function Archive_Name (This : Origin) return String - with Pre => This.Kind = Source_Archive; + with Pre => This.Kind in Archive_Kinds; function Archive_Format (This : Origin) return Known_Source_Archive_Format - with Pre => This.Kind = Source_Archive; + with Pre => This.Kind in Archive_Kinds; function Archive_Format (Name : String) return Source_Archive_Format; -- Guess the format of a source archive from its file name. @@ -82,22 +100,16 @@ package Alire.Origins is -- from external definitions (detected or not). function Short_Unique_Id (This : Origin) return String with - Pre => This.Kind in Git | Hg | Source_Archive; + Pre => This.Kind in Git | Hg | Archive_Kinds; -- Helper types - subtype Hexadecimal_Character is Character with - Static_Predicate => Hexadecimal_Character in '0' .. '9' | 'a' .. 'f'; - - subtype Git_Commit is String (1 .. 40) with - Dynamic_Predicate => - (for all Char of Git_Commit => Char in Hexadecimal_Character); - - subtype Hg_Commit is String (1 .. 40); + subtype Git_Commit is VCSs.Git.Git_Commit; + subtype Hg_Commit is VCSs.Hg.Hg_Commit; function Is_Valid_Commit (S : String) return Boolean is (S'Length = Git_Commit'Length and then - (for all Char of S => Char in Hexadecimal_Character)); + (for all Char of S => Char in Utils.Hexadecimal_Character)); function Short_Commit (Commit : String) return String; -- First characters in the commit @@ -106,7 +118,10 @@ package Alire.Origins is function New_External (Description : String) return Origin; - function New_Filesystem (Path : String) return Origin; + function New_Filesystem (Path : Any_Path) return Origin; + -- If Path is relative it will be converted to a full path, so this + -- function should be called from a point where the path makes sense + -- in that case. function New_Git (URL : Alire.URL; Commit : Git_Commit) @@ -171,6 +186,9 @@ private package Hash_Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Hashes.Any_Hash); + function Get_Hashes (This : Origin) return Hash_Vectors.Vector; + -- Ugly Get_ but it avoids lots of ambiguities down the line + function "+" (S : String) return Unbounded_String renames To_Unbounded_String; @@ -189,24 +207,73 @@ private function Packaged_As (Name : String) return Package_Names is (Name => +Name); - type Origin_Data (Kind : Kinds := External) is record + function S (Str : Unbounded_String) return String is (To_String (Str)); + + type Archive_Data is + new Interfaces.Classificable + and Interfaces.Tomifiable + and Interfaces.Yamlable with + record + URL : Unbounded_String; + Name : Unbounded_String; + Format : Known_Source_Archive_Format; Hashes : Hash_Vectors.Vector; + Binary : Boolean; + end record; + + overriding + function Key (This : Archive_Data) return String is (TOML_Keys.Origin); + + overriding + function To_TOML (This : Archive_Data) return TOML.TOML_Value; + + overriding + function To_YAML (This : Archive_Data) return String + is (raise Unimplemented with Errors.Set ("Should not be needed")); + + function Image (Archive : Archive_Data; + Kind : Archive_Kinds) return String + is ((if Kind in Source_Archive + then "source archive " + else "binary archive ") + & (if S (Archive.Name) /= "" + then S (Archive.Name) & " " + else "") + & "at " & S (Archive.URL)); + + function Binary_Image (Archive : Archive_Data) return String + is (Image (Archive, Binary_Archive)); + + function Source_Image (Archive : Archive_Data) return String + is (Image (Archive, Source_Archive)); + + package Conditional_Archives is + new Conditional_Trees (Values => Archive_Data, + Image => Binary_Image); + + type Conditional_Archive is new Conditional_Archives.Tree with null record; + package Binary_Loader is new Conditional_Archives.TOML_Load; + + function As_Data (This : Conditional_Archive) return Archive_Data'Class; + type Origin_Data (Kind : Kinds := External) is record case Kind is + when Binary_Archive => + Bin_Archive : Conditional_Archive; + when External => Description : Unbounded_String; when Filesystem => - Path : Unbounded_String; + Path : Unbounded_String; + Hashes : Hash_Vectors.Vector; when VCS_Kinds => Repo_URL : Unbounded_String; Commit : Unbounded_String; when Source_Archive => - Archive_URL : Unbounded_String; - Archive_Name : Unbounded_String; - Archive_Format : Known_Source_Archive_Format; + Src_Archive : Archive_Data; when System => Package_Name : Unbounded_String; @@ -223,84 +290,6 @@ private function Image_Of_Hashes (This : Origin) return String; - function New_External (Description : String) return Origin is - (Data => (External, Description => +Description, Hashes => <>)); - - function New_Filesystem (Path : String) return Origin is - (Data => (Filesystem, Path => +Path, Hashes => <>)); - - function New_Git (URL : Alire.URL; - Commit : Git_Commit) - return Origin is - (Data => (Git, Repo_URL => +URL, Commit => +Commit, Hashes => <>)); - - function New_Hg (URL : Alire.URL; - Commit : Hg_Commit) - return Origin is - (Data => (Hg, Repo_URL => +URL, Commit => +Commit, Hashes => <>)); - - function New_SVN (URL : Alire.URL; Commit : String) return Origin is - (Data => (SVN, Repo_URL => +URL, Commit => +Commit, Hashes => <>)); - - function New_System (System_Package_Name : String) return Origin is - (Data => (System, Package_Name => +System_Package_Name, Hashes => <>)); - - function Kind (This : Origin) return Kinds is (This.Data.Kind); - - function URL (This : Origin) return Alire.URL is - (Alire.URL (+This.Data.Repo_URL)); - function Commit (This : Origin) return String is - (+This.Data.Commit); - function URL_With_Commit (This : Origin) return Alire.URL is - (This.URL & "#" & This.Commit); - function TTY_URL_With_Commit (This : Origin) return String is - (TTY.URL (This.URL) & "#" & TTY.Emph (This.Commit)); - - function Path (This : Origin) return String is (+This.Data.Path); - - function Archive_URL (This : Origin) return Alire.URL is - (+This.Data.Archive_URL); - function Archive_Name (This : Origin) return String is - (+This.Data.Archive_Name); - function Archive_Format (This : Origin) return Known_Source_Archive_Format - is (This.Data.Archive_Format); - - function Package_Name (This : Origin) return String is - (+This.Data.Package_Name); - - function S (Str : Unbounded_String) return String is (To_String (Str)); - - function Image (This : Origin) return String is - ((case This.Kind is - when VCS_Kinds => - "commit " & S (This.Data.Commit) - & " from " & S (This.Data.Repo_URL), - when Source_Archive => - "source archive " & (if S (This.Data.Archive_Name) /= "" - then S (This.Data.Archive_Name) & " " - else "") - & "at " & S (This.Data.Archive_URL), - when System => - "system package from platform software manager: " - & This.Package_Name, - when Filesystem => - "path " & S (This.Data.Path), - when External => - "external " & S (This.Data.Description)) - & (if This.Data.Hashes.Is_Empty - then "" - elsif This.Data.Hashes.Last_Index = 1 - then " with hash " & This.Image_Of_Hashes - else " with hashes " & This.Image_Of_Hashes) - ); - - function Get_URL (This : Origin) return Alire.URL - is (case This.Kind is - when Filesystem => This.Path, - when Source_Archive => This.Archive_URL, - when VCS_Kinds => This.URL, - when others => raise Checked_Error with "Origin has no URL"); - Prefix_External : aliased constant String := "external:"; Prefix_Git : aliased constant String := "git+"; Prefix_Hg : aliased constant String := "hg+"; @@ -315,6 +304,6 @@ private External => Prefix_External'Access, Filesystem => Prefix_File'Access, System => Prefix_System'Access, - Source_Archive => null); + Archive_Kinds => null); end Alire.Origins; diff --git a/src/alire/alire-paths.ads b/src/alire/alire-paths.ads index e4daa062..7ea0fb48 100644 --- a/src/alire/alire-paths.ads +++ b/src/alire/alire-paths.ads @@ -7,6 +7,8 @@ package Alire.Paths with Preelaborate is Cache_Folder_Inside_Working_Folder : constant Relative_Path := "cache"; + Deps_Folder_Inside_Cache_Folder : constant Relative_Path := "dependencies"; + Temp_Folder_Inside_Working_Folder : constant Relative_Path := "tmp"; function Working_Folder_Inside_Root return Relative_Path diff --git a/src/alire/alire-platform.ads b/src/alire/alire-platform.ads index c476381b..c678a38d 100644 --- a/src/alire/alire-platform.ads +++ b/src/alire/alire-platform.ads @@ -1,5 +1,5 @@ with Alire.Platforms; -with Alire.Environment; +limited with Alire.Environment; private with GNATCOLL.OS.Constants; diff --git a/src/alire/alire-properties-actions-executor.adb b/src/alire/alire-properties-actions-executor.adb index fef72c60..b54ae2e0 100644 --- a/src/alire/alire-properties-actions-executor.adb +++ b/src/alire/alire-properties-actions-executor.adb @@ -1,6 +1,7 @@ with Alire.Directories; with Alire.OS_Lib.Subprocess; with Alire.Properties.Actions.Runners; +with Alire.TTY; package body Alire.Properties.Actions.Executor is @@ -77,18 +78,25 @@ package body Alire.Properties.Actions.Executor is Err_To_Out : Boolean; Code : out Integer; Output : out Utils.String_Vector; - Prefix : Utils.String_Vector := Utils.Empty_Vector) is + Prefix : Utils.String_Vector := Utils.Empty_Vector) + is + Now : Releases.Moment_Array := (others => False); begin - for Act of Release.On_Platform_Actions (Env) loop - if Action'Class (Act).Moment = Moment then - Trace.Detail ("Running action: " & Act.Image); - Execute_Run (This => Runners.Run (Act), - Capture => Capture, - Err_To_Out => Err_To_Out, - Code => Code, - Output => Output, - Prefix => Prefix); - end if; + Now (Moment) := True; -- Cannot be done in the initialization + + if not Release.On_Platform_Actions (Env, Now).Is_Empty then + Put_Info ("Running " & TTY.Name (Utils.To_Lower_Case (Moment'Image)) + & " actions for " & Release.Milestone.TTY_Image & "..."); + end if; + + for Act of Release.On_Platform_Actions (Env, Now) loop + Trace.Detail ("Running action: " & Act.Image); + Execute_Run (This => Runners.Run (Act), + Capture => Capture, + Err_To_Out => Err_To_Out, + Code => Code, + Output => Output, + Prefix => Prefix); end loop; end Execute_Actions; diff --git a/src/alire/alire-provides.adb b/src/alire/alire-provides.adb new file mode 100644 index 00000000..d2835a92 --- /dev/null +++ b/src/alire/alire-provides.adb @@ -0,0 +1,77 @@ +with Semantic_Versioning.Extended; + +package body Alire.Provides is + + -------------------- + -- Image_One_Line -- + -------------------- + + function Image_One_Line (This : Equivalences) return String is + use UStrings; + Result : UString; + First : Boolean := True; + begin + if This.Is_Empty then + return "(nothing)"; -- not visible anywhere if all goes well + end if; + + for Equiv of This loop + if not First then + Append (Result, ", "); + end if; + + Append (Result, Equiv.TTY_Image); + First := False; + end loop; + + return +Result; + end Image_One_Line; + + --------------- + -- Satisfies -- + --------------- + + function Satisfies (This : Equivalences; + Dep : Dependencies.Dependency'Class) + return Boolean + is (for some Milestone of This => + Milestone.Crate = Dep.Crate + and then + Semantic_Versioning.Extended.Is_In (Milestone.Version, Dep.Versions)); + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (From : TOML_Adapters.Key_Queue) return Equivalences is + use TOML; + TOML_Equivs : constant TOML_Value := From.Unwrap; + begin + return Result : Equivalences do + for I in 1 .. TOML_Equivs.Length loop + From.Assert (TOML_Equivs.Item (I).Kind = TOML_String, + "expected a string describing a milestone, but got: " + & TOML_Equivs.Item (I).Kind'Image); + + Result.Append + (Milestones.New_Milestone (TOML_Equivs.Item (I).As_String)); + end loop; + end return; + end From_TOML; + + ------------- + -- To_TOML -- + ------------- + + function To_TOML (This : Equivalences) return TOML.TOML_Value is + use TOML; + Result : constant TOML_Value := Create_Array; + begin + for Equiv of This loop + Result.Append (Create_String (Equiv.Image)); + end loop; + + return Result; + end To_TOML; + +end Alire.Provides; diff --git a/src/alire/alire-provides.ads b/src/alire/alire-provides.ads new file mode 100644 index 00000000..b8fe425d --- /dev/null +++ b/src/alire/alire-provides.ads @@ -0,0 +1,37 @@ +with Alire.Dependencies; +with Alire.Milestones.Containers; +with Alire.TOML_Adapters; + +with TOML; + +package Alire.Provides with Preelaborate is + + -- Support for releases filling in for another crate release. Each + -- individual equivalence is a milestone. Conceptually, an equivalence + -- could be a dependency, but this complicates things elsewhere, as we + -- would need to intersect dependencies (which Semantic_Versioning cannot + -- do) to check satisfiability. + + type Equivalences is new Milestones.Containers.Lists.List with null record; + + No_Equivalences : constant Equivalences; + + function Satisfies (This : Equivalences; + Dep : Dependencies.Dependency'Class) + return Boolean; + -- Check if any of the stored milestones fulfills the dependency. + + function Image_One_Line (This : Equivalences) return String; + + function From_TOML (From : TOML_Adapters.Key_Queue) return Equivalences + with Pre => From.Unwrap.Kind in TOML.TOML_Array; + + function To_TOML (This : Equivalences) return TOML.TOML_Value with + Post => To_TOML'Result.Kind in TOML.TOML_Array; + +private + + No_Equivalences : constant Equivalences := + (Milestones.Containers.Lists.Empty_List with null record); + +end Alire.Provides; diff --git a/src/alire/alire-containers.adb b/src/alire/alire-releases-containers.adb similarity index 51% rename from src/alire/alire-containers.adb rename to src/alire/alire-releases-containers.adb index 963d11ab..cd94736d 100644 --- a/src/alire/alire-containers.adb +++ b/src/alire/alire-releases-containers.adb @@ -1,31 +1,42 @@ -with Semantic_Versioning.Basic; +with Alire.Errors; + with Semantic_Versioning.Extended; +with Semantic_Versioning.Basic; -package body Alire.Containers is +package body Alire.Releases.Containers is - --------------- - -- Enumerate -- - --------------- + -------------------------- + -- Contains_Or_Provides -- + -------------------------- - function Enumerate (These : Conditional.Dependencies) return Dependency_Map - is - - procedure Append (C : in out Dependency_Map; - V : Dependencies.Dependency; - Count : Ada.Containers.Count_Type := 1) - is - pragma Unreferenced (Count); - begin - C.Include (V.Crate, V); - end Append; + function Contains_Or_Provides (This : Release_Map; + Crate : Crate_Name) return Boolean + is (This.Contains (Crate) + or else + (for some Rel of This => Rel.Provides (Crate))); - function Internal is new Conditional.For_Dependencies.Enumerate - (Collection => Dependency_Map, - Append => Append); + ----------------------- + -- Element_Providing -- + ----------------------- + function Element_Providing (This : Release_Map; + Crate : Crate_Name) + return Releases.Release + is begin - return Internal (These); - end Enumerate; + if This.Contains (Crate) then + return This (Crate); + else + for Rel of This loop + if Rel.Provides (Crate) then + return Rel; + end if; + end loop; + end if; + + raise Constraint_Error with Errors.Set + ("Requested crate not in map: " & Crate.As_String); + end Element_Providing; ------------ -- Insert -- @@ -59,9 +70,6 @@ package body Alire.Containers is return Result : Release_Map := Dst do for E of Src loop Result.Insert (E.Name, E); - if E.Name /= E.Provides then - Result.Insert (E.Provides, E); - end if; end loop; end return; end Inserting; @@ -89,6 +97,25 @@ package body Alire.Containers is end return; end Excluding; + -------------------- + -- Image_One_Line -- + -------------------- + + function Image_One_Line (This : Release_Set) return String is + Result : UString; + use UStrings; + begin + for Rel of This loop + if Result /= "" then + Append (Result, ", "); + end if; + + Append (Result, Rel.Milestone.TTY_Image); + end loop; + + return +Result; + end Image_One_Line; + --------------- -- Including -- --------------- @@ -103,34 +130,47 @@ package body Alire.Containers is end return; end Including; - ----------- - -- Merge -- - ----------- + ------------ + -- Remove -- + ------------ - procedure Merge (This : in out Dependency_Map; - Dep : Dependencies.Dependency) + procedure Remove (This : in out Release_Map; + Release : Releases.Release) is - use type Dependencies.Dependency; - use type Semantic_Versioning.Extended.Version_Set; begin - if This.Contains (Dep.Crate) then - declare - Old : constant Dependencies.Dependency := This (Dep.Crate); - begin - if Old /= Dep then - -- Include should work to replace the dependency, but I'm - -- getting a tampering error using it (?) - This.Delete (Dep.Crate); - This.Insert (Dep.Crate, - Dependencies.New_Dependency - (Dep.Crate, - Old.Versions and Dep.Versions)); - end if; - end; + if This.Contains (Release.Name) then + This.Exclude (Release.Name); + return; else - This.Insert (Dep.Crate, Dep); + for Mil of Release.Provides loop + if This.Contains (Mil.Crate) then + This.Exclude (Mil.Crate); + return; + end if; + end loop; end if; - end Merge; + + raise Constraint_Error with Errors.Set + ("Release not in map: " & Release.Milestone.TTY_Image); + end Remove; + + ---------------- + -- Satisfying -- + ---------------- + + function Satisfying (This : Release_Set; + Dep : Alire.Dependencies.Dependency) + return Release_Set + is + begin + return Result : Release_Set do + for Release of This loop + if Release.Satisfies (Dep) then + Result.Include (Release); + end if; + end loop; + end return; + end Satisfying; --------------------- -- To_Dependencies -- @@ -141,18 +181,15 @@ package body Alire.Containers is is package Semver renames Semantic_Versioning; use Conditional.For_Dependencies; - use Crate_Release_Maps; begin return Deps : Conditional.Dependencies do for I in Map.Iterate loop - if Key (I) = Map (I).Provides then -- Avoid duplicates - Deps := - Deps and - Conditional.New_Dependency - (Map (I).Name, - Semver.Extended.To_Extended - (Semver.Basic.Exactly (Map (I).Version))); - end if; + Deps := + Deps and + Conditional.New_Dependency + (Map (I).Name, + Semver.Extended.To_Extended + (Semver.Basic.Exactly (Map (I).Version))); end loop; end return; end To_Dependencies; @@ -173,7 +210,7 @@ package body Alire.Containers is -------------- function Whenever (Map : Release_Map; - Props : Properties.Vector) return Release_Map is + Props : Alire.Properties.Vector) return Release_Map is begin return Result : Release_Map do for Release of Map loop @@ -182,4 +219,4 @@ package body Alire.Containers is end return; end Whenever; -end Alire.Containers; +end Alire.Releases.Containers; diff --git a/src/alire/alire-releases-containers.ads b/src/alire/alire-releases-containers.ads new file mode 100644 index 00000000..cac8ca5d --- /dev/null +++ b/src/alire/alire-releases-containers.ads @@ -0,0 +1,105 @@ +with AAA.Containers.Indefinite_Holders; + +with Ada.Containers.Indefinite_Ordered_Sets; +with Optional.Values; + +package Alire.Releases.Containers is + + function Release_Image (R : Releases.Release) return String + is (R.Milestone.TTY_Image); + + package Optional_Releases is new Optional.Values (Releases.Release, + Release_Image); + + package Release_Sets + is new Ada.Containers.Indefinite_Ordered_Sets (Releases.Release, + Releases."<", + Releases."="); + type Release_Set is new Release_Sets.Set with null record; + Empty_Release_Set : constant Release_Set; + + function Image_One_Line (This : Release_Set) return String; + + function Satisfying (This : Release_Set; + Dep : Alire.Dependencies.Dependency) + return Release_Set + with Post => + Satisfying'Result.Is_Empty + or else (for all Release of Satisfying'Result => + Release.Satisfies (Dep)); + + package Release_Holders + is new AAA.Containers.Indefinite_Holders (Releases.Release); + subtype Release_H is Release_Holders.Holder; + + package Crate_Release_Maps is new Ada.Containers.Indefinite_Ordered_Maps + (Crate_Name, Releases.Release, "<", Releases."="); + type Release_Map is new Crate_Release_Maps.Map with null record; + + Empty_Release_Map : constant Release_Map; + + function Excluding (Map : Release_Map; + Name : Crate_Name) + return Release_Map; + + function Including (Map : Release_Map; + Release : Releases.Release) + return Release_Map; + -- Finds the current release (if existing) and replaces/adds the new + -- Release. + + procedure Insert (Dst : in out Release_Map; Src : Releases.Release); + -- Insert a release under its name as key + + procedure Insert (Dst : in out Release_Map; Src : Release_Map); + + function Inserting (Dst : Release_Map; + Src : Release_Map) + return Release_Map; + + function Inserting (Dst : Release_Map; + Src : Releases.Release) + return Release_Map; + -- Those insert both under the actual crate name and Provides, if + -- different. + + procedure Remove (This : in out Release_Map; + Release : Releases.Release); + -- Locate the release, by name or provides, and remove it. Will raise if + -- the release is not found. + + function Contains_Or_Provides (This : Release_Map; + Crate : Crate_Name) return Boolean; + -- Say if either the crate is a direct member, or provided by one of the + -- stored releases. + + function Element_Providing (This : Release_Map; + Crate : Crate_Name) + return Releases.Release + with Pre => This.Contains_Or_Provides (Crate); + -- Returns the release that is or provides Crate + + function To_Dependencies (Map : Release_Map) + return Conditional.Dependencies; + -- Will filter out duplicates under Provides key (only actual crates will + -- remain). + + function Whenever (Map : Release_Map; + Props : Alire.Properties.Vector) return Release_Map; + -- Replace every release with one that has no case expressions, using + -- environment Props. + + function To_Map (R : Releases.Release) return Release_Map; + + function To_Release_H (R : Releases.Release) return Release_H + renames Release_Holders.To_Holder; + +private + + Empty_Release_Map : constant Release_Map := + (Crate_Release_Maps.Empty_Map with null record); + + Empty_Release_Set : constant Release_Set := + (Release_Sets.Empty_Set with null record); + +end Alire.Releases.Containers; diff --git a/src/alire/alire-releases.adb b/src/alire/alire-releases.adb index 5fd34991..c9718cc2 100644 --- a/src/alire/alire-releases.adb +++ b/src/alire/alire-releases.adb @@ -8,6 +8,7 @@ with Alire.Directories; with Alire.Defaults; with Alire.Errors; with Alire.Origins.Deployers; +with Alire.Paths; with Alire.Properties.Bool; with Alire.Properties.Actions.Executor; with Alire.TOML_Load; @@ -27,6 +28,15 @@ package body Alire.Releases is use all type Alire.Properties.Labeled.Labels; + --------- + -- "<" -- + --------- + + function "<" (L, R : Release) return Boolean + is (if L.Provides (GNAT_Crate) and then R.Provides (GNAT_Crate) + then Sort_Compilers (L, R) + else Standard_Sorting (L, R)); + -------------------- -- All_Properties -- -------------------- @@ -128,12 +138,54 @@ package body Alire.Releases is Env : Alire.Properties.Vector; Parent_Folder : String; Was_There : out Boolean; - Perform_Actions : Boolean := True) + Perform_Actions : Boolean := True; + Create_Manifest : Boolean := False; + Include_Origin : Boolean := False) is - use Alire.OS_Lib.Operators; + use Alire.Directories; use all type Alire.Properties.Actions.Moments; Folder : constant Any_Path := Parent_Folder / This.Unique_Folder; - Result : Alire.Outcome; + + ------------------------------ + -- Backup_Upstream_Manifest -- + ------------------------------ + + procedure Backup_Upstream_Manifest is + Working_Dir : Guard (Enter (Folder)) with Unreferenced; + begin + Ada.Directories.Create_Path (Paths.Working_Folder_Inside_Root); + + if GNAT.OS_Lib.Is_Regular_File (Paths.Crate_File_Name) then + Trace.Debug ("Backing up bundled manifest file as *.upstream"); + declare + Upstream_File : constant String := + Paths.Working_Folder_Inside_Root + / (Paths.Crate_File_Name & ".upstream"); + begin + Alire.Directories.Backup_If_Existing + (Upstream_File, + Base_Dir => Paths.Working_Folder_Inside_Root); + Ada.Directories.Rename + (Old_Name => Paths.Crate_File_Name, + New_Name => Upstream_File); + end; + end if; + end Backup_Upstream_Manifest; + + ----------------------------------- + -- Create_Authoritative_Manifest -- + ----------------------------------- + + procedure Create_Authoritative_Manifest (Kind : Manifest.Sources) is + begin + Trace.Debug ("Generating manifest file for " + & This.Milestone.TTY_Image & " with" + & This.Dependencies.Leaf_Count'Img & " dependencies"); + + This.Whenever (Env).To_File (Folder / Paths.Crate_File_Name, + Kind); + end Create_Authoritative_Manifest; + begin -- Deploy if the target dir is not already there @@ -144,24 +196,31 @@ package body Alire.Releases is This.Milestone.Image); else Was_There := False; - Trace.Detail ("About to deploy " & This.Milestone.Image); - Result := Alire.Origins.Deployers.Deploy (This, Folder); - if not Result.Success then - Raise_Checked_Error (Message (Result)); - end if; + Put_Info ("Deploying release " & This.Milestone.TTY_Image & "..."); + Alire.Origins.Deployers.Deploy (This, Folder).Assert; -- For deployers that do nothing, we ensure the folder exists so all -- dependencies leave a trace in the cache/dependencies folder, and -- a place from where to run their actions by default. Ada.Directories.Create_Path (Folder); + + -- Backup a potentially packaged manifest, so our authoritative + -- manifest from the index is always used. + + Backup_Upstream_Manifest; + + if Create_Manifest then + Create_Authoritative_Manifest (if Include_Origin + then Manifest.Index + else Manifest.Local); + end if; end if; - -- Run actions on first retrieval + -- Run post-fetch actions on first retrieval if Perform_Actions and then not Was_There then declare - use Alire.Directories; Work_Dir : Guard (Enter (Folder)) with Unreferenced; begin Alire.Properties.Actions.Executor.Execute_Actions @@ -170,6 +229,20 @@ package body Alire.Releases is Moment => Post_Fetch); end; end if; + + exception + when E : others => + -- Clean up if deployment failed after the initial deployment (e.g. + -- during an action). + Log_Exception (E); + + if Ada.Directories.Exists (Folder) then + Trace.Debug ("Cleaning up failed release deployment of " + & This.Milestone.TTY_Image); + Directories.Force_Delete (Folder); + end if; + + raise; end Deploy; ---------------- @@ -185,17 +258,22 @@ package body Alire.Releases is end return; end Forbidding; - -------------- - -- Renaming -- - -------------- + --------------- + -- Providing -- + --------------- - function Renaming (Base : Release; - Provides : Crate_Name) return Release is + function Providing (Base : Release; + Targets : Containers.Crate_Name_Sets.Set) + return Release + is begin - return Renamed : Release := Base do - Renamed.Alias := +(+Provides); + return Result : Release := Base do + for Target of Targets loop + Result.Equivalences.Append + (Milestones.New_Milestone (Target, Base.Version)); + end loop; end return; - end Renaming; + end Providing; --------------- -- Replacing -- @@ -258,10 +336,10 @@ package body Alire.Releases is Name => Base.Name, Notes => New_Notes, - Alias => Base.Alias, Version => Base.Version, Origin => Base.Origin, Dependencies => Base.Dependencies, + Equivalences => Base.Equivalences, Pins => Base.Pins, Forbidden => Base.Forbidden, Properties => Base.Properties, @@ -312,11 +390,11 @@ package body Alire.Releases is is (Prj_Len => Name.Length, Notes_Len => Notes'Length, Name => Name, - Alias => +"", Version => Version, Origin => Origin, Notes => Notes, Dependencies => Dependencies, + Equivalences => <>, Pins => <>, Forbidden => Conditional.For_Dependencies.Empty, Properties => Properties, @@ -345,11 +423,11 @@ package body Alire.Releases is (Prj_Len => Name.Length, Notes_Len => 0, Name => Name, - Alias => +"", Version => +"0.0.0", Origin => Origin, Notes => "", Dependencies => Dependencies, + Equivalences => <>, Pins => <>, Forbidden => Conditional.For_Dependencies.Empty, Properties => Properties, @@ -596,8 +674,8 @@ package body Alire.Releases is -- MILESTONE Put_Line (R.Milestone.TTY_Image & ": " & R.TTY_Description); - if R.Provides /= R.Name then - Put_Line ("Provides: " & (+R.Provides)); + if not R.Equivalences.Is_Empty then + Put_Line ("Provides: " & R.Equivalences.Image_One_Line); end if; if R.Notes /= "" then @@ -759,6 +837,7 @@ package body Alire.Releases is From => From, Props => This.Properties, Deps => This.Dependencies, + Equiv => This.Equivalences, Pins => This.Pins, Avail => This.Available); @@ -825,9 +904,9 @@ package body Alire.Releases is -- Version Root.Set (TOML_Keys.Version, +Semver.Image (R.Version)); - -- Alias/Provides - if UStrings.Length (R.Alias) > 0 then - Root.Set (TOML_Keys.Provides, +(+R.Alias)); + -- Provided equivalences + if not R.Equivalences.Is_Empty then + Root.Set (TOML_Keys.Provides, R.Equivalences.To_TOML); end if; -- Notes @@ -934,11 +1013,11 @@ package body Alire.Releases is is (Prj_Len => R.Prj_Len, Notes_Len => R.Notes_Len, Name => R.Name, - Alias => R.Alias, Version => R.Version, - Origin => R.Origin, + Origin => R.Origin.Whenever (P), Notes => R.Notes, Dependencies => R.Dependencies.Evaluate (P), + Equivalences => R.Equivalences, Pins => R.Pins, Forbidden => R.Forbidden.Evaluate (P), Properties => R.Properties.Evaluate (P), @@ -961,4 +1040,49 @@ package body Alire.Releases is end if; end Long_Description; + -------------------- + -- Sort_Compilers -- + -------------------- + + function Sort_Compilers (L, R : Release) return Boolean is + + ----------------- + -- Is_External -- + ----------------- + + function Is_External (This : Release) return Boolean + is (This.Name = GNAT_External_Crate); + + --------------- + -- Is_Native -- + --------------- + + function Is_Native (This : Release) return Boolean is + use Utils; + begin + return Ends_With (This.Name.As_String, "_native"); + -- A lil' bit of magic to recognize the native compilers + end Is_Native; + + begin + + -- External is preferred to any other compiler. This can be overridden + -- by explicitly selecting a compiler with `alr toolchain --select`, or + -- by specifying a targeted gnat_xxx compiler. + + if Is_External (L) xor Is_External (R) then + return Is_External (R); + end if; + + -- Native goes next in preferences (preferred to cross-compilers) + + if Is_Native (L) xor Is_Native (R) then + return Is_Native (R); + end if; + + -- otherwise same ordering as regular crates + + return Standard_Sorting (L, R); + end Sort_Compilers; + end Alire.Releases; diff --git a/src/alire/alire-releases.ads b/src/alire/alire-releases.ads index 13088c9d..40134b89 100644 --- a/src/alire/alire-releases.ads +++ b/src/alire/alire-releases.ads @@ -2,6 +2,7 @@ with Ada.Containers.Indefinite_Ordered_Maps; with Ada.Tags; with Alire.Conditional; +with Alire.Containers; with Alire.Dependencies.Containers; with Alire.Interfaces; with Alire.Manifest; @@ -11,6 +12,7 @@ with Alire.Properties.Actions; with Alire.Properties.Environment; with Alire.Properties.Labeled; with Alire.Properties.Licenses; +with Alire.Provides; with Alire.TOML_Adapters; with Alire.TOML_Keys; with Alire.User_Pins.Maps; @@ -25,11 +27,10 @@ private with Alire.Utils.TTY; package Alire.Releases is --- subtype Dependency_Vector is Dependencies.Vectors.Vector; - type Release (<>) is new Interfaces.Yamlable with private; function "<" (L, R : Release) return Boolean; + -- Sorts by name, version, and build within same version function Default_Properties return Conditional.Properties; -- Returns the values in Defaults already wrapped as properties @@ -61,12 +62,6 @@ package Alire.Releases is -- For working releases that may have incomplete information. Note that the -- default properties are used by default. - function Renaming (Base : Release; - Provides : Crate_Name) return Release; - -- Fills-in the "provides" field - -- During resolution, a release that has a renaming will act as the - -- "Provides" release, so both releases cannot be selected simultaneously. - function Replacing (Base : Release; Notes : Description_String := "") return Release; @@ -99,6 +94,12 @@ package Alire.Releases is return Release; -- Add forbidden dependencies to a release + function Providing (Base : Release; + Targets : Containers.Crate_Name_Sets.Set) + return Release; + -- Add an equivalence to Target=Base.Version for all Target of Targets + -- (which may be empty). + function Whenever (R : Release; P : Properties.Vector) return Release; -- Materialize conditions in a Release once the whatever properties are -- known. At present dependencies, properties, and availability. @@ -120,10 +121,6 @@ package Alire.Releases is -- Returns the long description for the crate, which is also stored as a -- property of the release. - function Provides (R : Release) return Crate_Name; - -- The actual name to be used during dependency resolution (but nowhere - -- else). - function Forbidden (R : Release) return Conditional.Dependencies; -- Get all forbidden dependencies in platform-independen fashion @@ -169,6 +166,15 @@ package Alire.Releases is -- matter how they will be solved. If P is not empty, this function -- also works for platform-dependent dependencies only. + function Provides (R : Release) return Provides.Equivalences; + + function Provides (R : Release; Target : Crate_Name) return Boolean; + -- Say if one of this release Provides milestones is for Target, in + -- addition to R.Name = Target. + + function Provides (R : Release; Target : Release) return Boolean; + -- Check whether R and Target have the same name or provide the same name + function Property (R : Release; Key : Alire.Properties.Labeled.Labels) return String; @@ -278,7 +284,7 @@ package Alire.Releases is -- True if some property contains the given string function Satisfies (R : Release; - Dep : Alire.Dependencies.Dependency) + Dep : Alire.Dependencies.Dependency'Class) return Boolean; -- Ascertain if this release is a valid candidate for Dep @@ -329,8 +335,13 @@ package Alire.Releases is Env : Alire.Properties.Vector; Parent_Folder : String; Was_There : out Boolean; - Perform_Actions : Boolean := True); - -- Deploy the sources of this release under the given Parent_Folder + Perform_Actions : Boolean := True; + Create_Manifest : Boolean := False; + Include_Origin : Boolean := False); + -- Deploy the sources of this release under the given Parent_Folder. If + -- Create_Manifest, any packaged manifest will be moved out of the way + -- and an autoritative manifest will be generated from index information. + -- The created manifest may optionally Include_Origin information. private @@ -349,10 +360,10 @@ private is new Interfaces.Yamlable with record Name : Crate_Name (Prj_Len); - Alias : UString; -- I finally gave up on constraints Version : Semantic_Versioning.Version; Origin : Origins.Origin; Notes : Description_String (1 .. Notes_Len); + Equivalences : Alire.Provides.Equivalences; Dependencies : Conditional.Dependencies; Pins : User_Pins.Maps.Map; Forbidden : Conditional.Dependencies; @@ -372,8 +383,12 @@ private use all type Conditional.Properties; - function "<" (L, R : Release) return Boolean - is (L.Name < R.Name + function Sort_Compilers (L, R : Release) return Boolean; + -- For the special case of crates providing a compiler, we prefer the + -- native compilers before the cross-compilers. + + function Standard_Sorting (L, R : Release) return Boolean + is (R.Name < L.Name -- So when going from newest to oldest the order is OK or else (L.Name = R.Name and then L.Version < R.Version) or else @@ -381,9 +396,7 @@ private and then L.Version = R.Version and then - Build (L.Version) < Build (R.Version) - ) - ); + Build (L.Version) < Build (R.Version))); function Name (R : Release) return Crate_Name is (R.Name); @@ -391,11 +404,6 @@ private function TTY_Name (R : Release) return String is (Utils.TTY.Name (+R.Name)); - function Provides (R : Release) return Crate_Name - is (if UStrings.Length (R.Alias) = 0 - then R.Name - else +(+R.Alias)); - function Notes (R : Release) return Description_String is (R.Notes); @@ -407,6 +415,27 @@ private return Conditional.Dependencies is (R.Dependencies.Evaluate (P)); + function Provides (R : Release) return Alire.Provides.Equivalences + is (R.Equivalences); + + function Provides (R : Release; Target : Crate_Name) return Boolean + is (R.Name = Target + or else + (for some Mil of R.Equivalences => Mil.Crate = Target)); + + function Provides (R : Release; Target : Release) return Boolean + is (R.Provides (Target.Name) + or else + Target.Provides (R.Name) + or else + (for some Mil_1 of R.Equivalences => + Mil_1.Crate = Target.Name + or else + (for some Mil_2 of Target.Equivalences => + Mil_2.Crate = R.Name + or else + Mil_1.Crate = Mil_2.Crate))); + function Forbidden (R : Release) return Conditional.Dependencies is (R.Forbidden); @@ -426,7 +455,8 @@ private function Is_Available (R : Release; P : Alire.Properties.Vector) return Boolean - is (R.Available.Is_Available (P)); + is (R.Available.Is_Available (P) + and then R.Origin.Is_Available (P)); function Description (R : Release) return Description_String -- Image returns "Description: Blah" so we have to cut. @@ -477,6 +507,7 @@ private Utils.Head (Utils.Head (Image (R.Version), '-'), '+') & "_" & -- Remove patch/build strings that may violate folder valid chars (case R.Origin.Kind is + when Binary_Archive => R.Origin.Short_Unique_Id, when External => "external", when Filesystem => "filesystem", when System => "system", @@ -485,9 +516,11 @@ private when SVN => R.Origin.Commit)); function Satisfies (R : Release; - Dep : Alire.Dependencies.Dependency) + Dep : Alire.Dependencies.Dependency'Class) return Boolean - is (R.Name = Dep.Crate and then Dep.Versions.Contains (R.Version)); + is ((R.Name = Dep.Crate and then Dep.Versions.Contains (R.Version)) + or else + R.Equivalences.Satisfies (Dep)); function Version_Image (R : Release) return String is (Semantic_Versioning.Image (R.Version)); diff --git a/src/alire/alire-root.adb b/src/alire/alire-root.adb index 94388a74..116f9a40 100644 --- a/src/alire/alire-root.adb +++ b/src/alire/alire-root.adb @@ -1,4 +1,5 @@ with Alire.Directories; +with Alire.Properties.Platform; package body Alire.Root is @@ -21,10 +22,22 @@ package body Alire.Root is ------------------------- Environment : Properties.Vector; + OS : Platforms.Operating_Systems := Platforms.OS_Unknown; + + ------------------------- + -- Platform_Properties -- + ------------------------- function Platform_Properties return Properties.Vector is (Environment); + ----------------- + -- Platform_OS -- + ----------------- + + function Platform_OS return Platforms.Operating_Systems + is (OS); + ----------------------------- -- Set_Platform_Properties -- ----------------------------- @@ -32,6 +45,15 @@ package body Alire.Root is procedure Set_Platform_Properties (Env : Properties.Vector) is begin Environment := Env; + + -- Extract the current OS for easier use + + for Prop of Env loop + if Prop in Properties.Platform.Operating_Systems.Property'Class then + OS := Properties.Platform.Operating_Systems.Property'Class (Prop) + .Element; + end if; + end loop; end Set_Platform_Properties; end Alire.Root; diff --git a/src/alire/alire-root.ads b/src/alire/alire-root.ads index 60718ac8..0e645054 100644 --- a/src/alire/alire-root.ads +++ b/src/alire/alire-root.ads @@ -1,3 +1,4 @@ +with Alire.Platforms; with Alire.Properties; with Alire.Roots.Optional; @@ -20,4 +21,7 @@ package Alire.Root is -- Alire, this is a stopgag measure to be able to encapsulate properties in -- the Current Root. TODO: remove during the refactor. + function Platform_OS return Platforms.Operating_Systems; + -- TODO: remove during the same refactor as above + end Alire.Root; diff --git a/src/alire/alire-roots-editable.adb b/src/alire/alire-roots-editable.adb index a95b5548..78da98bd 100644 --- a/src/alire/alire-roots-editable.adb +++ b/src/alire/alire-roots-editable.adb @@ -112,7 +112,7 @@ package body Alire.Roots.Editable is end if; exception - when Solver.No_Solution_Error => + when Query_Unsuccessful => Put_Warning ("No solution found when adding dependency: " & Dep.TTY_Image); return Dep; @@ -473,4 +473,13 @@ package body Alire.Roots.Editable is Log_Exception (E, Warning); end Finalize; + --------- + -- Set -- + --------- + + procedure Set (This : in out Root; Solution : Solutions.Solution) is + begin + This.Edit.Set (Solution); + end Set; + end Alire.Roots.Editable; diff --git a/src/alire/alire-roots-editable.ads b/src/alire/alire-roots-editable.ads index 9f9ff67b..2783cfbc 100644 --- a/src/alire/alire-roots-editable.ads +++ b/src/alire/alire-roots-editable.ads @@ -31,10 +31,20 @@ package Alire.Roots.Editable is function Old (This : Root) return Roots.Root; -- The original root this editable copy was made from + type Reference (Element : not null access Roots.Root) + is limited null record with Implicit_Dereference => Element; + + function Current (This : in out Root) return Reference; + -- Retrieve the temporary copy. This is read/write because the caching of + -- solutions requires it, but it is intended for read-only use. + function Name (This : Root) return Crate_Name; function Solution (This : in out Root) return Solutions.Solution; + procedure Set (This : in out Root; Solution : Solutions.Solution); + -- Bulk replace the solution in the temporary copy + -- Edition procedures procedure Reload_Manifest (This : in out Root); @@ -109,11 +119,21 @@ private type Root is new Ada.Finalization.Limited_Controlled with record Orig : Roots.Root; - Edit : Roots.Root; + Edit : aliased Roots.Root; end record; overriding procedure Finalize (This : in out Root); + ------------- + -- Current -- + ------------- + + function Current (This : in out Root) return Reference + is (Element => This.Edit'Unrestricted_Access); + -- CE2021 is happy with 'Access but 9.3 complains about a dangling pointer. + -- We are returning a short-lived pointer to a limited value so I don't see + -- the problem. + ---------- -- Name -- ---------- diff --git a/src/alire/alire-roots-optional.adb b/src/alire/alire-roots-optional.adb index 77231bb4..831a6b15 100644 --- a/src/alire/alire-roots-optional.adb +++ b/src/alire/alire-roots-optional.adb @@ -91,7 +91,7 @@ package body Alire.Roots.Optional is function Search_Root (From : Any_Path) return Optional.Root is (Detect_Root (Directories.Detect_Root_Path - (Ada.Directories.Full_Name (From)))); + (Ada.Directories.Full_Name (From)))); --------------- -- Is_Broken -- diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 918b90fb..a05f84f5 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -1,12 +1,13 @@ with Alire.Conditional; with Alire.Crate_Configuration; with Alire.Dependencies.Containers; -with Alire.Dependencies; with Alire.Directories; with Alire.Environment; with Alire.Manifest; +with Alire.Origins; with Alire.OS_Lib; with Alire.Roots.Optional; +with Alire.Shared; with Alire.Solutions.Diffs; with Alire.User_Pins.Maps; with Alire.Utils.TTY; @@ -108,33 +109,8 @@ package body Alire.Roots is (Env => Env, Parent_Folder => Parent_Folder, Was_There => Was_There, - Perform_Actions => Perform_Actions); - - -- Backup a potentially packaged manifest, so our authoritative manifest - -- from the index is always used. - - declare - Working_Dir : Guard (Enter (This.Unique_Folder)) - with Unreferenced; - begin - Ada.Directories.Create_Path (Paths.Working_Folder_Inside_Root); - - if GNAT.OS_Lib.Is_Regular_File (Paths.Crate_File_Name) then - Trace.Debug ("Backing up bundled manifest file as *.upstream"); - declare - Upstream_File : constant String := - Paths.Working_Folder_Inside_Root / - (Paths.Crate_File_Name & ".upstream"); - begin - Alire.Directories.Backup_If_Existing - (Upstream_File, - Base_Dir => Paths.Working_Folder_Inside_Root); - Ada.Directories.Rename - (Old_Name => Paths.Crate_File_Name, - New_Name => Upstream_File); - end; - end if; - end; + Perform_Actions => Perform_Actions, + Create_Manifest => True); -- And generate its working files, if they do not exist @@ -150,14 +126,9 @@ package body Alire.Roots is Ada.Directories.Create_Path (Root.Working_Folder); - -- Generate the authoritative manifest from index information for - -- eventual use of the gotten crate as a local workspace. - - Root.Write_Manifest; - - -- Create also a preliminary lockfile (since dependencies are - -- still unretrieved). Once they are checked out, the lockfile - -- will be replaced with the complete solution. + -- Create a preliminary lockfile (since dependencies are still + -- unretrieved). Once they are checked out, the lockfile will + -- be replaced with the complete solution. Root.Set (Solution => (if This.Dependencies (Env).Is_Empty @@ -188,11 +159,21 @@ package body Alire.Roots is -- Mark any dependencies without a corresponding regular release as -- already deployed (in practice, we don't have to deploy them, and - -- dependents don't need to wait for their deployment). + -- dependents don't need to wait for their deployment). Likewhise for + -- installed dependencies, which are already deployed. for Dep of This.Solution.Required loop - if not Dep.Has_Release then + if not Dep.Has_Release or else Dep.Is_Shared then Deployed.Include (Dep.Crate); + + -- Also mark as deployed any crate provided by shared releases + + if Dep.Has_Release then + for Mil of Dep.Release.Provides loop + Deployed.Include (Mil.Crate); + end loop; + end if; + end if; end loop; @@ -202,7 +183,7 @@ package body Alire.Roots is Round := Round + 1; declare - To_Remove : Alire.Containers.Release_Set; + To_Remove : Alire.Releases.Containers.Release_Set; function Enum (Deps : Conditional.Dependencies) return Alire.Dependencies.Containers.List renames Conditional.Enumerate; @@ -216,7 +197,7 @@ package body Alire.Roots is -- don't have undeployed dependencies. We also identify -- releases that need not to be deployed (e.g. linked ones). - if not This.Solution.State (Rel.Name).Is_Solved then + if not This.Solution.State (Rel).Is_Solved then Trace.Debug ("Round" & Round'Img & ": NOOP " & Rel.Milestone.Image); @@ -235,10 +216,37 @@ package body Alire.Roots is To_Remove.Include (Rel); - if Rel.Name /= Release (This).Name then - Rel.Deploy (Env => This.Environment, - Parent_Folder => This.Dependencies_Dir, - Was_There => Was_There); + if not Release (This).Provides (Rel.Name) then + + -- A regular release is deployed normally. A binary + -- release is installed as a shared dependency. A + -- detected external is skipped. + + if Rel.Origin.Kind in Origins.Binary_Archive then + + Shared.Share (Rel); + + elsif This.Solution.State (Rel.Name).Is_Shared + and then Rel.Origin.Kind in Origins.External + then + + Trace.Debug ("No-op deployment of shared external: " + & Rel.Milestone.TTY_Image); + + else + + Rel.Deploy (Env => This.Environment, + Parent_Folder => + Ada.Directories.Containing_Directory + (This.Release_Base (Rel.Name)), + Was_There => Was_There, + Create_Manifest => + This.Solution.State (Rel.Name).Is_Shared, + Include_Origin => + This.Solution.State (Rel.Name).Is_Shared); + + end if; + else Trace.Debug ("Skipping checkout of root crate as dependency"); @@ -254,8 +262,15 @@ package body Alire.Roots is with "No release checked out in round" & Round'Img; else for Rel of To_Remove loop - Pending.Exclude (Rel.Name); + Pending.Remove (Rel); + + Trace.Debug ("Marking deployed: " & Rel.Name.As_String); Deployed.Include (Rel.Name); + for Mil of Rel.Provides loop + Trace.Debug ("Marking deployed (provided): " + & Mil.Crate.As_String); + Deployed.Include (Mil.Crate); + end loop; end loop; end if; end; @@ -639,7 +654,7 @@ package body Alire.Roots is (Ada.Finalization.Controlled with Environment => Env, Path => +Path, - Release => Containers.To_Release_H (R), + Release => Releases.Containers.To_Release_H (R), Cached_Solution => <>, Pins => <>, Lockfile => <>, @@ -685,12 +700,21 @@ package body Alire.Roots is Crate : Crate_Name) return Any_Path is - Deps_Dir : constant Any_Path := This.Dependencies_Dir; begin if This.Release.Element.Name = Crate then return +This.Path; elsif This.Solution.State (Crate).Is_Solved then - return Deps_Dir / Release (This, Crate).Unique_Folder; + declare + Rel : constant Releases.Release := Release (This, Crate); + begin + if This.Solution.State (Crate).Is_Shared then + return Shared.Install_Path / Rel.Unique_Folder; + else + return This.Cache_Dir + / Paths.Deps_Folder_Inside_Cache_Folder + / Rel.Unique_Folder; + end if; + end; elsif This.Solution.State (Crate).Is_Linked then return This.Solution.State (Crate).Link.Path; else @@ -723,13 +747,6 @@ package body Alire.Roots is function Cache_Dir (This : Root) return Absolute_Path is (This.Working_Folder / Paths.Cache_Folder_Inside_Working_Folder); - ---------------------- - -- Dependencies_Dir -- - ---------------------- - - function Dependencies_Dir (This : Root) return Absolute_Path is - (This.Cache_Dir / "dependencies"); - -------------- -- Pins_Dir -- -------------- @@ -744,6 +761,26 @@ package body Alire.Roots is function Working_Folder (This : Root) return Absolute_Path is ((+This.Path) / "alire"); + -------------------- + -- Write_Manifest -- + -------------------- + + procedure Write_Manifest (This : Root) is + Release : constant Releases.Release := Roots.Release (This); + begin + Trace.Debug + ("Generating manifest file for " + & Release.Milestone.TTY_Image & " with" + & Release.Dependencies.Leaf_Count'Img & " dependencies"); + + Directories.Backup_If_Existing (File => This.Crate_File, + Base_Dir => This.Working_Folder); + + Release.Whenever (This.Environment) + .To_File (Filename => This.Crate_File, + Format => Manifest.Local); + end Write_Manifest; + -------------------- -- Write_Solution -- -------------------- @@ -1017,25 +1054,6 @@ package body Alire.Roots is end; end Sync_Dependencies; - -------------------- - -- Write_Manifest -- - -------------------- - - procedure Write_Manifest (This : Root) is - Release : constant Releases.Release := Roots.Release (This); - begin - Trace.Debug ("Generating " & Release.Name_Str & ".toml file for " - & Release.Milestone.Image & " with" - & Release.Dependencies.Leaf_Count'Img & " dependencies"); - - Directories.Backup_If_Existing - (This.Crate_File, - Base_Dir => Paths.Working_Folder_Inside_Root); - - Release.Whenever (This.Environment) - .To_File (This.Crate_File, Manifest.Local); - end Write_Manifest; - -------------------- -- Temporary_Copy -- -------------------- @@ -1099,7 +1117,7 @@ package body Alire.Roots is begin -- Load our manifest - This.Release.Replace_Element + This.Release.Hold (Releases.From_Manifest (This.Crate_File, Manifest.Local, diff --git a/src/alire/alire-roots.ads b/src/alire/alire-roots.ads index 46f880ad..6831384f 100644 --- a/src/alire/alire-roots.ads +++ b/src/alire/alire-roots.ads @@ -7,7 +7,7 @@ limited with Alire.Environment; private with Alire.Lockfiles; with Alire.Paths; with Alire.Properties; -with Alire.Releases; +with Alire.Releases.Containers; with Alire.Solutions; with Alire.Solver; with Alire.Utils; @@ -207,9 +207,6 @@ package Alire.Roots is function Crate_File (This : Root) return Absolute_Path; -- The "/path/to/alire.toml" file inside Working_Folder - function Dependencies_Dir (This : Root) return Absolute_Path; - -- The folder where dependencies are checked out for this root - function Pins_Dir (This : Root) return Absolute_Path; -- The folder where remote pins are checked out for this root @@ -233,7 +230,7 @@ private type Root is new Ada.Finalization.Controlled with record Environment : Properties.Vector; Path : UString; - Release : Containers.Release_H; + Release : Releases.Containers.Release_H; Cached_Solution : Cached_Solutions.Cache; Pins : Solutions.Solution; diff --git a/src/alire/alire-shared.adb b/src/alire/alire-shared.adb new file mode 100644 index 00000000..f422174b --- /dev/null +++ b/src/alire/alire-shared.adb @@ -0,0 +1,279 @@ +with Ada.Directories; + +with Alire.Config.Edit; +with Alire.Containers; +with Alire.Directories; +with Alire.Index; +with Alire.Manifest; +with Alire.Origins; +with Alire.Paths; +with Alire.Properties.Actions; +with Alire.Root; +with Alire.Toolchains.Solutions; +with Alire.TTY; +with Alire.Warnings; + +with SI_Units.Binary; + +package body Alire.Shared is + + use Directories.Operators; + + use type Milestones.Milestone; + + --------------- + -- Available -- + --------------- + + function Available return Releases.Containers.Release_Set is + + Result : Releases.Containers.Release_Set; + + ------------ + -- Detect -- + ------------ + + procedure Detect (Item : Ada.Directories.Directory_Entry_Type; + Stop : in out Boolean) + is + use Ada.Directories; + begin + Stop := False; + if Kind (Item) = Directory then + if Exists (Full_Name (Item) / Paths.Crate_File_Name) then + Trace.Debug ("Detected shared release at " + & TTY.URL (Full_Name (Item))); + + Result.Include + (Releases.From_Manifest + (File_Name => Full_Name (Item) / Paths.Crate_File_Name, + Source => Manifest.Index, + Strict => True)); + else + Warnings.Warn_Once ("Unexpected folder in shared crates path: " + & TTY.URL (Full_Name (Item))); + end if; + + else + Warnings.Warn_Once ("Unexpected file in shared crates path: " + & TTY.URL (Full_Name (Item))); + end if; + end Detect; + + begin + if Ada.Directories.Exists (Install_Path) then + Directories.Traverse_Tree + (Start => Install_Path, + Doing => Detect'Access); + end if; + + -- Include external toolchain members + + Index.Detect_Externals (GNAT_External_Crate, + Root.Platform_Properties); + + for Tool of Toolchains.Tools loop + Index.Detect_Externals (Tool, Root.Platform_Properties); + + for Release of Index.Releases_Satisfying (Toolchains.Any_Tool (Tool), + Root.Platform_Properties) + loop + if not Release.Origin.Is_Regular then + Result.Include (Release); + end if; + end loop; + end loop; + + return Result; + end Available; + + ------------------ + -- Install_Path -- + ------------------ + + function Install_Path return String + is (Config.Edit.Path + / Paths.Cache_Folder_Inside_Working_Folder + / Paths.Deps_Folder_Inside_Cache_Folder); + + ----------- + -- Share -- + ----------- + + procedure Share (Release : Releases.Release) + is + Already_Installed : Boolean := False; + + -------------------- + -- Is_Installable -- + -------------------- + + function Is_Installable return Boolean is + + -- We can install only regular releases. Also, releases that do not + -- have post-fetch actions (as they might involve using dependencies) + -- and dependencies simultaneously. I.e., post-fetch without + -- dependencies is OK, as it is having dependencies and no + -- post-fetch. Since "make" can be a pretty common single dependency + -- that does not cause problems, we make an exception for it. + + use Containers.Crate_Name_Sets; + Allowed_Dependencies : constant Set := To_Set (To_Name ("make")); + + begin + if Release.Dependencies.Is_Empty or else + (for all Dep of Release.Flat_Dependencies (Root.Platform_Properties) + => Allowed_Dependencies.Contains (Dep.Crate)) + then + return True; + end if; + + if Release.On_Platform_Actions + (Root.Platform_Properties, + (Properties.Actions.Post_Fetch => True, + others => False)).Is_Empty + then + return True; + end if; + + return False; + end Is_Installable; + + begin + + -- See if it is a valid installable origin + + if Release.Origin.Kind in Origins.External_Kinds then + Raise_Checked_Error + ("Only regular releases can be installed, but the requested release" + & " has origin of kind " & Release.Origin.Kind'Image); + end if; + + if not Is_Installable then + Recoverable_Error + ("Releases with both dependencies and post-fetch actions are not " + & " yet supported. (Use `" + & TTY.Terminal ("alr show ") & "` to examine " + & "release properties.)"); + end if; + + -- See if it can be skipped + + if Available.Contains (Release) then + Trace.Detail ("Skipping installation of already available release: " + & Release.Milestone.TTY_Image); + return; + end if; + + -- Deploy at the install location + + Release.Deploy (Env => Root.Platform_Properties, + Parent_Folder => Install_Path, + Was_There => Already_Installed, + Perform_Actions => True, + Create_Manifest => True, + Include_Origin => True); + -- We need the origin to be included for the release to be recognized as + -- a binary-origin release. + + if Already_Installed then + Trace.Warning + ("Reused previous installation for existing release: " + & Release.Milestone.TTY_Image); + end if; + + Put_Info (Release.Milestone.TTY_Image & " installed successfully."); + end Share; + + ------------ + -- Remove -- + ------------ + + procedure Remove + (Release : Releases.Release; + Confirm : Boolean := not Utils.User_Input.Not_Interactive) + is + type Modular_File_Size is mod 2 ** Ada.Directories.File_Size'Size; + + function Image is new SI_Units.Binary.Image + (Item => Modular_File_Size, + Default_Aft => 1, + Unit => "B"); + + use Utils.User_Input; + Path : constant Absolute_Path := Install_Path / Release.Unique_Folder; + begin + if not Release.Origin.Is_Regular then + Raise_Checked_Error + ("Only regular releases deployed through Alire can be removed."); + end if; + + if not Ada.Directories.Exists (Path) then + Raise_Checked_Error + ("Directory slated for removal does not exist: " & TTY.URL (Path)); + end if; + + if Toolchains.Solutions.Is_In_Toolchain (Release) then + Recoverable_Error ("The release to be removed (" + & Release.Milestone.TTY_Image & ") is part of the " + & "configured default toolchain."); + + -- If forced: + Put_Warning ("Removing it anyway; it will be also removed from the " + & "default toolchain."); + + -- So remove it + Toolchains.Unconfigure (Release.Name); + end if; + + if not Confirm or else Utils.User_Input.Query + (Question => "Release " & Release.Milestone.TTY_Image & " is going to " + & "be removed, freeing " + & TTY.Emph (Image (Modular_File_Size (Directories.Tree_Size (Path)))) + & ". Do you want to proceed?", + Valid => (No | Yes => True, others => False), + Default => Yes) = Yes + then + Directories.Force_Delete (Path); + Put_Success + ("Release " & Release.Milestone.TTY_Image + & " removed successfully"); + end if; + end Remove; + + ------------ + -- Remove -- + ------------ + + procedure Remove + (Target : Milestones.Milestone; + Confirm : Boolean := not Utils.User_Input.Not_Interactive) + is + begin + for Release of Available loop + if Release.Milestone = Target then + Remove (Release, Confirm); + return; + end if; + end loop; + + Raise_Checked_Error + ("Requested release is not installed: " & Target.TTY_Image); + end Remove; + + ------------- + -- Release -- + ------------- + + function Release (Target : Milestones.Milestone) return Releases.Release is + begin + for Release of Available loop + if Release.Milestone = Target then + return Release; + end if; + end loop; + + raise Constraint_Error with "Not installed: " & Target.TTY_Image; + end Release; + +end Alire.Shared; diff --git a/src/alire/alire-shared.ads b/src/alire/alire-shared.ads new file mode 100644 index 00000000..b9c7a0b3 --- /dev/null +++ b/src/alire/alire-shared.ads @@ -0,0 +1,38 @@ +with Alire.Errors; +with Alire.Milestones; +with Alire.Releases.Containers; +with Alire.Utils.User_Input; + +package Alire.Shared is + + -- Stuff about shared/binary crates that are deployed not in the local + -- workspace but in the shared configuration folder. + + function Available return Releases.Containers.Release_Set; + -- Returns the releases installed at the shared location + + function Release (Target : Milestones.Milestone) return Releases.Release; + -- Retrieve the release corresponding to Target, if it exists. Will raise + -- Constraint_Error if not among Available. + + function Install_Path return Any_Path; + -- Returns the base folder in which all shared releases live + + procedure Share (Release : Releases.Release); + -- Deploy a release in the shared location for the configuration + + procedure Remove + (Release : Releases.Release; + Confirm : Boolean := not Utils.User_Input.Not_Interactive) + with Pre => Available.Contains (Release) + or else raise Checked_Error with + Errors.Set ("Requested release is not installed: " + & Release.Milestone.TTY_Image); + -- Remove a release from the shared location for the configuration + + procedure Remove + (Target : Milestones.Milestone; + Confirm : Boolean := not Utils.User_Input.Not_Interactive); + -- Behaves as the previous Remove + +end Alire.Shared; diff --git a/src/alire/alire-solutions-diffs.adb b/src/alire/alire-solutions-diffs.adb index 7db348c9..e607ecb3 100644 --- a/src/alire/alire-solutions-diffs.adb +++ b/src/alire/alire-solutions-diffs.adb @@ -21,7 +21,8 @@ package body Alire.Solutions.Diffs is Pinned, -- A release being pinned Unpinned, -- A release being unpinned Unchanged, -- An unchanged dependency/release - Missing -- A missing dependency + Missing, -- A missing dependency + Shared -- A release used from the shared installed releases ); ---------- @@ -39,18 +40,21 @@ package body Alire.Solutions.Diffs is when Pinned => TTY.OK ("⊙"), when Unpinned => TTY.Emph ("𐩒"), when Unchanged => TTY.OK ("="), - when Missing => TTY.Error ("⚠")) + when Missing => TTY.Error ("⚠"), + when Shared => TTY.Emph ("♼")) else (case Change is - when Added => "+", - when Removed => "-", - when Hinted => "~", - when Upgraded => "^", - when Downgraded => "v", - when Pinned => "·", - when Unpinned => "o", - when Unchanged => "=", - when Missing => "!")); + when Added => "+", + when Removed => "-", + when Hinted => "~", + when Upgraded => "^", + when Downgraded => "v", + when Pinned => "·", + when Unpinned => "o", + when Unchanged => "=", + when Missing => "!", + when Shared => "i" + )); -- This type is used to summarize every detected change type Crate_Changes is record @@ -169,6 +173,25 @@ package body Alire.Solutions.Diffs is end if; end Fulfil_Change; + -------------------- + -- Sharing_Change -- + -------------------- + + procedure Sharing_Change is + begin + if (not Has_Former or else not Former.Is_Shared) + and then Has_Latter and then Latter.Is_Shared + then + Add_Change (Chg, Icon (Shared), TTY.Emph ("installed")); + + elsif Has_Former and then Former.Is_Shared + and then Has_Latter and then not Latter.Is_Shared + then + Add_Change (Chg, "", TTY.Emph ("local")); + + end if; + end Sharing_Change; + -------------------------- -- transitivity_changed -- -------------------------- @@ -220,6 +243,17 @@ package body Alire.Solutions.Diffs is end if; end Pinned_Or_Unpinned; + --------------------- + -- Provider_Change -- + --------------------- + + procedure Provider_Change is + begin + if Has_Latter and then Latter.Is_Provided then + Add_Change (Chg, "", TTY.Italic (Latter.Release.Name.As_String)); + end if; + end Provider_Change; + --------------------- -- Up_Or_Downgrade -- --------------------- @@ -296,6 +330,10 @@ package body Alire.Solutions.Diffs is Fulfil_Change; + Sharing_Change; + + Provider_Change; + Transitivity_Changed; Up_Or_Downgrade; diff --git a/src/alire/alire-solutions.adb b/src/alire/alire-solutions.adb index 47aa45b7..f82ed3b0 100644 --- a/src/alire/alire-solutions.adb +++ b/src/alire/alire-solutions.adb @@ -2,10 +2,11 @@ with Ada.Containers; with Alire.Config; with Alire.Crates; -with Alire.Dependencies.Containers; with Alire.Dependencies.Diffs; with Alire.Dependencies.Graphs; +with Alire.Errors; with Alire.Index; +with Alire.Milestones; with Alire.Root; with Alire.Solutions.Diffs; with Alire.Utils.Tables; @@ -22,6 +23,284 @@ package body Alire.Solutions is use type Ada.Containers.Count_Type; use type Semantic_Versioning.Version; + ---------------------- + -- All_Dependencies -- + ---------------------- + + function All_Dependencies (This : Solution) return State_Map + is (This.Dependencies); + + ----------------- + -- Composition -- + ----------------- + + function Composition (This : Solution) return Compositions + is (if not This.Solved then + Unsolved + elsif This.Dependencies.Is_Empty then + Empty + elsif (for all Dep of This.Dependencies => + Dep.Is_Solved or else Dep.Is_Linked) + then + Releases + elsif (for all Dep of This.Dependencies => Dep.Is_Hinted) then + Hints + elsif (for some Dep of This.Dependencies => Dep.Is_Missing) then + Partial + else + Mixed); + + ---------------------- + -- Contains_Release -- + ---------------------- + + function Contains_Release (This : Solution; + Crate : Crate_Name) return Boolean + is (This.Depends_On (Crate) and then This.State (Crate).Is_Solved); + + ---------------- + -- Dependency -- + ---------------- + + function Dependency (This : Solution; + Crate : Crate_Name) + return Alire.Dependencies.Dependency + is (This.Dependencies (Crate).As_Dependency); + + ------------------ + -- Depending_On -- + ------------------ + + function Depending_On (This : Solution; + Dep : Dependencies.Dependency) + return Solution + is (Solution'(Solved => True, + Dependencies => This.Dependencies.Merging (Dep))); + + ---------------- + -- Depends_On -- + ---------------- + + function Depends_On (This : Solution; + Name : Crate_Name) return Boolean + is (This.Dependencies.Contains (Name) + or else + (for some Dep of This.Dependencies => + Dep.Has_Release and then Dep.Release.Provides (Name))); + + ---------------- + -- Depends_On -- + ---------------- + + function Depends_On (This : Solution; + Release : Alire.Releases.Release) return Boolean + is (for some Dep of This.Dependencies => Release.Provides (Dep.Crate)); + + ------------------------------ + -- Depends_On_Specific_GNAT -- + ------------------------------ + + function Depends_On_Specific_GNAT (This : Solution) return Boolean + is (This.Releases.Contains_Or_Provides (GNAT_Crate) and then + This.Releases.Element_Providing (GNAT_Crate).Name /= GNAT_Crate); + + ---------------------------- + -- Empty_Invalid_Solution -- + ---------------------------- + + function Empty_Invalid_Solution return Solution + is (Solved => False, + others => <>); + + -------------------------- + -- Empty_Valid_Solution -- + -------------------------- + + function Empty_Valid_Solution return Solution + is (Solved => True, + others => <>); + + ------------- + -- Hinting -- + ------------- + + function Hinting (This : Solution; + Dep : Dependencies.Dependency) + return Solution + is (if This.Depends_On (Dep.Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including (This.State (Dep.Crate).Hinting)) + else (Solved => True, + Dependencies => + This.Dependencies.Including (States.New_State (Dep).Hinting))); + + ----------- + -- Hints -- + ----------- + + function Hints (This : Solution) return Dependency_Map + is (This.Dependencies_That (States.Is_Hinted'Access)); + + ------------------ + -- Is_Attempted -- + ------------------ + + function Is_Attempted (This : Solution) return Boolean + is (This.Composition /= Unsolved); + + ----------------- + -- Is_Complete -- + ----------------- + + function Is_Complete (This : Solution) return Boolean + is (This.Composition <= Releases); + + ----------- + -- Links -- + ----------- + + function Links (This : Solution) return Dependency_Map + is (This.Dependencies_That (States.Is_Linked'Access)); + + ------------ + -- Misses -- + ------------ + + function Misses (This : Solution) return Dependency_Map + is (This.Dependencies_That (States.Is_Missing'Access)); + + ------------- + -- Missing -- + ------------- + + function Missing (This : Solution; + Dep : Dependencies.Dependency) + return Solution + is (if This.Depends_On (Dep.Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including (This.State (Dep.Crate).Missing)) + else (Solved => True, + Dependencies => + This.Dependencies.Including (States.New_State (Dep).Missing))); + + ------------- + -- Missing -- + ------------- + + function Missing (This : Solution; + Crate : Crate_Name) + return Solution + is (if This.Dependencies.Contains (Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Missing)) + else This); + + ------------- + -- Pinning -- + ------------- + + function Pinning (This : Solution; + Crate : Crate_Name; + Version : Semantic_Versioning.Version) + return Solution + is (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Pinning (Version))); + + -------------- + -- Provides -- + -------------- + + function Provides (This : Solution; + Release : Alire.Releases.Release) + return Boolean + is (for some Solved of This.Releases => Solved.Provides (Release)); + + -------------- + -- Required -- + -------------- + + function Required (This : Solution) return State_Map'Class + is (This.Dependencies); + + --------------- + -- Resetting -- + --------------- + + function Resetting (This : Solution; + Crate : Crate_Name) + return Solution + is (This.Missing (Crate).User_Unpinning (Crate)); + + ------------- + -- Setting -- + ------------- + + function Setting (This : Solution; + Crate : Crate_Name; + Transitivity : States.Transitivities) + return Solution + is (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Setting (Transitivity))); + + --------------- + -- Unlinking -- + --------------- + + function Unlinking (This : Solution; + Crate : Crate_Name) + return Solution + is (if This.Dependencies.Contains (Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Unlinking)) + else This); + + --------------- + -- Unpinning -- + --------------- + + function Unpinning (This : Solution; + Crate : Crate_Name) + return Solution + is (if This.Dependencies.Contains (Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Unpinning)) + else This); + + --------------- + -- Unsolving -- + --------------- + + function Unsolving (This : Solution; + Crate : Crate_Name) + return Solution + is (if This.Dependencies.Contains (Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Unlinking.Unpinning.Missing)) + else This); + + -------------------- + -- User_Unpinning -- + -------------------- + + function User_Unpinning (This : Solution; + Crate : Crate_Name) + return Solution + is (This.Unpinning (Crate).Unlinking (Crate)); + ----------------------- -- Dependencies_That -- ----------------------- @@ -114,26 +393,44 @@ package body Alire.Solutions is Release : Alire.Releases.Release; Env : Properties.Vector) return Boolean - -- First check stored releases' forbids against new release, then check new - -- release's forbids agains solution releases. - is ((for some Rel of This.Releases => - (for some Dep of Rel.Forbidden (Env) => + is ( + -- Some of the releases in the solution forbid this one release + (for some Solved of This.Releases => + (for some Dep of Solved.Forbidden (Env) => Release.Satisfies (Dep.Value)) or else + -- The candidate release forbids something in the solution (for some Dep of Release.Forbidden (Env) => - (for some Rel of This.Releases => Rel.Satisfies (Dep.Value))))); + (for some Rel of This.Releases => Rel.Satisfies (Dep.Value)))) + ); --------------- -- Including -- --------------- - function Including (This : Solution; - Release : Alire.Releases.Release; - Env : Properties.Vector; - Add_Dependency : Boolean := False) - return Solution + function Including + (This : Solution; + Release : Alire.Releases.Release; + Env : Properties.Vector; + For_Dependency : Optional.Crate_Name := Optional.Crate_Names.Empty; + Add_Dependency : Boolean := False; + Shared : Boolean := False) + return Solution is + Dep_Name : constant Crate_Name := (if Add_Dependency + then Release.Name + else For_Dependency.Value); begin + + -- Check that there's no conflict with current solution + + if This.Forbids (Release, Env) then + -- The solver should take care, so this is an unexpected error + raise Program_Error with + "release " & Release.Milestone.TTY_Image + & " is forbidden by solution"; + end if; + return Result : Solution := This do if Add_Dependency and then not This.Depends_On (Release.Name) then Result := Result.Depending_On (Release.To_Dependency.Value); @@ -143,17 +440,27 @@ package body Alire.Solutions is Result.Dependencies := Result.Dependencies.Including - (Result.State (Release.Name).Solving (Release.Whenever (Env))); + (Result.State (Dep_Name) + .Solving (Release.Whenever (Env), + Shared => Shared)); -- TODO: remove this Whenever once dynamic expr can be exported - -- Check that there's no conflict with current solution + -- In addition, mark as solved other deps satisfied via provides - if Result.Forbids (Release, Env) then - -- The solver should take care, so this is an unexpected error - raise Program_Error with - "release " & Release.Milestone.TTY_Image - & " is forbidden by solution"; - end if; + for Dep of This.Dependencies loop + if Dep.Crate /= Dep_Name + and then not Dep.Is_Solved + and then Release.Satisfies (Dep) + then + Trace.Debug + ("Marking " & Dep.TTY_Image & " as solved colaterally by " + & Release.Milestone.TTY_Image); + Result.Dependencies := + Result.Dependencies.Including + (This.State (Dep.Crate) + .Solving (Release.Whenever (Env), Shared => Shared)); + end if; + end loop; end return; end Including; @@ -180,10 +487,10 @@ package body Alire.Solutions is for Rel of This.Releases loop if Than.Contains_Release (Rel.Name) then - if Than.Releases.Element (Rel.Name).Version < Rel.Version then + if Than.Release_Providing (Rel.Name).Version < Rel.Version then return Better; elsif - Rel.Version < Than.Releases.Element (Rel.Name).Version + Rel.Version < Than.Release_Providing (Rel.Name).Version then return Worse; end if; @@ -302,31 +609,6 @@ package body Alire.Solutions is This.Dependencies.Including (This.State (Crate).Linking (Link))); - ------------------ - -- New_Solution -- - ------------------ - - function New_Solution - (Env : Properties.Vector := Properties.No_Properties; - Releases : Release_Map := Containers.Empty_Release_Map; - Direct : Dependency_Map := Containers.Empty_Dependency_Map) - return Solution - is - begin - return This : Solution := (Solved => True, - others => <>) - do - for Rel of Releases loop - This := This.Including (Rel, Env, Add_Dependency => True); - end loop; - - for Dep of Direct loop - This := This.Depending_On (Dep); - This.Set (Dep.Crate, Dependencies.States.Direct); - end loop; - end return; - end New_Solution; - --------------- -- Link_Pins -- --------------- @@ -418,15 +700,19 @@ package body Alire.Solutions is if not This.Releases.Is_Empty then Trace.Log ("Dependencies (solution):", Level); - for Rel of This.Releases loop - declare - Dep : Dependencies.States.State renames This.State (Rel.Name); - begin + for Dep of This.Dependencies loop + if Dep.Has_Release then Trace.Log (" " - & Rel.Milestone.TTY_Image + & TTY.Name (Dep.Crate) & "=" + & TTY.Version (Dep.Release.Version.Image) + & (if Dep.Crate /= Dep.Release.Name -- provided by + then " (" & TTY.Italic (TTY.Name (Dep.Release.Name)) & ")" + else "") & (if Dep.Is_Pinned or else Dep.Is_Linked then TTY.Emph (" (pinned)") + elsif Dep.Is_Shared + then TTY.Emph (" (installed)") else "") & (if Detailed then " (origin: " @@ -437,11 +723,12 @@ package body Alire.Solutions is & Dep.Link.TTY_URL_With_Reference (Detailed) else "") -- no remote - else Utils.To_Lower_Case (Rel.Origin.Kind'Img)) + else Utils.To_Lower_Case + (Dep.Release.Origin.Kind'Img)) & ")" -- origin completed else ""), -- no details Level); - end; + end if; end loop; end if; @@ -565,11 +852,13 @@ package body Alire.Solutions is for Dep of This.Hints loop Trace.Warning (" " & Dep.Image); - for Hint of Index.Crate (Dep.Crate) - .Externals.Hints (Dep.Crate, Env) - loop - Trace.Warning (" Hint: " & Hint); - end loop; + if Index.All_Crates.Contains (Dep.Crate) then + for Hint of Index.Crate (Dep.Crate) + .Externals.Hints (Dep.Crate, Env) + loop + Trace.Warning (" Hint: " & Hint); + end loop; + end if; end loop; Trace.Warning @@ -666,7 +955,7 @@ package body Alire.Solutions is -- For a dependency solved by a release, print exact -- version. Otherwise print the state of the dependency. & (if This.State (Dep.Crate).Has_Release - then This.State (Dep.Crate).Release.Milestone.TTY_Image + then This.State (Dep.Crate).Milestone_Image else This.State (Dep.Crate).TTY_Image) -- And dependency that introduces the crate in the solution @@ -711,6 +1000,7 @@ package body Alire.Solutions is Table .Append (TTY.Bold ("CRATE")) .Append (TTY.Bold ("DEPENDENCY")) + .Append (TTY.Bold ("PROVIDER")) .Append (TTY.Bold ("SOLVED")) .Append (TTY.Bold ("LATEST")) .New_Row; @@ -727,6 +1017,12 @@ package body Alire.Solutions is Table.Append (TTY.Version (Dep.Versions.Image)); end if; + if Dep.Has_Release and then Dep.Crate /= Dep.Release.Name then + Table.Append (TTY.Italic (Dep.Release.Name.As_String)); + else + Table.Append (""); + end if; + Index.Detect_Externals (Dep.Crate, Root.Environment); -- Detect externals for the crate, in case they add more versions @@ -734,11 +1030,12 @@ package body Alire.Solutions is Latest_Known : constant Boolean := Index.Exists (Dep.Crate) and then not Index.Crate (Dep.Crate).Releases.Is_Empty; - Latest : constant Containers.Release_H := + Latest : constant Alire.Releases.Containers.Release_H := (if Latest_Known - then Containers.To_Release_H + then Alire.Releases.Containers.To_Release_H (Index.Crate (Dep.Crate).Releases.Last_Element) - else Containers.Release_Holders.Empty_Holder); + else Alire.Releases.Containers.Release_Holders + .Empty_Holder); begin -- Print release version, colored according to being latest @@ -790,6 +1087,51 @@ package body Alire.Solutions is end return; end Releases; + -------------------------- + -- Dependency_Providing -- + -------------------------- + + function Dependency_Providing (This : Solution; + Crate : Crate_Name) + return States.State + is + begin + for Dep of This.Dependencies loop + if Dep.Has_Release and then Dep.Release.Provides (Crate) then + return Dep; + end if; + end loop; + + raise Program_Error with "Should not be reached due to preconditions"; + end Dependency_Providing; + + ----------------------- + -- Release_Providing -- + ----------------------- + + function Release_Providing (This : Solution; + Crate : Crate_Name) + return Alire.Releases.Release + is (This.Dependency_Providing (Crate).Release); + + ----------------------- + -- Release_Providing -- + ----------------------- + + function Release_Providing (This : Solution; + Release : Alire.Releases.Release) + return Alire.Releases.Release + is + begin + for Rel of This.Releases loop + if Rel.Provides (Release) then + return Rel; + end if; + end loop; + + raise Program_Error with "Should not be reached due to precondition"; + end Release_Providing; + --------- -- Set -- --------- @@ -804,6 +1146,53 @@ package body Alire.Solutions is (This.State (Crate).Setting (Transitivity)); end Set; + ----------- + -- State -- + ----------- + + function State (This : Solution; + Crate : Crate_Name) + return Dependency_State + is + begin + if This.Dependencies.Contains (Crate) then + return This.Dependencies (Crate); + end if; + + for Dep of This.Dependencies loop + if Dep.Has_Release and then Dep.Release.Provides (Dep.Crate) then + return Dep; + end if; + end loop; + + raise Program_Error with Errors.Set + ("No dependency in solution matches crate " & TTY.Name (Crate)); + end State; + + ----------- + -- State -- + ----------- + + function State (This : Solution; + Release : Alire.Releases.Release) + return Dependency_State + is + begin + if This.Dependencies.Contains (Release.Name) then + return This.Dependencies (Release.Name); + end if; + + for Dep of This.Dependencies loop + if Release.Provides (Dep.Crate) then + return Dep; + end if; + end loop; + + raise Program_Error with Errors.Set + ("No dependency in solution matches release " + & Release.Milestone.TTY_Image); + end State; + --------------- -- With_Pins -- --------------- diff --git a/src/alire/alire-solutions.ads b/src/alire/alire-solutions.ads index 41127c56..ddb32573 100644 --- a/src/alire/alire-solutions.ads +++ b/src/alire/alire-solutions.ads @@ -1,9 +1,11 @@ with Alire.Conditional; with Alire.Containers; +with Alire.Dependencies.Containers; with Alire.Dependencies.States.Maps; with Alire.Interfaces; +with Alire.Optional; with Alire.Properties; -with Alire.Releases; +with Alire.Releases.Containers; limited with Alire.Roots; with Alire.TOML_Adapters; @@ -15,10 +17,10 @@ with TOML; package Alire.Solutions is - subtype Dependency_Map is Alire.Containers.Dependency_Map; + subtype Dependency_Map is Dependencies.Containers.Map; subtype Dependency_State is Dependencies.States.State; subtype Name_Set is Containers.Crate_Name_Sets.Set; - subtype Release_Map is Alire.Containers.Release_Map; + subtype Release_Map is Releases.Containers.Release_Map; subtype State_Map is Dependencies.States.Maps.Map; package States renames Dependencies.States; @@ -74,17 +76,6 @@ package Alire.Solutions is function Empty_Valid_Solution return Solution; - function New_Solution - (Env : Properties.Vector := Properties.No_Properties; - Releases : Release_Map := Containers.Empty_Release_Map; - Direct : Dependency_Map := Containers.Empty_Dependency_Map) - return Solution - with Pre => Releases.Is_Empty or else not Env.Is_Empty; - -- A new solution. Trivially, a Solution without dependencies is complete. - -- We can initialize it with solved releases and unsolved dependencies. In - -- both cases, these are marked as direct dependencies. The environment is - -- only needed when releases are given. - function Depending_On (This : Solution; Dep : Dependencies.Dependency) return Solution; @@ -96,18 +87,26 @@ package Alire.Solutions is return Solution; -- Add/merge dependency as hinted in solution - function Including (This : Solution; - Release : Alire.Releases.Release; - Env : Properties.Vector; - Add_Dependency : Boolean := False) - return Solution - with Pre => Add_Dependency or else This.Depends_On (Release.Name); + function Including + (This : Solution; + Release : Alire.Releases.Release; + Env : Properties.Vector; + For_Dependency : Optional.Crate_Name := Optional.Crate_Names.Empty; + Add_Dependency : Boolean := False; + Shared : Boolean := False) + return Solution + with Pre => + (Add_Dependency and then not This.Provides (Release)) + xor + (For_Dependency.Has_Element and then + This.All_Dependencies.Contains (For_Dependency.Value)); -- Add a release to the solution, marking its dependency as solved. Takes -- care of adding forbidden dependencies and ensuring the Release does not -- conflict with current solution (which would result in a Checked_Error). -- Since from the release we can't know the actual complete dependency the -- release is fulfilling, by default we don't create its dependency (it - -- must exist previously). + -- must exist previously). Only in particular cases where we want to add + -- a dependency matching the release Add_Dependency should be true. function Resetting (This : Solution; Crate : Crate_Name) @@ -218,7 +217,15 @@ package Alire.Solutions is function Depends_On (This : Solution; Name : Crate_Name) return Boolean; - -- Says if the solution depends on the crate in some way + -- Says if the solution depends on the crate in some way. Will also + -- consider Provides of releases in the solution. + + function Depends_On (This : Solution; + Release : Alire.Releases.Release) return Boolean; + -- Likewise, but take also into account the Release.Provides + + function Depends_On_Specific_GNAT (This : Solution) return Boolean; + -- Say if the solution contains a release which is a gnat_something function Forbidden (This : Solution; Env : Properties.Vector) @@ -231,6 +238,31 @@ package Alire.Solutions is return Boolean; -- Check whether the solution forbids a release + function Provides (This : Solution; + Release : Alire.Releases.Release) + return Boolean; + -- Check whether the solution already contains or provides a release + -- equivalent to Release. + + function Dependency_Providing (This : Solution; + Crate : Crate_Name) + return States.State + with Pre => This.Releases.Contains_Or_Provides (Crate); + -- Return the dependency containing the release that provides Crate + + function Release_Providing (This : Solution; + Crate : Crate_Name) + return Alire.Releases.Release + with Pre => This.Contains_Release (Crate); + + function Release_Providing (This : Solution; + Release : Alire.Releases.Release) + return Alire.Releases.Release + with Pre => This.Provides (Release); + -- Return the release already in the solution that prevents Release from + -- entering the solution, as they both provide the same crate according + -- to This.Provides + function Hints (This : Solution) return Dependency_Map; -- Return undetected externals in the solution @@ -283,6 +315,13 @@ package Alire.Solutions is with Pre => This.Depends_On (Crate); -- Returns the solving state of a dependency in the solution + function State (This : Solution; + Release : Alire.Releases.Release) + return Dependency_State + with Pre => This.Depends_On (Release); + -- Returns the state of the dependency this release might fulfill, relying + -- only on the release name or its provides names. + -------------- -- Mutation -- -------------- @@ -341,7 +380,7 @@ package Alire.Solutions is overriding function To_TOML (This : Solution) return TOML.TOML_Value with Pre => (for all Release of This.Releases => - This.State (Release.Name).Is_Linked + This.State (Release).Is_Linked or else (Release.Dependencies.Is_Unconditional and then Release.Properties.Is_Unconditional)); -- Requires releases not to have dynamic expressions. This is currently @@ -370,265 +409,7 @@ private -- Has solving been attempted? end record; - -- Begin of implementation - - ---------------------- - -- All_Dependencies -- - ---------------------- - - function All_Dependencies (This : Solution) return State_Map - is (This.Dependencies); - - ----------------- - -- Composition -- - ----------------- - - function Composition (This : Solution) return Compositions - is (if not This.Solved then - Unsolved - elsif This.Dependencies.Is_Empty then - Empty - elsif (for all Dep of This.Dependencies => - Dep.Is_Solved or else Dep.Is_Linked) - then - Releases - elsif (for all Dep of This.Dependencies => Dep.Is_Hinted) then - Hints - elsif (for some Dep of This.Dependencies => Dep.Is_Missing) then - Partial - else - Mixed); - - ---------------------- - -- Contains_Release -- - ---------------------- - - function Contains_Release (This : Solution; - Crate : Crate_Name) return Boolean - is (This.Depends_On (Crate) and then This.State (Crate).Is_Solved); - - ---------------- - -- Dependency -- - ---------------- - - function Dependency (This : Solution; - Crate : Crate_Name) - return Alire.Dependencies.Dependency - is (This.Dependencies (Crate).As_Dependency); - - ------------------ - -- Depending_On -- - ------------------ - - function Depending_On (This : Solution; - Dep : Dependencies.Dependency) - return Solution - is (Solution'(Solved => True, - Dependencies => This.Dependencies.Merging (Dep))); - - ---------------- - -- Depends_On -- - ---------------- - - function Depends_On (This : Solution; - Name : Crate_Name) return Boolean - is (This.Dependencies.Contains (Name)); - - ---------------------------- - -- Empty_Invalid_Solution -- - ---------------------------- - - function Empty_Invalid_Solution return Solution - is (Solved => False, - others => <>); - - -------------------------- - -- Empty_Valid_Solution -- - -------------------------- - - function Empty_Valid_Solution return Solution - is (Solved => True, - others => <>); - - ------------- - -- Hinting -- - ------------- - - function Hinting (This : Solution; - Dep : Dependencies.Dependency) - return Solution - is (if This.Depends_On (Dep.Crate) - then (Solved => True, - Dependencies => - This.Dependencies.Including (This.State (Dep.Crate).Hinting)) - else (Solved => True, - Dependencies => - This.Dependencies.Including (States.New_State (Dep).Hinting))); - - ----------- - -- Hints -- - ----------- - - function Hints (This : Solution) return Dependency_Map - is (This.Dependencies_That (States.Is_Hinted'Access)); - - ------------------ - -- Is_Attempted -- - ------------------ - - function Is_Attempted (This : Solution) return Boolean - is (This.Composition /= Unsolved); - - ----------------- - -- Is_Complete -- - ----------------- - - function Is_Complete (This : Solution) return Boolean - is (This.Composition <= Releases); - - ----------- - -- Links -- - ----------- - - function Links (This : Solution) return Dependency_Map - is (This.Dependencies_That (States.Is_Linked'Access)); - - ------------ - -- Misses -- - ------------ - - function Misses (This : Solution) return Dependency_Map - is (This.Dependencies_That (States.Is_Missing'Access)); - - ------------- - -- Missing -- - ------------- - - function Missing (This : Solution; - Dep : Dependencies.Dependency) - return Solution - is (if This.Depends_On (Dep.Crate) - then (Solved => True, - Dependencies => - This.Dependencies.Including (This.State (Dep.Crate).Missing)) - else (Solved => True, - Dependencies => - This.Dependencies.Including (States.New_State (Dep).Missing))); - - ------------- - -- Missing -- - ------------- - - function Missing (This : Solution; - Crate : Crate_Name) - return Solution - is (if This.Dependencies.Contains (Crate) - then (Solved => True, - Dependencies => - This.Dependencies.Including - (This.Dependencies (Crate).Missing)) - else This); - - ------------- - -- Pinning -- - ------------- - - function Pinning (This : Solution; - Crate : Crate_Name; - Version : Semantic_Versioning.Version) - return Solution - is (Solved => True, - Dependencies => - This.Dependencies.Including - (This.Dependencies (Crate).Pinning (Version))); - - -------------- - -- Required -- - -------------- - - function Required (This : Solution) return State_Map'Class - is (This.Dependencies); - - --------------- - -- Resetting -- - --------------- - - function Resetting (This : Solution; - Crate : Crate_Name) - return Solution - is (This.Missing (Crate).User_Unpinning (Crate)); - - ------------- - -- Setting -- - ------------- - - function Setting (This : Solution; - Crate : Crate_Name; - Transitivity : States.Transitivities) - return Solution - is (Solved => True, - Dependencies => - This.Dependencies.Including - (This.Dependencies (Crate).Setting (Transitivity))); - - ----------- - -- State -- - ----------- - - function State (This : Solution; - Crate : Crate_Name) - return Dependency_State - is (This.Dependencies (Crate)); - - --------------- - -- Unlinking -- - --------------- - - function Unlinking (This : Solution; - Crate : Crate_Name) - return Solution - is (if This.Dependencies.Contains (Crate) - then (Solved => True, - Dependencies => - This.Dependencies.Including - (This.Dependencies (Crate).Unlinking)) - else This); - - --------------- - -- Unpinning -- - --------------- - - function Unpinning (This : Solution; - Crate : Crate_Name) - return Solution - is (if This.Dependencies.Contains (Crate) - then (Solved => True, - Dependencies => - This.Dependencies.Including - (This.Dependencies (Crate).Unpinning)) - else This); - - --------------- - -- Unsolving -- - --------------- - - function Unsolving (This : Solution; - Crate : Crate_Name) - return Solution - is (if This.Dependencies.Contains (Crate) - then (Solved => True, - Dependencies => - This.Dependencies.Including - (This.Dependencies (Crate).Unlinking.Unpinning.Missing)) - else This); - - -------------------- - -- User_Unpinning -- - -------------------- - - function User_Unpinning (This : Solution; - Crate : Crate_Name) - return Solution - is (This.Unpinning (Crate).Unlinking (Crate)); + -- Implementations moved to body due to bug about missing symbols in + -- predicates otherwise. end Alire.Solutions; diff --git a/src/alire/alire-solver.adb b/src/alire/alire-solver.adb index e862b571..6fbff35a 100644 --- a/src/alire/alire-solver.adb +++ b/src/alire/alire-solver.adb @@ -6,6 +6,12 @@ with Alire.Containers; with Alire.Dependencies.States; with Alire.Errors; with Alire.Milestones; +with Alire.Optional; +with Alire.Origins; +with Alire.Releases.Containers; +with Alire.Shared; +with Alire.Root; +with Alire.Toolchains; with Alire.Utils.TTY; package body Alire.Solver is @@ -17,7 +23,6 @@ package body Alire.Solver is package TTY renames Utils.TTY; use all type Dependencies.States.Transitivities; - use all type Semver.Extended.Version_Set; package Solution_Sets is new Ada.Containers.Indefinite_Ordered_Sets (Element_Type => Solution, @@ -43,18 +48,9 @@ package body Alire.Solver is Allowed : Semantic_Versioning.Extended.Version_Set := Semantic_Versioning.Extended.Any) return Boolean - is - begin - if Alire.Index.Exists (Name) then - for R of Index.Crate (Name).Releases loop - if Allowed.Contains (R.Version) then - return True; - end if; - end loop; - end if; - - return False; - end Exists; + is (not Index.Releases_Satisfying + (Dependencies.New_Dependency (Name, Allowed), + Root.Platform_Properties).Is_Empty); ---------- -- Find -- @@ -67,38 +63,16 @@ package body Alire.Solver is Policy : Age_Policies) return Release is - use Semantic_Versioning; - - ----------- - -- Check -- - ----------- - - function Check (R : Index.Release) return Boolean is - begin - if Allowed.Contains (R.Version) then - return True; - else - Trace.Debug ("Skipping unsatisfactory version: " & - Image (R.Version)); - end if; - - return False; - end Check; - + Candidates : constant Releases.Containers.Release_Set := + Index.Releases_Satisfying + (Dependencies.New_Dependency (Name, Allowed), + Root.Platform_Properties); begin - if Alire.Index.Exists (Name) then + if not Candidates.Is_Empty then if Policy = Newest then - for R of reverse Alire.Index.Crate (Name).Releases loop - if Check (R) then - return R; - end if; - end loop; + return Candidates.Last_Element; else - for R of Alire.Index.Crate (Name).Releases loop - if Check (R) then - return R; - end if; - end loop; + return Candidates.First_Element; end if; end if; @@ -128,7 +102,7 @@ package body Alire.Solver is Options : Query_Options := Default_Options) return Solution is - Progress : Trace.Ongoing := Trace.Activity ("Solving dependencies..."); + Progress : Trace.Ongoing := Trace.Activity ("Solving dependencies"); use Alire.Conditional.For_Dependencies; @@ -161,6 +135,10 @@ package body Alire.Solver is -- to select the solver behavior (e.g. stop after the first complete -- solution is found). + Installed : constant Releases.Containers.Release_Set := Shared.Available; + -- Installed releases do not change during resolution, we make a local + -- copy here so they are not read repeatedly from disk. + Dupes : Natural := 0; -- Some solutions are found twice when some dependencies are subsets of -- other dependencies. @@ -210,22 +188,147 @@ package body Alire.Solver is -- Expand_Value -- ------------------ - procedure Expand_Value (Dep : Dependencies.Dependency) is + procedure Expand_Value (Dep : Dependencies.Dependency; + Allow_Shared : Boolean) is -- Ensure the dependency exists in the solution, so the following -- procedures can safely count on it being there: Solution : constant Alire.Solutions.Solution := Expand.Solution.Depending_On (Dep); + -- Note that, since this merge may render the release for the old + -- dependency invalid, it should be checked again (which Check + -- below does.) + + -------------------- + -- Check_Compiler -- + -------------------- + + function Check_Compiler (R : Release) return Boolean is + + ------------------- + -- Specific_GNAT -- + ------------------- + -- Examine pending dependencies for a specific GNAT, and if so + -- return the one. + function Specific_GNAT (Deps : Conditional.Dependencies) + return Conditional.Dependencies + is + begin + if Deps.Is_Iterable then + for Dep of Deps loop + if Utils.Starts_With (Dep.Value.Crate.As_String, + "gnat_") -- Ugly hack + then + return Dep; + end if; + end loop; + end if; + + return Conditional.No_Dependencies; + end Specific_GNAT; + + begin + + -- The following checks are not guaranteed to find the proper + -- GNAT to use, as a yet-unknonw dependency might add a precise + -- GNAT later on. It should however cover the common case + -- in which the GNAT dependencies are in the root crate. If + -- all else fails, in the end there is a real problem of the + -- user having selected an incompatible compiler, so the last + -- recourse is for the user to unselect the compiler in this + -- configuration local config, for example. + + if Solution.Depends_On_Specific_GNAT then + + -- There is already a precise gnat_xxx in the solution, that + -- we must reuse. + + Trace.Debug + ("SOLVER: gnat PASS " & Boolean' + (Solution.Releases + .Element_Providing (GNAT_Crate).Name = R.Name)'Image + & " for " & R.Milestone.TTY_Image + & " due to compiler already in solution: " + & Solution.Releases.Element_Providing + (GNAT_Crate).Milestone.TTY_Image); + + return Solution + .Releases.Element_Providing (GNAT_Crate).Name = R.Name; + + elsif not Specific_GNAT (Remaining).Is_Empty then + + -- There is an unsolved dependency on a specific gnat, that + -- we must honor sooner or later, so no point on trying + -- another target. + + Trace.Debug + ("SOLVER: gnat PASS " & Boolean' + (Specific_GNAT (Remaining).Value.Crate = R.Name)'Image + & " for " & R.Milestone.TTY_Image + & " due to compiler already in dependencies: " + & Specific_GNAT (Remaining).Value.TTY_Image); + + return Specific_GNAT (Remaining).Value.Crate = R.Name; + + elsif Toolchains.Tool_Is_Configured (GNAT_Crate) then + + -- There is a preferred compiler that we must use, as there + -- is no overriding reason not to + + Trace.Debug + ("SOLVER: gnat PASS " & Boolean' + (Toolchains + .Tool_Dependency (GNAT_Crate).Crate = R.Name)'Image + & " for " & R.Milestone.TTY_Image + & " due to configured compiler: " + & Toolchains.Tool_Dependency (GNAT_Crate).TTY_Image); + + return Toolchains + .Tool_Dependency (GNAT_Crate).Crate = R.Name; + + elsif Dep.Crate = GNAT_Crate then + + -- For generic dependencies on gnat, we do not want to use + -- a compiler that is not already installed. + + Trace.Debug + ("SOLVER: gnat PASS " & Boolean' + (Installed.Contains (R))'Image + & " for " & R.Milestone.TTY_Image + & " due to installed compiler availability."); + + return Installed.Contains (R); + + else + + Trace.Debug ("SOLVER: gnat compiler " & R.Milestone.TTY_Image + & " is valid candidate."); + + return True; + + end if; + end Check_Compiler; ----------- -- Check -- ----------- - procedure Check (R : Release) is - use Alire.Containers; + procedure Check (R : Release; Is_Shared : Boolean) is + use all type Origins.Kinds; + use type Release; begin + -- Special compiler checks are hardcoded when the dependency is + -- on a generic GNAT. This way we ensure the preferred compiler + -- is used, unless we are forced by other dependencies to do + -- something else + + if R.Provides (GNAT_Crate) and then not Check_Compiler (R) then + -- Reason already logged by Check_Compiler + return; + end if; + -- We first check that the release matches the dependency we -- are attempting to resolve, in which case we check whether -- it is a valid candidate by taking into account the following @@ -237,13 +340,59 @@ package body Alire.Solver is -- current dependency, we may continue along this branch, -- with this dependency out of the picture. - if Solution.Releases.Contains (R.Name) then + if Solution.Provides (R) + then + + if R /= Solution.Release_Providing (R) then + + -- This may occur when e.g., we have a system compiler in + -- the solution, which does not have provides and hence + -- cannot be detected before this point. In this case we + -- cannot add a release that also provides something + -- in the solution, so we have to discard this branch. + + Trace.Debug + ("SOLVER: discarding tree because of " & + "conflicting FROZEN release: " & + Solution.Release_Providing (R).Milestone.TTY_Image & + " already provides same crate as target release: " & + R.Milestone.TTY_Image & " for dependency " & + Dep.Image & " in tree " & + Tree'(Expanded + and Target + and Remaining).Image_One_Line); + + return; + + end if; + + -- Now we may continue knowing that R is the same release + -- already in the solution for another dependency. + if R.Satisfies (Dep) then - -- Continue along this tree + + Trace.Debug + ("SOLVER: reusing FROZEN release: " & + R.Milestone.Image & " to satisfy " & + Dep.Image & " in tree " & + Tree'(Expanded + and Target + and Remaining).Image_One_Line); + + -- Continue along this tree; no need to add dependencies + -- as the release was already added previously. + Expand (Expanded => Expanded, Target => Remaining, Remaining => Empty, - Solution => Solution); + Solution => Solution.Including + (R, Props, + For_Dependency => + Optional.Crate_Names.Unit (Dep.Crate), + Shared => + Is_Shared or else + R.Origin.Kind = Binary_Archive)); + else Trace.Debug ("SOLVER: discarding tree because of " & @@ -255,20 +404,6 @@ package body Alire.Solver is and Remaining).Image_One_Line); end if; - -- If the alias of the candidate release is already in the - -- frozen list, the candidate is incompatible since another - -- crate has already provided this dependency: - - elsif Solution.Releases.Contains (R.Provides) then - Trace.Debug - ("SOLVER: discarding tree because of " & - "conflicting PROVIDES release: " & - R.Milestone.Image & " provides " & (+R.Provides) & - " already in tree " & - Tree'(Expanded - and Target - and Remaining).Image_One_Line); - -- If the candidate release is forbidden by a previously -- resolved dependency, the candidate release is -- incompatible and we may stop search along this branch. @@ -318,8 +453,9 @@ package body Alire.Solver is Trace.Debug ("SOLVER: dependency FROZEN: " & R.Milestone.Image & " to satisfy " & Dep.TTY_Image & - (if R.Name /= R.Provides - then " also providing " & (+R.Provides) + (if Is_Shared then " with INSTALLED" else "") & + (if not R.Provides.Is_Empty + then " also providing " & R.Provides.Image_One_Line else "") & " adding" & R.Dependencies (Props).Leaf_Count'Img & @@ -332,7 +468,13 @@ package body Alire.Solver is Expand (Expanded => Expanded and R.To_Dependency, Target => Remaining and R.Dependencies (Props), Remaining => Empty, - Solution => Solution.Including (R, Props)); + Solution => Solution.Including + (R, Props, + For_Dependency => + Optional.Crate_Names.Unit (Dep.Crate), + Shared => + Is_Shared or else + R.Origin.Kind = Binary_Archive)); end if; end Check; @@ -371,6 +513,46 @@ package body Alire.Solver is end if; end Expand_Missing; + ------------------ + -- Check_Hinted -- + ------------------ + + procedure Check_Hinted is + begin + if Index.Has_Externals (Dep.Crate) then + if Options.Hinting = Hint then + Trace.Debug + ("SOLVER: dependency HINTED: " & (+Dep.Crate) & + " via EXTERNAL to satisfy " & Dep.Image & + " without adding dependencies to tree " & + Tree'(Expanded + and Target + and Remaining).Image_One_Line); + + Expand (Expanded => Expanded, + Target => Remaining, + Remaining => Empty, + Solution => Solution.Hinting (Dep)); + else + Trace.Debug + ("SOLVER: dependency not hinted: " & (+Dep.Crate) & + " as HINTING is DISABLED, for dep " & Dep.Image & + " having externals, when tree is " & + Tree'(Expanded + and Target + and Remaining).Image_One_Line); + end if; + else + Trace.Debug + ("SOLVER: dependency not hinted: " & (+Dep.Crate) & + " for dep " & Dep.Image & + " LACKING externals, when tree is " & + Tree'(Expanded + and Target + and Remaining).Image_One_Line); + end if; + end Check_Hinted; + ----------------------- -- Check_Version_Pin -- ----------------------- @@ -389,44 +571,32 @@ package body Alire.Solver is -- The pin is compatible with the dependency, go ahead - if Index.Exists (Dep.Crate, Pin_Version) then + for Release of Index.Releases_Satisfying + (Dependencies.New_Dependency (Dep.Crate, Pin_Version), + Props) + loop -- There is a valid crate for this pin and dependency Trace.Debug ("SOLVER short-cutting due to version pin" & " with valid release in index"); - Check (Index.Find (Dep.Crate, Pin_Version)); - - -- The check may still fail, so we must attempt this one: - - Trace.Debug - ("SOLVER: marking crate " & Dep.Image - & " MISSING in case pinned version available in index " - & TTY.Version (Pin_Version.Image) - & " is incompatible with other dependencies" - & " when the search tree was " - & Tree'(Expanded - and Target - and Remaining).Image_One_Line); - - Expand_Missing (Dep); - - else + Check (Release, Is_Shared => False); + end loop; - -- There is no release for this pin + -- There may be no satisfying releases, or even so the + -- check may still fail, so we must attempt this one too: - Trace.Debug - ("SOLVER: marking crate " & Dep.Image - & " MISSING because index LACKS pinned version " - & TTY.Version (Pin_Version.Image) - & " when the search tree was " - & Tree'(Expanded - and Target - and Remaining).Image_One_Line); - - Expand_Missing (Dep); + Trace.Debug + ("SOLVER: marking crate " & Dep.Image + & " MISSING in case pinned version " + & TTY.Version (Pin_Version.Image) + & " is incompatible with other dependencies" + & " when the search tree was " + & Tree'(Expanded + and Target + and Remaining).Image_One_Line); - end if; + Expand_Missing (Dep); else @@ -453,6 +623,33 @@ package body Alire.Solver is -- will have to), we should do this globally since this is -- information common to all search states. + ------------------ + -- Check_Shared -- + ------------------ + + procedure Check_Shared is + begin + + -- Solve with all installed dependencies that satisfy it + + for R of reverse Installed.Satisfying (Dep) loop + Satisfiable := True; + + Check (R, Is_Shared => True); + end loop; + + -- We may want still check without taking into account + -- installed releases. + + if Installed.Satisfying (Dep).Is_Empty + or else Options.Completeness >= Some_Incomplete + then + Expand_Value (Dep => Dep, + Allow_Shared => False); + end if; + + end Check_Shared; + begin if Pins.Depends_On (Dep.Crate) and then @@ -479,14 +676,37 @@ package body Alire.Solver is Solution.Linking (Dep.Crate, Pins.State (Dep.Crate).Link)); - elsif Solution.Releases.Contains (Dep.Crate) then + elsif Solution.Releases.Contains_Or_Provides (Dep.Crate) then -- Cut search once a crate is frozen, by checking the - -- compatibility of the already frozen release: + -- compatibility of the already frozen release. This will + -- result in the same release being used to satisfy the new + -- Dep, if possible, or discarding the search branch early. + + Trace.Debug + ("SOLVER: re-checking EXISTING release " + & Solution.Releases.Element_Providing (Dep.Crate) + .Milestone.TTY_Image + & " for DIFFERENT dep " & Dep.TTY_Image); + + Check (Solution.Releases.Element_Providing (Dep.Crate), + Is_Shared => + Solution.Dependency_Providing (Dep.Crate).Is_Shared); + + end if; - Check (Solution.Releases.Element (Dep.Crate)); + if Allow_Shared then - elsif Pins.Depends_On (Dep.Crate) and then + -- There is a shared release we can use for this dependency; we + -- prefer this option first. If more solutions than the first + -- complete one are sought, we can still try without the shared + -- release. + + Check_Shared; + + end if; + + if Pins.Depends_On (Dep.Crate) and then Pins.State (Dep.Crate).Is_Pinned then @@ -494,7 +714,11 @@ package body Alire.Solver is Check_Version_Pin; - elsif Index.Exists (Dep.Crate) then + elsif Index.Exists (Dep.Crate) or else + Index.Has_Externals (Dep.Crate) or else + not Index.Releases_Satisfying (Dep, Props).Is_Empty + -- TODO: Worth caching? + then -- Detect externals for this dependency now, so they are -- available as regular releases. Note that if no release @@ -515,18 +739,26 @@ package body Alire.Solver is -- Don't bother checking what we known to not be available. -- We still want to go through to external hinting. declare + Candidates : constant Releases.Containers.Release_Set := + Index.Releases_Satisfying (Dep, Props); + procedure Consider (R : Release) is begin Satisfiable := Satisfiable or else R.Satisfies (Dep); - Check (R); + Check (R, Is_Shared => False); end Consider; begin + Trace.Debug ("SOLVER: considering" + & Candidates.Length'Image & " candidates to " + & Dep.TTY_Image & ": " + & Candidates.Image_One_Line); + if Options.Age = Newest then - for R of reverse Index.Crate (Dep.Crate).Releases loop + for R of reverse Candidates loop Consider (R); end loop; else - for R of Index.Crate (Dep.Crate).Releases loop + for R of Candidates loop Consider (R); end loop; end if; @@ -537,38 +769,7 @@ package body Alire.Solver is -- crate, in which case we hint the crate instead of failing -- resolution (if the external failed to find its releases). - if not Index.Crate (Dep.Crate).Externals.Is_Empty then - if Options.Hinting = Hint then - Trace.Debug - ("SOLVER: dependency HINTED: " & (+Dep.Crate) & - " via EXTERNAL to satisfy " & Dep.Image & - " without adding dependencies to tree " & - Tree'(Expanded - and Target - and Remaining).Image_One_Line); - - Expand (Expanded => Expanded, - Target => Remaining, - Remaining => Empty, - Solution => Solution.Hinting (Dep)); - else - Trace.Debug - ("SOLVER: dependency not hinted: " & (+Dep.Crate) & - " as HINTING is DISABLED, for dep " & Dep.Image & - " having externals, when tree is " & - Tree'(Expanded - and Target - and Remaining).Image_One_Line); - end if; - else - Trace.Debug - ("SOLVER: dependency not hinted: " & (+Dep.Crate) & - " for dep " & Dep.Image & - " LACKING externals, when tree is " & - Tree'(Expanded - and Target - and Remaining).Image_One_Line); - end if; + Check_Hinted; -- There may be a less bad solution if we leave this crate out. @@ -677,7 +878,7 @@ package body Alire.Solver is Dupes := Dupes + 1; end if; - Progress.Step ("Solving dependencies... " + Progress.Step ("Solving dependencies" & Utils.Trim (Complete'Img) & "/" & Utils.Trim (Partial'Img) & "/" & Utils.Trim (Dupes'Image) @@ -724,8 +925,9 @@ package body Alire.Solver is -- 2 is done here: first add/merge new dep, then use it for expand Expand_Value - (Solution.Depending_On (Target.Value) -- add or merge dependency - .Dependency (Target.Value.Crate)); -- and use it in expansion + (Solution.Depending_On (Target.Value) -- add or merge dependency + .Dependency (Target.Value.Crate), -- and use it in expansion + Allow_Shared => Options.Sharing = Allow_Shared); elsif Target.Is_Vector then if Target.Conjunction = Anded then @@ -753,25 +955,18 @@ package body Alire.Solver is begin if not Direct.Contains_ORs then for Dep of Direct loop - if not Index.Exists (Dep.Value.Crate) then - -- Crate totally unavailable - Unavailable_Crates.Include (Dep.Value.Crate); - Trace.Debug ("Direct dependency is not a known crate: " - & TTY.Name (Dep.Value.Crate)); - else - -- Pre-populate external releases - if Options.Detecting = Detect then - Index.Detect_Externals (Dep.Value.Crate, Props); - end if; - if not Exists (Dep.Value.Crate, Dep.Value.Versions) then + -- Pre-populate external releases - -- No valid releases for the crate - Unavailable_Deps.Include (Dep.Value.Image); - Trace.Debug - ("Direct dependency has no fulfilling releases: " - & TTY.Name (Dep.Value.Image)); - end if; + if Options.Detecting = Detect then + Index.Detect_Externals (Dep.Value.Crate, Props); + end if; + + if Index.Releases_Satisfying (Dep.Value, Props).Is_Empty then + Unavailable_Deps.Include (Dep.Value.Image); + Trace.Debug + ("Direct dependency has no fulfilling releases: " + & TTY.Name (Dep.Value.Image)); end if; end loop; else @@ -877,9 +1072,10 @@ package body Alire.Solver is when All_Incomplete => raise Program_Error with "Unreachable code"), Detecting => Options.Detecting, - Hinting => Options.Hinting))); + Hinting => Options.Hinting, + Sharing => Options.Sharing))); else - raise No_Solution_Error with Errors.Set + raise Query_Unsuccessful with Errors.Set ("Solver failed to find any solution to fulfill dependencies."); end if; else @@ -901,7 +1097,7 @@ package body Alire.Solver is -- Mark direct dependencies - for Dep of Containers.Enumerate (Deps) loop + for Dep of Conditional.Enumerate (Deps) loop if Best_Solution.Depends_On (Dep.Crate) then Best_Solution.Set (Dep.Crate, Direct); end if; diff --git a/src/alire/alire-solver.ads b/src/alire/alire-solver.ads index 00617947..d48651ec 100644 --- a/src/alire/alire-solver.ads +++ b/src/alire/alire-solver.ads @@ -9,8 +9,6 @@ with Semantic_Versioning.Extended; package Alire.Solver is - No_Solution_Error : exception; - -------------- -- Policies -- -------------- @@ -56,6 +54,10 @@ package Alire.Solver is -- releases will be used normally; otherwise a crate with only externals -- will always cause failure. + type Sharing_Policies is (Allow_Shared, Only_Local); + -- * Allow_Shared: crates in the shared config can appear in solutions. + -- * Only_Local: only crates in the local workspace will be used. + subtype Pin_Map is User_Pins.Maps.Map; subtype Release is Types.Release; subtype Solution is Solutions.Solution; @@ -87,6 +89,7 @@ package Alire.Solver is Allowed : Semantic_Versioning.Extended.Version_Set := Semantic_Versioning.Extended.Any) return Boolean; + -- Say if some release in the index fulfills this dependency function Find (Name : Alire.Crate_Name; @@ -97,8 +100,8 @@ package Alire.Solver is with Pre => Exists (Name, Allowed) or else raise Query_Unsuccessful - with "Release within requested version not found: " - & Dependencies.New_Dependency (Name, Allowed).Image; + with "Release within requested versions not found: " + & Dependencies.New_Dependency (Name, Allowed).TTY_Image; ----------------------- -- Advanced queries -- @@ -110,6 +113,7 @@ package Alire.Solver is Completeness : Completeness_Policies := First_Complete; Detecting : Detection_Policies := Detect; Hinting : Hinting_Policies := Hint; + Sharing : Sharing_Policies := Allow_Shared; end record; Default_Options : constant Query_Options := (others => <>); diff --git a/src/alire/alire-toml_adapters.adb b/src/alire/alire-toml_adapters.adb index 707c68b1..98cb16c2 100644 --- a/src/alire/alire-toml_adapters.adb +++ b/src/alire/alire-toml_adapters.adb @@ -328,7 +328,7 @@ package body Alire.TOML_Adapters is Trace.Always (Prefix & "table:"); for Pair of Val.Iterate_On_Table loop if Pair.Value.Kind in Atom_Value_Kind then - Trace.Always (Prefix & (+Val.Keys (1)) & " = " + Trace.Always (Prefix & (+Pair.Key) & " = " & Image (Pair.Value)); else Trace.Always (Prefix & (+Pair.Key) & " = "); diff --git a/src/alire/alire-toml_index.adb b/src/alire/alire-toml_index.adb index 20c7e153..f4766b22 100644 --- a/src/alire/alire-toml_index.adb +++ b/src/alire/alire-toml_index.adb @@ -5,6 +5,7 @@ with Alire.Directories; with Alire.Errors; with Alire.TOML_Adapters; +with Alire.Hashes.SHA256_Impl; pragma Unreferenced (Alire.Hashes.SHA256_Impl); with Alire.Hashes.SHA512_Impl; pragma Unreferenced (Alire.Hashes.SHA512_Impl); -- Hash implementation generics are not directly withed anywhere. Since they -- are not Preelaborate, and the index loader is one of the few in Alire also @@ -347,6 +348,12 @@ package body Alire.TOML_Index is Version : String; Strict : Boolean) is + -- We enter the folder of the file so any relative paths within (mostly + -- used during tests, but might be valid for private indexes too) are + -- properly resolved by the loaders elsewhere. + + Enter : Directories.Guard + (Directories.Enter (Directories.Parent (File_Name))) with Unreferenced; ------------------- -- Error_In_File -- diff --git a/src/alire/alire-toml_load.adb b/src/alire/alire-toml_load.adb index 53d6561b..67f0bcde 100644 --- a/src/alire/alire-toml_load.adb +++ b/src/alire/alire-toml_load.adb @@ -39,6 +39,7 @@ package body Alire.TOML_Load is type Tables is (Available, Dependencies, + Provides, Origin); Allowed_Tables : constant array (Crates.Sections, Tables) of Boolean := @@ -73,6 +74,7 @@ package body Alire.TOML_Load is From : TOML_Adapters.Key_Queue; Props : in out Conditional.Properties; Deps : in out Conditional.Dependencies; + Equiv : in out Alire.Provides.Equivalences; Pins : in out User_Pins.Maps.Map; Avail : in out Conditional.Availability) is @@ -83,6 +85,7 @@ package body Alire.TOML_Load is TOML_Avail : TOML.TOML_Value; TOML_Deps : TOML.TOML_Value; + TOML_Equiv : TOML.TOML_Value; begin @@ -126,6 +129,19 @@ package body Alire.TOML_Load is & TOML_Keys.Depends_On); end if; + -- Process Provides + + if Allowed_Tables (Section, Provides) then + if From.Pop (TOML_Keys.Provides, TOML_Equiv) then + From.Assert + (TOML_Equiv.Kind = TOML_Array, + "provides must be an array of strings describing milestones"); + + Equiv := Alire.Provides.From_TOML + (From.Descend (TOML_Equiv, TOML_Keys.Provides)); + end if; + end if; + -- Process user pins if From.Contains (TOML_Keys.Pins) then diff --git a/src/alire/alire-toml_load.ads b/src/alire/alire-toml_load.ads index 1073d95c..37b52e45 100644 --- a/src/alire/alire-toml_load.ads +++ b/src/alire/alire-toml_load.ads @@ -1,5 +1,6 @@ with Alire.Conditional; with Alire.Crates; +with Alire.Provides; with Alire.TOML_Adapters; with Alire.User_Pins.Maps; @@ -22,10 +23,11 @@ package Alire.TOML_Load is From : TOML_Adapters.Key_Queue; Props : in out Conditional.Properties; Deps : in out Conditional.Dependencies; + Equiv : in out Alire.Provides.Equivalences; Pins : in out User_Pins.Maps.Map; Avail : in out Conditional.Availability); -- Loads parts of a manifest, taking into account if we are loading - -- a indexed release, a local release, a external shared section or - -- a external private section. + -- an indexed release, a local release, an external shared section or + -- an external private section. end Alire.TOML_Load; diff --git a/src/alire/alire-toolchains-solutions.adb b/src/alire/alire-toolchains-solutions.adb new file mode 100644 index 00000000..02517a44 --- /dev/null +++ b/src/alire/alire-toolchains-solutions.adb @@ -0,0 +1,51 @@ +with Alire.Root; +with Alire.Shared; + +package body Alire.Toolchains.Solutions is + + ------------------- + -- Add_Toolchain -- + ------------------- + + function Add_Toolchain (Solution : Alire.Solutions.Solution) + return Alire.Solutions.Solution + is + Result : Alire.Solutions.Solution := Solution; + begin + -- For every tool in the toolchain that does not appear in the solution, + -- we will insert the user-configured tool, if any. + + for Tool of Toolchains.Tools loop + if Solution.Depends_On (Tool) then + Trace.Debug + ("Toolchain environment: solution already depends on " + & Solution.State (Tool).TTY_Image); + elsif Toolchains.Tool_Is_Configured (Tool) then + Result := Result.Including + (Release => Shared.Release + (Tool_Milestone (Tool)), + Env => Root.Platform_Properties, + Add_Dependency => True, + Shared => True); + else + Trace.Debug ("Toolchain environment: tool not in solution nor " + & "defined by the user: " & Tool.TTY_Image); + end if; + end loop; + + return Result; + end Add_Toolchain; + + --------------------- + -- Is_In_Toolchain -- + --------------------- + + function Is_In_Toolchain (Release : Releases.Release) return Boolean + is + use type Dependencies.Dependency; + begin + return Tool_Is_Configured (Release.Name) and then + Tool_Dependency (Release.Name) = Release.To_Dependency.Value; + end Is_In_Toolchain; + +end Alire.Toolchains.Solutions; diff --git a/src/alire/alire-toolchains-solutions.ads b/src/alire/alire-toolchains-solutions.ads new file mode 100644 index 00000000..56bb976a --- /dev/null +++ b/src/alire/alire-toolchains-solutions.ads @@ -0,0 +1,18 @@ +with Alire.Releases; +with Alire.Solutions; + +package Alire.Toolchains.Solutions is + + -- Needed to break circularity + + function Add_Toolchain (Solution : Alire.Solutions.Solution) + return Alire.Solutions.Solution; + -- If no release in the solution is a compiler/builder, add the configured + -- ones (if defined) to the solution. This is used just before launching + -- the build, so the configured tools are used despite not being in a + -- regular solution. + + function Is_In_Toolchain (Release : Releases.Release) return Boolean; + -- Say if this Release is part of the user-configured toolchain + +end Alire.Toolchains.Solutions; diff --git a/src/alire/alire-toolchains.adb b/src/alire/alire-toolchains.adb new file mode 100644 index 00000000..f754666a --- /dev/null +++ b/src/alire/alire-toolchains.adb @@ -0,0 +1,286 @@ +with AAA.Strings; +with AAA.Text_IO; + +with Ada.Containers.Indefinite_Vectors; + +with Alire.Config.Edit; +with Alire.Index; +with Alire.Origins; +with Alire.Properties; +with Alire.Releases.Containers; +with Alire.Root; +with Alire.Shared; +with Alire.Utils.User_Input; + +with Semantic_Versioning.Extended; + +package body Alire.Toolchains is + + -------------- + -- Any_Tool -- + -------------- + -- crate=* dependency builder + function Any_Tool (Crate : Crate_Name) return Dependencies.Dependency + is (Dependencies.New_Dependency + (Crate, Semantic_Versioning.Extended.Any)); + + --------------- + -- Assistant -- + --------------- + + procedure Assistant is + package Release_Vectors is new + Ada.Containers.Indefinite_Vectors + (Positive, Releases.Release, Releases."="); + + type Selections is record + Choices : Utils.String_Vector; + Targets : Release_Vectors.Vector; + -- These two variables are in sync; so the picked choice says the + -- release to use at the same position in the respective vector. + end record; + + Selected : Releases.Containers.Release_Set; + -- We store here all selected releases, so they are deployed in batch + -- after all the user interactions. + + -------------------------- + -- Fill_Version_Choices -- + -------------------------- + + function Fill_Version_Choices (Crate : Crate_Name) + return Selections + is + + Result : Selections; + + ---------------- + -- Add_Choice -- + ---------------- + + procedure Add_Choice (Text : String; + Release : Alire.Releases.Release; + Prepend : Boolean := False) + is + begin + if Prepend then + Result.Choices.Prepend (Text); + Result.Targets.Prepend (Release); + else + Result.Choices.Append (Text); + Result.Targets.Append (Release); + end if; + end Add_Choice; + + use all type Origins.Kinds; + Env : constant Properties.Vector := Root.Platform_Properties; + begin + Index.Detect_Externals (Crate, Root.Platform_Properties); + + -- Always offer to configure nothing + Result.Choices.Append ("None"); + Result.Targets.Append (Releases.New_Empty_Release (Crate)); + -- Just a placeholder that won't be used anywere, but keeps boot + -- collections in sync. + + -- Identify possible externals first (but after the newest Alire one) + for Release of reverse Index.Releases_Satisfying (Any_Tool (Crate), + Env) + loop + if Release.Origin.Kind in System | External then + Add_Choice (Release.Milestone.TTY_Image + & TTY.Dim (" [" & Release.Notes & "]"), + Release); + end if; + end loop; + + -- Regular choices go afterwards, except for the most current one + -- which goes before anything else. + Add_Binary_Versions : + declare + First : Boolean := True; + begin + for Release of reverse Index.Releases_Satisfying (Any_Tool (Crate), + Env) + loop + if Release.Origin.Is_Regular then + + -- We want the newest native compiler packaged by Alire to + -- be the default. Sorting of the GNAT crate in Releases + -- already guarantees that the last compiler in the + -- collection will be a native one (if there is one). + + if First then + First := False; + Add_Choice (Release.Milestone.TTY_Image, Release, + Prepend => True); + else + Add_Choice (Release.Milestone.TTY_Image, Release); + end if; + end if; + end loop; + end Add_Binary_Versions; + + return Result; + end Fill_Version_Choices; + + ------------- + -- Install -- + ------------- + + procedure Install (Release : Releases.Release) is + begin + + -- If the selected tool is one of our regular indexed ones, install + -- the tool. Also, store the version in our configuration for future + -- reference. On the contrary, if the selection is from system + -- packages or the environment, we need not to install anything. + -- (We are not offering system packages, as only one gnat can + -- be installed e.g. in Debian, and changing it would affect the + -- whole system. We only offer external compilers detected in the + -- environment.) + + -- Deploy as a shared install unless external + + if Release.Origin.Is_Regular then + Shared.Share (Release); + else + Trace.Debug + ("The user selected a external version as default for " + & Release.Milestone.TTY_Image); + end if; + + -- Store tool milestone after successful deployment + + Config.Edit.Set (Path => Config.Edit.Filepath (Config.Global), + Key => Tool_Key (Release.Name), + Value => Release.Milestone.Image); + + end Install; + + ------------------ + -- Pick_Up_Tool -- + ------------------ + + procedure Pick_Up_Tool (Crate : Crate_Name; Selection : Selections) is + Choice : constant Positive := + Utils.User_Input.Query_Multi + (Question => + "Please select the " & Crate.TTY_Image + & " version for use with this configuration", + Choices => Selection.Choices); + begin + if Selection.Choices (Choice) = "None" then + + Put_Info ("Selected to rely on a user-provided binary."); + + -- Clean up stored version + + Config.Edit.Unset (Path => Config.Edit.Filepath (Config.Global), + Key => Tool_Key (Crate)); + + else + + Put_Info + ("Selected tool version " + & TTY.Bold (Selection.Targets (Choice).Milestone.TTY_Image)); + + -- Store for later installation + + Selected.Insert (Selection.Targets (Choice)); + + end if; + end Pick_Up_Tool; + + ------------ + -- Set_Up -- + ------------ + + procedure Set_Up (Crate : Crate_Name) is + begin + + Trace.Info (""); + if Tool_Is_Configured (Crate) then + Put_Info ("Currently configured: " + & Tool_Dependency (Crate).TTY_Image); + else + Put_Info (Crate.TTY_Image & " is currently not configured. (" + & TTY.Alr + & " will use the version found in the environment.)"); + end if; + Trace.Info (""); + + -- Find the newest regular release in our index: + if not Index.Releases_Satisfying (Any_Tool (Crate), + Root.Platform_Properties).Is_Empty + then + Pick_Up_Tool (Crate, Fill_Version_Choices (Crate)); + else + Put_Warning + ("No indexed versions in the catalog for crate " + & Crate.TTY_Image); + end if; + + end Set_Up; + + begin + + AAA.Text_IO.Put_Paragraphs + (AAA.Strings.Empty_Vector + .Append ("Welcome to the toolchain selection assistant") + .Append ("") + .Append + ("In this assistant you can set up the default toolchain to be " + & "used with any crate that does not specify its own top-level " + & "dependency on a version of " & TTY.Name ("gnat") & " or " + & TTY.Name ("gprbuild.")) + .Append ("") + .Append + ("If you choose " & TTY.Italic ("""None""") & ", Alire will use " + & "whatever version is found in the environment.") + ); + + for Tool of Tools loop + Set_Up (Tool); + end loop; + + -- The user has already chosen, so disable the assistant + + Config.Edit.Set (Config.Edit.Filepath (Config.Global), + Config.Keys.Toolchain_Assistant, + "false"); + + -- Finally deploy selections + + for Release of Selected loop + Install (Release); + end loop; + + end Assistant; + + ------------------------ + -- Tool_Is_Configured -- + ------------------------ + + function Tool_Is_Configured (Crate : Crate_Name) return Boolean + is (Config.Defined (Tool_Key (Crate))); + + --------------------- + -- Tool_Dependency -- + --------------------- + + function Tool_Dependency (Crate : Crate_Name) return Dependencies.Dependency + is (Dependencies.New_Dependency + (Milestones.New_Milestone (Config.Get (Tool_Key (Crate), "")))); + + ----------------- + -- Unconfigure -- + ----------------- + + procedure Unconfigure (Crate : Crate_Name) is + begin + Config.Edit.Unset (Config.Edit.Filepath (Config.Global), + Tool_Key (Crate)); + end Unconfigure; + +end Alire.Toolchains; diff --git a/src/alire/alire-toolchains.ads b/src/alire/alire-toolchains.ads new file mode 100644 index 00000000..eadd54c5 --- /dev/null +++ b/src/alire/alire-toolchains.ads @@ -0,0 +1,84 @@ +with Ada.Containers.Indefinite_Ordered_Sets; + +private with Alire.Config; +with Alire.Dependencies; +private with Alire.Milestones; +with Alire.TTY; +with Alire.Utils; + +package Alire.Toolchains is + + package Name_Sets is + new Ada.Containers.Indefinite_Ordered_Sets (Crate_Name); + + Tools : constant Name_Sets.Set := + Name_Sets.Empty_Set + .Union (Name_Sets.To_Set (GNAT_Crate)) + .Union (Name_Sets.To_Set (GPRbuild_Crate)); + -- All crates that are part of the provided binary toolchain + + function Any_Tool (Crate : Crate_Name) return Dependencies.Dependency; + -- Returns a dependency on crate* + + procedure Assistant; + -- Runs the interactive assistant to select the default toolchain. By + -- default, the native Alire-provided compiler for Current_OS is proposed. + + -- The following functions will transform any `gnat_XXX` dependency on + -- plain `gnat`. This way we need to to litter the callers with similar + -- transformations, as we always want whatever gnat_XXX is used for "gnat". + + function Tool_Is_Configured (Crate : Crate_Name) return Boolean; + -- Say if a tool is actually configured by the user + + function Tool_Dependency (Crate : Crate_Name) return Dependencies.Dependency + with Pre => Tool_Is_Configured (Crate); + -- Return the configured compiler as an exact compiler=version dependency + + procedure Unconfigure (Crate : Crate_Name); + -- Set the crate as not configured. + + Description : constant Utils.String_Vector + := Utils.Empty_Vector + .Append ("Alire indexes binary releases of GNAT and gprbuild. The " + & "compilers are indexed with their target name, e.g., " + & TTY.Name ("gnat_native") & " or " + & TTY.Name ("gnat_riscv_elf") & ". ") + .Append ("") + .Append ("Use " & TTY.Terminal ("alr toolchain --help") & " to obtain " + & "information about toolchain management. Alire can be " + & "configured to rely on a toolchain installed by the user in " + & "the environment, or to use one of the indexed toolchains " + & "whenever possible.") + .Append ("") + .Append ("Some crates may override the default toolchain by specifying " + & "dependencies on particular compiler crates, for example to " + & "use a cross-compiler. In this situation, a compiler already " + & "available (selected as default or already installed) will " + & "take precedence over a compiler available in the catalog. ") + .Append ("") + .Append ("See also " + & TTY.URL ("https://alire.ada.dev/docs/#toolchains") & " for " + & "additional details about compiler dependencies and toolchain " + & "interactions."); + +private + + -------------- + -- Tool_Key -- + -------------- + -- Construct the "toolchain.use.crate" keys + function Tool_Key (Crate : Crate_Name) return Config.Config_Key + is (if Utils.Starts_With (Crate.As_String, "gnat_") + then Tool_Key (GNAT_Crate) + else Config.Config_Key + (String (Config.Keys.Toolchain_Use) & "." & Crate.As_String)); + + -------------------- + -- Tool_Milestone -- + -------------------- + -- Return the milestone stored by the user for this tool + function Tool_Milestone (Crate : Crate_Name) return Milestones.Milestone + is (Milestones.New_Milestone (Config.Get (Tool_Key (Crate), ""))); + +end Alire.Toolchains; diff --git a/src/alire/alire-uri.adb b/src/alire/alire-uri.adb new file mode 100644 index 00000000..27a982b2 --- /dev/null +++ b/src/alire/alire-uri.adb @@ -0,0 +1,38 @@ +package body Alire.URI is + + ------------ + -- Scheme -- + ------------ + + function Scheme (This : URL) return Schemes + is + Img : constant String := L (U.Scheme (This)); + begin + return + (if Img = "" then + None + elsif Img = "external" then + External + elsif Img = "file" then + File + elsif Utils.Starts_With (Img, "git+") then + Git + elsif Utils.Starts_With (Img, "git@") then + Pure_Git + elsif Utils.Starts_With (Img, "hg+") then + Hg + elsif Utils.Starts_With (Img, "svn+") then + SVN + elsif Img = "http" then + HTTP + elsif Img = "https" then + HTTP + elsif Img = "system" then + System + elsif Img'Length = 1 and then Img (Img'First) in 'a' .. 'z' then + None -- A Windows drive letter, so a path without scheme + else + Unknown); + end Scheme; + +end Alire.URI; diff --git a/src/alire/alire-uri.ads b/src/alire/alire-uri.ads index ee0a165e..6c70b377 100644 --- a/src/alire/alire-uri.ads +++ b/src/alire/alire-uri.ads @@ -117,32 +117,4 @@ private function Path (This : URL) return String is (U.Extract (This, U.Path)); - ------------ - -- Scheme -- - ------------ - - function Scheme (This : URL) return Schemes - is (if U.Scheme (This) = "" then - None - elsif L (U.Scheme (This)) = "external" then - External - elsif L (U.Scheme (This)) = "file" then - File - elsif Utils.Starts_With (L (U.Scheme (This)), "git+") then - Git - elsif Utils.Starts_With (L (U.Scheme (This)), "git@") then - Pure_Git - elsif Utils.Starts_With (L (U.Scheme (This)), "hg+") then - Hg - elsif Utils.Starts_With (L (U.Scheme (This)), "svn+") then - SVN - elsif L (U.Scheme (This)) = "http" then - HTTP - elsif L (U.Scheme (This)) = "https" then - HTTP - elsif L (U.Scheme (This)) = "system" then - System - else - Unknown); - end Alire.URI; diff --git a/src/alire/alire-user_pins.adb b/src/alire/alire-user_pins.adb index 397d3a8b..6bd8d3ac 100644 --- a/src/alire/alire-user_pins.adb +++ b/src/alire/alire-user_pins.adb @@ -1,10 +1,10 @@ with Ada.Directories; with Alire.Directories; +with Alire.Origins; with Alire.Roots.Optional; with Alire.Utils.TTY; with Alire.Utils.User_Input; -with Alire.VCSs.Git; with Alire.VFS; with GNAT.OS_Lib; diff --git a/src/alire/alire-user_pins.ads b/src/alire/alire-user_pins.ads index 89bc91e4..d1469628 100644 --- a/src/alire/alire-user_pins.ads +++ b/src/alire/alire-user_pins.ads @@ -1,6 +1,6 @@ with Alire.Optional; -with Alire.Origins; with Alire.TOML_Adapters; +with Alire.VCSs.Git; with Semantic_Versioning; @@ -67,7 +67,7 @@ package Alire.User_Pins is Branch : String := "") return Pin with - Pre => Commit = "" or else Origins.Is_Valid_Commit (Commit), + Pre => Commit = "" or else VCSs.Git.Is_Valid_Commit (Commit), Post => New_Remote'Result.Kind = To_Git; function URL (This : Pin) return Alire.URL diff --git a/src/alire/alire-utils-tty.ads b/src/alire/alire-utils-tty.ads index ed2a294f..3fcd35b5 100644 --- a/src/alire/alire-utils-tty.ads +++ b/src/alire/alire-utils-tty.ads @@ -57,6 +57,10 @@ package Alire.Utils.TTY with Preelaborate is function Bold (Text : String) return String; + function Dim (Text : String) return String; + + function Italic (Text : String) return String; + function Underline (Text : String) return String; function Name (Crate : Crate_Name) return String; @@ -67,11 +71,20 @@ package Alire.Utils.TTY with Preelaborate is function Description (Text : String) return String; -- Not bold cyan for crate descriptions + function Terminal (Text : String) return String; + -- For showing commands that the user can run; mimics old amber displays. + function URL (Text : String) return String; function Version (Text : String) return String; -- For versions/version sets, bold magenta + ---------------------- + -- Purpose-specific -- + ---------------------- + + function Alr return String is (Terminal ("alr")); + private function Info (Text : String := "") return String is @@ -108,6 +121,14 @@ private (Format (Text, Style => ANSI.Bright)); + function Dim (Text : String) return String is + (Format (Text, + Style => ANSI.Dim)); + + function Italic (Text : String) return String is + (Format (Text, + Style => ANSI.Italic)); + function Underline (Text : String) return String is (Format (Text, Style => ANSI.Underline)); @@ -122,6 +143,11 @@ private (Format (Text, Fore => ANSI.Light_Cyan)); + function Terminal (Text : String) return String is + (if Color_Enabled and then Is_TTY + then ANSI.Color_Wrap (Text, ANSI.Palette_Fg (5, 3, 0)) + else Text); + function URL (Text : String) return String renames Version; function Version (Text : String) return String is diff --git a/src/alire/alire-utils-user_input.adb b/src/alire/alire-utils-user_input.adb index 1f4d84bf..32d59ceb 100644 --- a/src/alire/alire-utils-user_input.adb +++ b/src/alire/alire-utils-user_input.adb @@ -166,6 +166,133 @@ package body Alire.Utils.User_Input is end loop; end Query; + ----------------- + -- Query_Multi -- + ----------------- + + function Query_Multi (Question : String; + Choices : String_Vector; + Page_Size : Positive := 10) + return Positive + is + Answers : constant array (Positive range <>) of Character := + ('1', '2', '3', '4', '5', '6', '7', '8', '9', '0', + 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', + 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', + 'u', 'v', 'w', 'x', 'y', 'z'); + pragma Assert (Answers'First = Positive'First); + + Use_Pager : constant Boolean := Natural (Choices.Length) > Page_Size; + Page_Start : Positive := 1; + Page_End : Positive; + -- Points always to the last valid choice; there can be an extra choice + -- if Use_Pager, to move forward the list. + + ------------------- + -- Print_Choices -- + ------------------- + + procedure Print_Choices is + begin + Page_End := Positive'Min (Choices.Last_Index, + Page_Start + Page_Size - 1); + + -- Print the choices proper + + for I in Page_Start .. Page_End loop + TIO.Put_Line + (" " + & (if I = Page_Start + then TTY.Bold ("" & Answers (I - Page_Start + 1)) + else TTY.Emph ("" & Answers (I - Page_Start + 1))) + & ". " & Choices (I)); + end loop; + + -- And the pager if needed + + if Use_Pager then + TIO.Put_Line (TTY.Emph (" " & Answers (Page_End - Page_Start + 2)) + & ". (See more choices...)"); + end if; + end Print_Choices; + + begin + loop + begin + TIO.Put_Line (Question); + + if Not_Interactive then + Put_Info ("Using default choice in non-interactive mode: " + & Choices.First_Element); + Trace.Warning (Alire.Is_TTY'Image); + return Choices.First_Index; + end if; + + -- Flush the input that the user may have entered by mistake + -- before the question is asked. + Flush_TTY; + + Print_Choices; + TIO.Put_Line ("Enter your choice index (first is default): "); + TIO.Put ("> "); + + declare + Answer_Line : constant String := TIO.Get_Line; + Answer_Char : Character; + Answer_Pos : Natural := 0; + Extra : constant Natural := (if Use_Pager then 1 else 0); + -- We have an extra entry in the list in this case + begin + if Answer_Line = "" then + return Page_Start; + elsif Answer_Line'Length > 1 then + raise Checked_Error with "answer too long"; + end if; + + Answer_Char := Answer_Line (Answer_Line'First); + + -- Find the user's choice, and correct it with the actual page + -- we are showing to them. + + for I in Answers'Range loop + if Answer_Char = Answers (I) then + Answer_Pos := I; + end if; + end loop; + + if Answer_Pos = 0 then + raise Checked_Error with "Choice out of range"; + end if; + + Answer_Pos := Answer_Pos + Page_Start - 1; + + if Answer_Pos not in Page_Start .. Page_End + Extra + then + raise Checked_Error with "Choice out of range"; + end if; + + -- We have a valid choice; either change pages or return choice + if Answer_Pos = Page_End + 1 then + Page_Start := Page_Start + Page_Size; + if Page_Start > Choices.Last_Index then + Page_Start := Choices.First_Index; + end if; + else + return Answer_Pos; + end if; + end; + exception + when E : TIO.End_Error => + -- This happens on the user hitting Ctrl-D, and no further + -- input can be obtained as stdin is closed + Log_Exception (E); + Raise_Checked_Error ("Canceled."); + when others => + Put_Failure ("Not a valid choice, please use a line index."); + end; + end loop; + end Query_Multi; + --------- -- Img -- --------- diff --git a/src/alire/alire-utils-user_input.ads b/src/alire/alire-utils-user_input.ads index 667fc751..d23ec66d 100644 --- a/src/alire/alire-utils-user_input.ads +++ b/src/alire/alire-utils-user_input.ads @@ -23,6 +23,14 @@ package Alire.Utils.User_Input is -- If interactive, ask the user for one of the valid answer. -- Otherwise return the Default answer. + function Query_Multi (Question : String; + Choices : String_Vector; + Page_Size : Positive := 10) + return Positive + with Pre => Page_Size >= 2 and then Page_Size < 36; + -- Present the Choices in a numbered list 1-9-0-a-z, with paging if + -- Choices.Length > Page_Size. Default is always First of Choices. + type Answer_With_Input (Length : Natural) is record Input : String (1 .. Length); Answer : Answer_Kind; @@ -35,7 +43,6 @@ package Alire.Utils.User_Input is Default : access function (User_Input : String) return Answer_Kind; Confirm : String := "Is this information correct?"; Is_Valid : access function (User_Input : String) return Boolean) - return Answer_With_Input; -- Interactive prompt for information from the user, with confirmation: -- Put_Line (Question) diff --git a/src/alire/alire-utils.ads b/src/alire/alire-utils.ads index ba9751e1..ffdea4b8 100644 --- a/src/alire/alire-utils.ads +++ b/src/alire/alire-utils.ads @@ -8,6 +8,9 @@ private with Ada.Strings.Maps; package Alire.Utils with Preelaborate is + subtype Hexadecimal_Character is Character with + Static_Predicate => Hexadecimal_Character in '0' .. '9' | 'a' .. 'f'; + function Command_Line_Contains (Prefix : String) return Boolean; -- Say if any of the command-line arguments begins with Prefix. This is -- needed for string arguments, that even when not supplied are initialized diff --git a/src/alire/alire-vcss-git.adb b/src/alire/alire-vcss-git.adb index acf7b35d..038eba8d 100644 --- a/src/alire/alire-vcss-git.adb +++ b/src/alire/alire-vcss-git.adb @@ -6,8 +6,6 @@ with Alire.Utils.TTY; package body Alire.VCSs.Git is - subtype Git_Commit is String (1 .. 40); - ------------- -- Run_Git -- ------------- @@ -281,8 +279,8 @@ package body Alire.VCSs.Git is -- Once here is reached, the Ref is ready for comparison declare - Not_Found : constant Git_Commit := (others => 'x'); - Result : Git_Commit := Not_Found; + Not_Found : constant String (Git_Commit'Range) := (others => 'x'); + Result : String := Not_Found; begin for Line of Output loop if Ends_With (Line, Ref) then @@ -298,7 +296,7 @@ package body Alire.VCSs.Git is if Result = Not_Found then return ""; else - return Result; + return Git_Commit (Result); -- Contents check end if; end; end Remote_Commit; diff --git a/src/alire/alire-vcss-git.ads b/src/alire/alire-vcss-git.ads index e7904a71..387aa20e 100644 --- a/src/alire/alire-vcss-git.ads +++ b/src/alire/alire-vcss-git.ads @@ -5,6 +5,14 @@ package Alire.VCSs.Git is Known_Transformable_Hosts : constant Utils.String_Vector; -- Known hosts that honor the git@ --> https:// transformation + subtype Git_Commit is String (1 .. 40) with + Dynamic_Predicate => + (for all Char of Git_Commit => Char in Hexadecimal_Character); + + function Is_Valid_Commit (S : String) return Boolean + is (S'Length = Git_Commit'Length and then + (for all Char of S => Char in Utils.Hexadecimal_Character)); + type VCS (<>) is new VCSs.VCS with private; function Handler return VCS; diff --git a/src/alire/alire-vcss-hg.ads b/src/alire/alire-vcss-hg.ads index 9472e6c5..0f541a5d 100644 --- a/src/alire/alire-vcss-hg.ads +++ b/src/alire/alire-vcss-hg.ads @@ -1,5 +1,7 @@ package Alire.VCSs.Hg is + subtype Hg_Commit is String (1 .. 40); + type VCS (<>) is new VCSs.VCS with private; function Handler return VCS; diff --git a/src/alire/alire.adb b/src/alire/alire.adb index 94b7eea9..1e1e1a16 100644 --- a/src/alire/alire.adb +++ b/src/alire/alire.adb @@ -237,11 +237,14 @@ package body Alire is ----------------------- procedure Recoverable_Error (Msg : String; Recover : Boolean := Force) is + use Alire.Utils; + Info : constant String := " (This error can be overridden with " + & TTY.Terminal ("--force") & ".)"; begin if Recover then Warnings.Warn_Once (Msg); else - Raise_Checked_Error (Msg); + Raise_Checked_Error (Msg & Info); end if; end Recoverable_Error; diff --git a/src/alire/alire.ads b/src/alire/alire.ads index 5c6108dc..89d8164a 100644 --- a/src/alire/alire.ads +++ b/src/alire/alire.ads @@ -9,7 +9,7 @@ with Simple_Logging; package Alire with Preelaborate is - Version : constant String := "1.1.0-dev+pincmdline"; + Version : constant String := "1.1.0-dev+toolchain"; -- 1.1.0-dev: begin post-1.0 changes -- 1.0.0: no changes since rc3 -- 1.0.0-rc3: added help colors PR @@ -270,6 +270,14 @@ package Alire with Preelaborate is -- the opposite of Put_Success when it makes sense to continue, albeit -- briefly, without emitting a final error with Raise_Checked_Error. + --------------- + -- Constants -- + --------------- + + GNAT_Crate : constant Crate_Name; + GNAT_External_Crate : constant Crate_Name; + GPRbuild_Crate : constant Crate_Name; + private type Crate_Name (Len : Natural) is tagged record @@ -305,4 +313,10 @@ private function Detailed return Boolean is (Log_Level >= Detail); + GNAT_Crate : constant Crate_Name := (Len => 4, Name => "gnat"); + GPRbuild_Crate : constant Crate_Name := (Len => 8, Name => "gprbuild"); + + GNAT_External_Crate : constant Crate_Name := + (Len => 13, Name => "gnat_external"); + end Alire; diff --git a/src/alire/os_windows/alire-platform.adb b/src/alire/os_windows/alire-platform.adb index f654751d..acd9e01e 100644 --- a/src/alire/os_windows/alire-platform.adb +++ b/src/alire/os_windows/alire-platform.adb @@ -1,6 +1,7 @@ with Ada.Directories; with GNAT.OS_Lib; +with Alire.Environment; with Alire.Utils; with Alire.OS_Lib; use Alire.OS_Lib; with Alire.OS_Lib.Subprocess; diff --git a/src/alr/alr-commands-help.adb b/src/alr/alr-commands-help.adb index 6b50549f..37264850 100644 --- a/src/alr/alr-commands-help.adb +++ b/src/alr/alr-commands-help.adb @@ -2,6 +2,7 @@ with AAA.Enum_Tools; with AAA.Text_IO; with Alire.Crates; +with Alire.Toolchains; with Alire.Utils.Tables; with Alire.Utils.TTY; @@ -9,7 +10,8 @@ package body Alr.Commands.Help is package TTY renames Alire.Utils.TTY; - type Help_Topics is (Identifiers); + type Help_Topics is (Identifiers, + Toolchains); -- Enumeration used to index available help topics. ----------------------- @@ -18,7 +20,8 @@ package body Alr.Commands.Help is function One_Liner_Summary (Topic : Help_Topics) return String is (case Topic is - when Identifiers => "Naming rules for crate and index names" + when Identifiers => "Naming rules for crate and index names", + when Toolchains => "Configuration and use of toolchains" ); ----------------- @@ -31,7 +34,9 @@ package body Alr.Commands.Help is is (case Topic is when Identifiers => - Alire.Crates.Naming_Convention + Alire.Crates.Naming_Convention, + when Toolchains => + Alire.Toolchains.Description ); ------------------ @@ -64,7 +69,7 @@ package body Alr.Commands.Help is elsif Is_Topic (Keyword) then Put_Line (TTY.Bold (Help_Topics'Value (Keyword)'Img)); - Format (Description (Identifiers)); + Format (Description (Help_Topics'Value (Keyword))); else Trace.Error ("No help found for: " & Keyword); diff --git a/src/alr/alr-commands-search.adb b/src/alr/alr-commands-search.adb index 4832b6c7..d6c45124 100644 --- a/src/alr/alr-commands-search.adb +++ b/src/alr/alr-commands-search.adb @@ -1,8 +1,7 @@ -with Alire.Containers; with Alire.Externals; with Alire.Index.Search; -with Alire.Crates; -with Alire.Releases; +with Alire.Crates.Containers; +with Alire.Releases.Containers; with Alire.Solutions; with Alire.Solver; with Alire.Utils.Tables; @@ -89,7 +88,7 @@ package body Alr.Commands.Search is Tab.Append (Ext.Image); end List_Undetected; - use Alire.Containers.Release_Sets; + use Alire.Releases.Containers.Release_Sets; begin -- First, simpler case of search into crates @@ -223,9 +222,20 @@ package body Alr.Commands.Search is -- List releases Trace.Detail ("Searching..."); - for Crate of Alire.Index.All_Crates.all loop - List_Crate (Crate); - end loop; + declare + I : Alire.Crates.Containers.Maps.Cursor := + Alire.Index.All_Crates.First; + use Alire.Crates.Containers.Maps; + begin + -- Cursor-based iteration because external detection during + -- listing may cause addition of new crates, and this triggers + -- tampering checks in some compiler versions. + + while Has_Element (I) loop + List_Crate (Element (I)); + Next (I); + end loop; + end; else -- Search into releases diff --git a/src/alr/alr-commands-show.adb b/src/alr/alr-commands-show.adb index 734c4221..ea47f238 100644 --- a/src/alr/alr-commands-show.adb +++ b/src/alr/alr-commands-show.adb @@ -4,7 +4,7 @@ with Alire.Index; with Alire.Milestones; with Alire.Platform; with Alire.Platforms; -with Alire.Releases; +with Alire.Releases.Containers; with Alire.Root; with Alire.Roots.Optional; with Alire.Solutions; @@ -40,10 +40,21 @@ package body Alr.Commands.Show is declare -- Nested so a failure in Query.Find is caught below - Rel : constant Alire.Releases.Release := + Candidates : constant Alire.Releases.Containers.Release_Set := (if Current - then Cmd.Root.Release - else Query.Find (Name, Versions, Query_Policy)); + then Alire.Releases.Containers.To_Set + (Cmd.Root.Release) + else Alire.Index.Releases_Satisfying + (Alire.Dependencies.New_Dependency + (Name, Versions), + Platform.Properties, + Use_Equivalences => False, + Available => False)); + + Rel : constant Alire.Releases.Release := + (if Candidates.Is_Empty + then raise Alire.Query_Unsuccessful + else Candidates.Last_Element); -- Last is newest begin if Cmd.System then Rel.Whenever (Platform.Properties).Print; @@ -260,8 +271,8 @@ package body Alr.Commands.Show is end if; exception when Alire.Query_Unsuccessful => - Trace.Info ("Crate [" & (+Allowed.Crate) & - "] does not exist in the index"); + Reportaise_Command_Failed + ("Crate " & Allowed.TTY_Image & " does not exist in the index"); end; end Execute; diff --git a/src/alr/alr-commands-test.adb b/src/alr/alr-commands-test.adb index 95d9d91c..5ec65f56 100644 --- a/src/alr/alr-commands-test.adb +++ b/src/alr/alr-commands-test.adb @@ -2,7 +2,6 @@ with Ada.Calendar; with Ada.Directories; with Ada.Exceptions; -with Alire.Containers; with Alire.Crates; with Alire.Defaults; with Alire.Dependencies; @@ -11,7 +10,7 @@ with Alire.Index; with Alire.Milestones; with Alire.OS_Lib.Subprocess; with Alire.Properties.Actions.Executor; -with Alire.Releases; +with Alire.Releases.Containers; with Alire.Solutions; with Alire.Solver; with Alire.Utils; @@ -76,9 +75,10 @@ package body Alr.Commands.Test is -- Do_Test -- ------------- - procedure Do_Test (Cmd : Command; - Releases : Alire.Containers.Release_Sets.Set; - Docker_Image : String) + procedure Do_Test + (Cmd : Command; + Releases : Alire.Releases.Containers.Release_Sets.Set; + Docker_Image : String) is use Ada.Calendar; use GNATCOLL.VFS; @@ -363,14 +363,14 @@ package body Alr.Commands.Test is raise Command_Failed; end Not_Empty; - Candidates : Alire.Containers.Release_Sets.Set; + Candidates : Alire.Releases.Containers.Release_Sets.Set; Docker_Image : constant String := (if Cmd.Docker.all = "" then Alire.Defaults.Docker_Test_Image else Utils.Replace (Cmd.Docker.all, "=", "")); - use Alire.Containers.Release_Sets; + use Alire.Releases.Containers.Release_Sets; --------------------- -- Find_Candidates -- @@ -413,7 +413,7 @@ package body Alr.Commands.Test is Alire.Dependencies.From_String (Argument (J)); Crate : constant Alire.Crates.Crate := Alire.Index.Crate (Allowed.Crate); - Releases : constant Alire.Containers.Release_Set := + Releases : constant Alire.Releases.Containers.Release_Set := Crate.Releases; begin for I in Releases.Iterate loop diff --git a/src/alr/alr-commands-toolchain.adb b/src/alr/alr-commands-toolchain.adb new file mode 100644 index 00000000..60681e11 --- /dev/null +++ b/src/alr/alr-commands-toolchain.adb @@ -0,0 +1,249 @@ +with AAA.Table_IO; + +with Alire.Config.Edit; +with Alire.Dependencies; +with Alire.Errors; +with Alire.Milestones; +with Alire.Releases.Containers; +with Alire.Shared; +with Alire.Solver; +with Alire.Toolchains; +with Alire.Utils; + +with Semantic_Versioning.Extended; + +package body Alr.Commands.Toolchain is + + -------------------- + -- Setup_Switches -- + -------------------- + + overriding + procedure Setup_Switches + (Cmd : in out Command; + Config : in out GNAT.Command_Line.Command_Line_Configuration) + is + use GNAT.Command_Line; + begin + Define_Switch + (Config, + Cmd.Install'Access, + Switch => "-i", + Long_Switch => "--install", + Help => "Install a toolchain component"); + + Define_Switch + (Config, + Cmd.S_Select'Access, + Switch => "", + Long_Switch => "--select", + Help => "Run the toolchain selection assistant"); + + Define_Switch + (Config, + Cmd.Uninstall'Access, + Switch => "-u", + Long_Switch => "--uninstall", + Help => "Uninstall a toolchain component"); + end Setup_Switches; + + ------------- + -- Install -- + ------------- + + procedure Install (Cmd : in out Command; Request : String) is + use Alire; + begin + Cmd.Requires_Full_Index; + + Installation : + declare + Dep : constant Dependencies.Dependency := + Dependencies.From_String (Request); + Rel : constant Releases.Release := + Solver.Find (Name => Dep.Crate, + Allowed => Dep.Versions, + Policy => Query_Policy); + begin + + -- Only allow sharing toolchain elements in this command: + + if not (for some Crate of Alire.Toolchains.Tools => + Rel.Provides (Crate)) + then + Reportaise_Wrong_Arguments + ("The requested crate is not a toolchain component"); + end if; + + -- Inform of how the requested crate has been narrowed down + + if not Alire.Utils.Starts_With (Dep.Versions.Image, "=") then + Put_Info ("Requested crate resolved as " + & Rel.Milestone.TTY_Image); + end if; + + -- And perform the actual installation + + Shared.Share (Rel); + + end Installation; + + exception + when E : Alire.Query_Unsuccessful => + Alire.Log_Exception (E); + Trace.Error (Alire.Errors.Get (E)); + end Install; + + ---------- + -- List -- + ---------- + + procedure List (Cmd : in out Command) is + use Alire; + use type Dependencies.Dependency; + Table : AAA.Table_IO.Table; + begin + Cmd.Requires_Full_Index; + + if Alire.Shared.Available.Is_Empty then + Trace.Info ("Nothing installed in configuration prefix " + & TTY.URL (Alire.Config.Edit.Path)); + return; + end if; + + Table + .Append (TTY.Emph ("CRATE")) + .Append (TTY.Emph ("VERSION")) + .Append (TTY.Emph ("STATUS")) + .Append (TTY.Emph ("NOTES")) + .New_Row; + + for Dep of Alire.Shared.Available loop + if (for some Crate of Toolchains.Tools => + Dep.Provides (Crate)) + then + declare + Tool : constant Crate_Name := + (if Dep.Provides (GNAT_Crate) + then GNAT_Crate + else Dep.Name); + begin + Table + .Append (TTY.Name (Dep.Name)) + .Append (TTY.Version (Dep.Version.Image)) + .Append (if Toolchains.Tool_Is_Configured (Tool) + and then Dep.To_Dependency.Value = + Toolchains.Tool_Dependency (Tool) + then TTY.Description ("Default") + else "Available") + .Append (TTY.Dim (Dep.Notes)) + .New_Row; + end; + end if; + end loop; + + Table.Print; + end List; + + --------------- + -- Uninstall -- + --------------- + + procedure Uninstall (Cmd : in out Command; Target : String) is + + ------------------ + -- Find_Version -- + ------------------ + + function Find_Version return String is + -- Obtain all installed releases for the crate; we will proceed if + -- only one exists. + Available : constant Alire.Releases.Containers.Release_Set := + Alire.Shared.Available.Satisfying + (Alire.Dependencies.New_Dependency + (Crate => Alire.To_Name (Target), + Versions => Semantic_Versioning.Extended.Any)); + begin + if Available.Is_Empty then + Reportaise_Command_Failed + ("Requested crate has no installed releases: " + & TTY.Name (Target)); + elsif Available.Length not in 1 then + Reportaise_Command_Failed + ("Requested crate has several installed releases, " + & "please provide an exact target version"); + end if; + + return Available.First_Element.Milestone.Version.Image; + end Find_Version; + + begin + Cmd.Requires_Full_Index; + + -- If no version was given, find if only one is installed + + if not Utils.Contains (Target, "=") then + Uninstall (Cmd, Target & "=" & Find_Version); + return; + end if; + + -- Otherwise we proceed with a complete milestone + + Alire.Shared.Remove (Alire.Milestones.New_Milestone (Target)); + + end Uninstall; + + ------------- + -- Execute -- + ------------- + + overriding + procedure Execute (Cmd : in out Command) is + begin + + -- Validation + + if Cmd.Uninstall and then Cmd.S_Select then + Reportaise_Wrong_Arguments + ("The provided switches cannot be used simultaneously"); + end if; + + if Num_Arguments > 1 then + Reportaise_Wrong_Arguments + ("One crate with optional version expected: crate[version set]"); + end if; + + if (Cmd.Install or Cmd.Uninstall) and then Num_Arguments /= 1 then + Reportaise_Wrong_Arguments ("No release specified"); + end if; + + if Num_Arguments = 1 and then not (Cmd.Install or Cmd.Uninstall) then + Reportaise_Wrong_Arguments + ("Specify the action to perform with the crate"); + end if; + + if Cmd.S_Select and then Num_Arguments /= 0 then + Reportaise_Wrong_Arguments + ("Toolchain installation does not accept any arguments"); + end if; + + -- Dispatch to subcommands + + if Cmd.S_Select then + Cmd.Requires_Full_Index; + Alire.Toolchains.Assistant; + elsif Cmd.Uninstall then + Uninstall (Cmd, Argument (1)); + elsif Cmd.Install then + Install (Cmd, Argument (1)); + else + Cmd.List; + end if; + + exception + when E : Semantic_Versioning.Malformed_Input => + Alire.Log_Exception (E); + Reportaise_Wrong_Arguments ("Improper version specification"); + end Execute; + +end Alr.Commands.Toolchain; diff --git a/src/alr/alr-commands-toolchain.ads b/src/alr/alr-commands-toolchain.ads new file mode 100644 index 00000000..5b38cdd8 --- /dev/null +++ b/src/alr/alr-commands-toolchain.ads @@ -0,0 +1,61 @@ +with Alire.TTY; + +package Alr.Commands.Toolchain is + + package TTY renames Alire.TTY; + + -- Installation of binary toolchain crates into the ${ALR_CONFIG}/cache + -- shared configuration. + + type Command is new Commands.Command with private; + + overriding + procedure Execute (Cmd : in out Command); + + overriding + function Long_Description (Cmd : Command) + return Alire.Utils.String_Vector + is (Alire.Utils.Empty_Vector + .Append + ("Download toolchain elements, like" & " " & TTY.Emph ("GNAT") + & " and " & TTY.Emph ("gprbuid") & ", in the shared cache of the" + & " active configuration.") + .New_Line + .Append + ("Run it without arguments to get a list of downloaded tools.") + .New_Line + .Append + ("Use --select without arguments to run the assistant to " + & "select the default toolchain for this configuration.") + .New_Line + .Append + ("Specify --install/--uninstall and a crate name with optional " + & "version set to make available or remove a tool.") + .New_Line + .Append + ("Run `" & TTY.Terminal ("alr help toolchains") & "` for further " + & "information about toolchain management and use.") + ); + + overriding + procedure Setup_Switches + (Cmd : in out Command; + Config : in out GNAT.Command_Line.Command_Line_Configuration); + + overriding + function Short_Description (Cmd : Command) return String + is ("Manage Alire-provided toolchains"); + + overriding + function Usage_Custom_Parameters (Cmd : Command) return String + is ("[-u|--uninstall] [-i|--install crate[version set]] | --select"); + +private + + type Command is new Commands.Command with record + Install : aliased Boolean := False; + S_Select : aliased Boolean := False; + Uninstall : aliased Boolean := False; + end record; + +end Alr.Commands.Toolchain; diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index fa928b16..bd9dc6c0 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -8,7 +8,6 @@ with Ada.Strings.Unbounded; with Ada.Text_IO; use Ada.Text_IO; with Alire_Early_Elaboration; -with Alire; with Alire.Config.Edit; with Alire.Errors; with Alire.Features.Index; @@ -17,6 +16,7 @@ with Alire.Paths; with Alire.Platforms; with Alire.Root; with Alire.Solutions; +with Alire.Toolchains; with Alire.Utils.Tables; with Alire.Utils.TTY; with Alire.Utils.User_Input; @@ -37,6 +37,7 @@ with Alr.Commands.Run; with Alr.Commands.Search; with Alr.Commands.Show; with Alr.Commands.Test; +with Alr.Commands.Toolchain; with Alr.Commands.Update; with Alr.Commands.Version; with Alr.Commands.Withing; @@ -61,25 +62,26 @@ package body Alr.Commands is type Command_Access is access Command'Class; Dispatch_Table : constant array (Cmd_Names) of Command_Access := - (Cmd_Build => new Build.Command, - Cmd_Clean => new Clean.Command, - Cmd_Config => new Config.Command, - Cmd_Dev => new Dev.Command, - Cmd_Edit => new Edit.Command, - Cmd_Get => new Get.Command, - Cmd_Help => new Help.Command, - Cmd_Index => new Index.Command, - Cmd_Init => new Init.Command, - Cmd_Pin => new Pin.Command, - Cmd_Printenv => new Printenv.Command, - Cmd_Publish => new Publish.Command, - Cmd_Run => new Run.Command, - Cmd_Search => new Search.Command, - Cmd_Show => new Show.Command, - Cmd_Test => new Test.Command, - Cmd_Update => new Update.Command, - Cmd_Version => new Version.Command, - Cmd_With => new Withing.Command); + (Cmd_Build => new Build.Command, + Cmd_Clean => new Clean.Command, + Cmd_Config => new Config.Command, + Cmd_Dev => new Dev.Command, + Cmd_Edit => new Edit.Command, + Cmd_Get => new Get.Command, + Cmd_Help => new Help.Command, + Cmd_Index => new Index.Command, + Cmd_Init => new Init.Command, + Cmd_Pin => new Pin.Command, + Cmd_Printenv => new Printenv.Command, + Cmd_Publish => new Publish.Command, + Cmd_Run => new Run.Command, + Cmd_Search => new Search.Command, + Cmd_Show => new Show.Command, + Cmd_Test => new Test.Command, + Cmd_Toolchain => new Toolchain.Command, + Cmd_Update => new Update.Command, + Cmd_Version => new Version.Command, + Cmd_With => new Withing.Command); Command_Line_Config_Path : aliased GNAT.OS_Lib.String_Access; @@ -545,6 +547,8 @@ package body Alr.Commands is Manual_Only : constant Boolean := Alire.Config.Get (Alire.Config.Keys.Update_Manually, False); + + package Conf renames Alire.Config; begin -- If the root has been already loaded, then all following checks have @@ -555,6 +559,11 @@ package body Alr.Commands is return; end if; + if Conf.Get (Conf.Keys.Toolchain_Assistant, Default => True) then + Cmd.Requires_Full_Index; + Alire.Toolchains.Assistant; + end if; + Trace.Debug ("Workspace is being checked and loaded for the first time"); Unchecked := Alire.Root.Current; diff --git a/src/alr/alr-commands.ads b/src/alr/alr-commands.ads index d29ef866..82cc2205 100644 --- a/src/alr/alr-commands.ads +++ b/src/alr/alr-commands.ads @@ -138,6 +138,7 @@ package Alr.Commands is Cmd_Search, Cmd_Show, Cmd_Test, + Cmd_Toolchain, Cmd_Update, Cmd_Version, Cmd_With); @@ -158,22 +159,23 @@ package Alr.Commands is function Image (Name : Group_Names) return String; Group_Commands : constant array (Cmd_Names) of Group_Names := - (Cmd_Config | - Cmd_Help | - Cmd_Printenv | + (Cmd_Config | + Cmd_Help | + Cmd_Printenv | + Cmd_Toolchain | Cmd_Version => Group_General, Cmd_Build | Cmd_Clean | - Cmd_Dev | - Cmd_Edit | - Cmd_Run | + Cmd_Dev | + Cmd_Edit | + Cmd_Run | Cmd_Test => Group_Build, Cmd_Index => Group_Index, - Cmd_Get | - Cmd_Init | - Cmd_Pin | + Cmd_Get | + Cmd_Init | + Cmd_Pin | Cmd_Search | - Cmd_Show | + Cmd_Show | Cmd_Update | Cmd_With => Group_Release, Cmd_Publish => Group_Publish); diff --git a/testsuite/drivers/alr.py b/testsuite/drivers/alr.py index f4da8204..75e86ff3 100644 --- a/testsuite/drivers/alr.py +++ b/testsuite/drivers/alr.py @@ -38,6 +38,12 @@ def prepare_env(config_dir, env): mkdir(config_dir) env['ALR_CONFIG'] = config_dir + # Disable selection of toolchain to preserve older behavior. Tests that + # require a configured compiler will have to set it up explicitly. + run_alr("config", "--global", "--set", "toolchain.assistant", "false", + "-c", config_dir) + # Pass config location explicitly since env is not yet applied + # If distro detection is disabled via environment, configure so in alr if "ALIRE_DISABLE_DISTRO" in env: if env["ALIRE_DISABLE_DISTRO"] == "true": @@ -346,14 +352,19 @@ def alr_with(dep="", path="", url="", commit="", branch="", if manual and dep == "": raise RuntimeError("Cannot manually add without explicit dependency") - separators = "=^~<>*" + separators = "/=^~<>*" # Fix the dependency if no version subset is in dep if manual and not any([separator in dep for separator in separators]): dep += "*" # Find the separator position - pos = max([dep.find(separator) for separator in separators]) + pos = len(dep) + 1 + for separator in separators: + idx = dep.find(separator) + pos = idx if 0 < idx < pos else pos + if manual and pos > len(dep): + raise RuntimeError(f"Should not happen, dep is {dep}") if manual: if delete: diff --git a/testsuite/drivers/asserts.py b/testsuite/drivers/asserts.py index 549eb36b..6d22ca57 100644 --- a/testsuite/drivers/asserts.py +++ b/testsuite/drivers/asserts.py @@ -6,6 +6,7 @@ testcases based on Python scripts. import re import difflib +from drivers.alr import run_alr def indent(text, prefix=' '): """ @@ -46,3 +47,13 @@ def assert_match(expected_re, actual, label=None, flags=re.S): 'But got:', indent(actual)] assert False, '\n'.join(text) + + +def match_solution(regex, escape=False, whole=False): + "Check whether a regex matches the current solution" + p = run_alr("with", "--solve") + wrap = "" if whole else ".*" + assert_match(wrap + + (regex if not escape else re.escape(regex)) + + wrap, + p.out) diff --git a/testsuite/drivers/helpers.py b/testsuite/drivers/helpers.py index 7678c2e3..6d4097da 100644 --- a/testsuite/drivers/helpers.py +++ b/testsuite/drivers/helpers.py @@ -5,6 +5,7 @@ Assorted helpers that are reused by several tests. from subprocess import run from zipfile import ZipFile +import re import os import platform import shutil @@ -12,11 +13,17 @@ import stat # Return the entries (sorted) under a given folder, both folders and files -def contents(dir): +# Optionally, return only those matching regex +def contents(dir, regex=""): assert os.path.exists(dir), "Bad path for enumeration: {}".format(dir) - return sorted([os.path.join(root, name).replace('\\', '/') for - root, dirs, files in os.walk(dir) - for name in dirs + files]) + if regex != "": + matcher = re.compile(regex) + return sorted([os.path.join(root, name).replace('\\', '/') + for root, dirs, files in os.walk(dir) + for name in dirs + files + if regex == "" or + matcher.search(os.path.join(root, name).replace('\\', '/')) + ]) # Return the content of a text file as a single string with embedded newlines diff --git a/testsuite/fix-versions.sh b/testsuite/fix-versions.sh index ede72b7e..8a19f0d2 100755 --- a/testsuite/fix-versions.sh +++ b/testsuite/fix-versions.sh @@ -1,6 +1,6 @@ #!/bin/bash -oldversion=0.4 -newversion=1.0 +oldversion=1.0 +newversion=1.1 find . -type f -name index.toml -exec sed -i "s/$oldversion/$newversion/" {} \; diff --git a/testsuite/fixtures/basic_index/index.toml b/testsuite/fixtures/basic_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/fixtures/basic_index/index.toml +++ b/testsuite/fixtures/basic_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/fixtures/cases_index/index.toml b/testsuite/fixtures/cases_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/fixtures/cases_index/index.toml +++ b/testsuite/fixtures/cases_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/fixtures/checked_index/index.toml b/testsuite/fixtures/checked_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/fixtures/checked_index/index.toml +++ b/testsuite/fixtures/checked_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/fixtures/git_index/index.toml b/testsuite/fixtures/git_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/fixtures/git_index/index.toml +++ b/testsuite/fixtures/git_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/fixtures/native_index/index.toml b/testsuite/fixtures/native_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/fixtures/native_index/index.toml +++ b/testsuite/fixtures/native_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/fixtures/run_index/index.toml b/testsuite/fixtures/run_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/fixtures/run_index/index.toml +++ b/testsuite/fixtures/run_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/fixtures/solver_index/index.toml b/testsuite/fixtures/solver_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/fixtures/solver_index/index.toml +++ b/testsuite/fixtures/solver_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/fixtures/toolchain_index/cr/crate_clash/crate_clash-1.0.0.toml b/testsuite/fixtures/toolchain_index/cr/crate_clash/crate_clash-1.0.0.toml new file mode 100644 index 00000000..6463f7d3 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/cr/crate_clash/crate_clash-1.0.0.toml @@ -0,0 +1,10 @@ +description = "A crate that supplies another crate" +name = "crate_clash" +version = "1.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["crate_virtual=1.0"] + +[origin] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/cr/crate_equiv/crate_equiv-2.0.0.toml b/testsuite/fixtures/toolchain_index/cr/crate_equiv/crate_equiv-2.0.0.toml new file mode 100644 index 00000000..88175937 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/cr/crate_equiv/crate_equiv-2.0.0.toml @@ -0,0 +1,10 @@ +description = "A crate that supplies another crate" +name = "crate_equiv" +version = "2.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["crate_virtual=1.0", "crate_lone=1.0"] + +[origin] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/cr/crate_lone/crate_lone-1.0.0.toml b/testsuite/fixtures/toolchain_index/cr/crate_lone/crate_lone-1.0.0.toml new file mode 100644 index 00000000..4278bcf5 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/cr/crate_lone/crate_lone-1.0.0.toml @@ -0,0 +1,12 @@ +description = "A crate" +name = "crate_lone" +version = "1.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["crate_virtual=1.0"] + +available = false + +[origin] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/cr/crate_lone/crate_lone-2.0.0.toml b/testsuite/fixtures/toolchain_index/cr/crate_lone/crate_lone-2.0.0.toml new file mode 100644 index 00000000..7aa0c610 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/cr/crate_lone/crate_lone-2.0.0.toml @@ -0,0 +1,10 @@ +description = "A crate" +name = "crate_lone" +version = "2.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["crate_virtual=1.0"] + +[origin] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/gn/gnat_cross_1/gnat_cross_1-1.0.0.toml b/testsuite/fixtures/toolchain_index/gn/gnat_cross_1/gnat_cross_1-1.0.0.toml new file mode 100644 index 00000000..d425d412 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/gn/gnat_cross_1/gnat_cross_1-1.0.0.toml @@ -0,0 +1,11 @@ +description = "Fake GNAT cross-target crate (1)" +name = "gnat_cross_1" +version = "1.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["gnat=1.0"] + +# Test dynamic expression, but for all OSes +[origin."case(os)"."..."] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/gn/gnat_cross_1/gnat_cross_1-9999.0.0.toml b/testsuite/fixtures/toolchain_index/gn/gnat_cross_1/gnat_cross_1-9999.0.0.toml new file mode 100644 index 00000000..1b180d43 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/gn/gnat_cross_1/gnat_cross_1-9999.0.0.toml @@ -0,0 +1,11 @@ +description = "Fake GNAT cross-target crate (1)" +name = "gnat_cross_1" +version = "9999.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["gnat=9999.0"] + +# Test dynamic expression, but for all OSes +[origin."case(os)"."..."] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/gn/gnat_cross_2/gnat_cross_2-1.0.0.toml b/testsuite/fixtures/toolchain_index/gn/gnat_cross_2/gnat_cross_2-1.0.0.toml new file mode 100644 index 00000000..26b40935 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/gn/gnat_cross_2/gnat_cross_2-1.0.0.toml @@ -0,0 +1,11 @@ +description = "Fake GNAT cross crate (2)" +name = "gnat_cross_2" +version = "1.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["gnat=1.0"] + +# Test dynamic expression, but for all OSes +[origin."case(os)"."..."] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/gn/gnat_external/gnat_external-external.toml b/testsuite/fixtures/toolchain_index/gn/gnat_external/gnat_external-external.toml new file mode 100644 index 00000000..f1171a6b --- /dev/null +++ b/testsuite/fixtures/toolchain_index/gn/gnat_external/gnat_external-external.toml @@ -0,0 +1,12 @@ +description = "GNAT is a compiler for the Ada programming language" +name = "gnat_external" + +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mosteo"] + +[[external]] +kind = "version-output" +# We look for make instead that should be always installed. +version-command = ["make", "--version"] +version-regexp = ".*Make ([\\d\\.]+).*" +provides = "gnat" diff --git a/testsuite/fixtures/toolchain_index/gn/gnat_native/gnat_native-1.0.0.toml b/testsuite/fixtures/toolchain_index/gn/gnat_native/gnat_native-1.0.0.toml new file mode 100644 index 00000000..3852851c --- /dev/null +++ b/testsuite/fixtures/toolchain_index/gn/gnat_native/gnat_native-1.0.0.toml @@ -0,0 +1,11 @@ +description = "Fake GNAT native crate" +name = "gnat_native" +version = "1.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["gnat=1.0"] + +# Test dynamic expression, but for all OSes +[origin."case(os)"."..."] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/gn/gnat_native/gnat_native-2.0.0.toml b/testsuite/fixtures/toolchain_index/gn/gnat_native/gnat_native-2.0.0.toml new file mode 100644 index 00000000..39438d36 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/gn/gnat_native/gnat_native-2.0.0.toml @@ -0,0 +1,11 @@ +description = "Fake GNAT native crate" +name = "gnat_native" +version = "2.0.0" +maintainers = ["alejandro@mosteo.com"] +maintainers-logins = ["mylogin"] +provides = ["gnat=2.0"] + +# Test dynamic expression, but for all OSes +[origin."case(os)"."..."] +url = "file:../../../crates/libhello_1.0.0.tgz" +hashes = ["sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac"] diff --git a/testsuite/fixtures/toolchain_index/index.toml b/testsuite/fixtures/toolchain_index/index.toml new file mode 100644 index 00000000..bad265e4 --- /dev/null +++ b/testsuite/fixtures/toolchain_index/index.toml @@ -0,0 +1 @@ +version = "1.1" diff --git a/testsuite/skels/local-index/my_index/index/index.toml b/testsuite/skels/local-index/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/skels/local-index/my_index/index/index.toml +++ b/testsuite/skels/local-index/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/crate_config/basic/my_index/index/index.toml b/testsuite/tests/crate_config/basic/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/crate_config/basic/my_index/index/index.toml +++ b/testsuite/tests/crate_config/basic/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/crate_config/gen_control/my_index/index/index.toml b/testsuite/tests/crate_config/gen_control/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/crate_config/gen_control/my_index/index/index.toml +++ b/testsuite/tests/crate_config/gen_control/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/get/backup-user-manifest/my_index/index/index.toml b/testsuite/tests/get/backup-user-manifest/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/get/backup-user-manifest/my_index/index/index.toml +++ b/testsuite/tests/get/backup-user-manifest/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/get/build/my_index/index/index.toml b/testsuite/tests/get/build/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/get/build/my_index/index/index.toml +++ b/testsuite/tests/get/build/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/get/external-tool-dependency/my_index/index.toml b/testsuite/tests/get/external-tool-dependency/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/get/external-tool-dependency/my_index/index.toml +++ b/testsuite/tests/get/external-tool-dependency/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/get/external-tool-dependency/test.py b/testsuite/tests/get/external-tool-dependency/test.py index 242b7ace..811abb69 100644 --- a/testsuite/tests/get/external-tool-dependency/test.py +++ b/testsuite/tests/get/external-tool-dependency/test.py @@ -33,6 +33,7 @@ compare(dir_content, 'main_1.0.0_filesystem/alire/cache', 'main_1.0.0_filesystem/alire/cache/dependencies', make_dep_dir, + make_dep_dir + "/alire", 'main_1.0.0_filesystem/config', 'main_1.0.0_filesystem/config/main_config.ads', 'main_1.0.0_filesystem/config/main_config.gpr', diff --git a/testsuite/tests/get/indirect-link/my_index/index/index.toml b/testsuite/tests/get/indirect-link/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/get/indirect-link/my_index/index/index.toml +++ b/testsuite/tests/get/indirect-link/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/bad-action-command/my_index/index/index.toml b/testsuite/tests/index/bad-action-command/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/bad-action-command/my_index/index/index.toml +++ b/testsuite/tests/index/bad-action-command/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/bad-config-vars/my_index/index/index.toml b/testsuite/tests/index/bad-config-vars/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/bad-config-vars/my_index/index/index.toml +++ b/testsuite/tests/index/bad-config-vars/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/bad-index-metadata/my_index/index/index.toml b/testsuite/tests/index/bad-index-metadata/my_index/index/index.toml index 8421407f..7d655e2b 100644 --- a/testsuite/tests/index/bad-index-metadata/my_index/index/index.toml +++ b/testsuite/tests/index/bad-index-metadata/my_index/index/index.toml @@ -1,2 +1,2 @@ -version = "1.0" +version = "1.1" badkey = "sneaking around" diff --git a/testsuite/tests/index/bad-license-too-long/my_index/index/index.toml b/testsuite/tests/index/bad-license-too-long/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/bad-license-too-long/my_index/index/index.toml +++ b/testsuite/tests/index/bad-license-too-long/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/bad-license/my_index/index/index.toml b/testsuite/tests/index/bad-license/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/bad-license/my_index/index/index.toml +++ b/testsuite/tests/index/bad-license/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/bad-tag/my_index/index/index.toml b/testsuite/tests/index/bad-tag/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/bad-tag/my_index/index/index.toml +++ b/testsuite/tests/index/bad-tag/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/check-enums/my_index/index/index.toml b/testsuite/tests/index/check-enums/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/check-enums/my_index/index/index.toml +++ b/testsuite/tests/index/check-enums/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/empty-tag/my_index/index/index.toml b/testsuite/tests/index/empty-tag/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/empty-tag/my_index/index/index.toml +++ b/testsuite/tests/index/empty-tag/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/environment/my_index/index/index.toml b/testsuite/tests/index/environment/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/environment/my_index/index/index.toml +++ b/testsuite/tests/index/environment/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/external-available/my_index/index.toml b/testsuite/tests/index/external-available/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/external-available/my_index/index.toml +++ b/testsuite/tests/index/external-available/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/external-from-output/my_index/index/index.toml b/testsuite/tests/index/external-from-output/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/external-from-output/my_index/index/index.toml +++ b/testsuite/tests/index/external-from-output/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/external-hint/my_index/index.toml b/testsuite/tests/index/external-hint/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/external-hint/my_index/index.toml +++ b/testsuite/tests/index/external-hint/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/external-msys2/my_index/index.toml b/testsuite/tests/index/external-msys2/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/external-msys2/my_index/index.toml +++ b/testsuite/tests/index/external-msys2/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/external-unindexed/my_index/index/index.toml b/testsuite/tests/index/external-unindexed/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/external-unindexed/my_index/index/index.toml +++ b/testsuite/tests/index/external-unindexed/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/long-description/my_index/index/index.toml b/testsuite/tests/index/long-description/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/long-description/my_index/index/index.toml +++ b/testsuite/tests/index/long-description/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/long-tag/my_index/index/index.toml b/testsuite/tests/index/long-tag/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/long-tag/my_index/index/index.toml +++ b/testsuite/tests/index/long-tag/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/maint-bad-email/my_index/index/index.toml b/testsuite/tests/index/maint-bad-email/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/maint-bad-email/my_index/index/index.toml +++ b/testsuite/tests/index/maint-bad-email/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/maint-bad-login/my_index/index/index.toml b/testsuite/tests/index/maint-bad-login/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/maint-bad-login/my_index/index/index.toml +++ b/testsuite/tests/index/maint-bad-login/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/mismatched-crate/my_index/index/index.toml b/testsuite/tests/index/mismatched-crate/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/mismatched-crate/my_index/index/index.toml +++ b/testsuite/tests/index/mismatched-crate/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/mismatched-parent/my_index/index/index.toml b/testsuite/tests/index/mismatched-parent/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/mismatched-parent/my_index/index/index.toml +++ b/testsuite/tests/index/mismatched-parent/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/origin-filesystem-bad-path/bad_index_1/index.toml b/testsuite/tests/index/origin-filesystem-bad-path/bad_index_1/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/origin-filesystem-bad-path/bad_index_1/index.toml +++ b/testsuite/tests/index/origin-filesystem-bad-path/bad_index_1/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/origin-filesystem-bad-path/bad_index_2/index.toml b/testsuite/tests/index/origin-filesystem-bad-path/bad_index_2/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/origin-filesystem-bad-path/bad_index_2/index.toml +++ b/testsuite/tests/index/origin-filesystem-bad-path/bad_index_2/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/origin-no-archive-name/my_index/index/index.toml b/testsuite/tests/index/origin-no-archive-name/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/origin-no-archive-name/my_index/index/index.toml +++ b/testsuite/tests/index/origin-no-archive-name/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/origin-unknown-kind/my_index/index/index.toml b/testsuite/tests/index/origin-unknown-kind/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/origin-unknown-kind/my_index/index/index.toml +++ b/testsuite/tests/index/origin-unknown-kind/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/too-long-short-description/my_index/index/index.toml b/testsuite/tests/index/too-long-short-description/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/too-long-short-description/my_index/index/index.toml +++ b/testsuite/tests/index/too-long-short-description/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/index/unexpected-contents/my_index/index/index.toml b/testsuite/tests/index/unexpected-contents/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/index/unexpected-contents/my_index/index/index.toml +++ b/testsuite/tests/index/unexpected-contents/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/misc/hashes/my_index/index/cr/crate/crate-1.0.0.toml b/testsuite/tests/misc/hashes/my_index/index/cr/crate/crate-1.0.0.toml new file mode 100644 index 00000000..1e49be81 --- /dev/null +++ b/testsuite/tests/misc/hashes/my_index/index/cr/crate/crate-1.0.0.toml @@ -0,0 +1,15 @@ +description = "Sample crate" +name = "crate" +version = "1.0.0" +licenses = [] +maintainers = ["any@bo.dy"] +maintainers-logins = ["someone"] + +[origin] +# Relative to where the index and the crates are placed by the test set up +url = "file:../../../../crates/libhello_1.0.0.tgz" + +hashes = [ +"sha256:c17d6ce87c6997c5f68ea4bfe6134c318073fed38ec0f81ccb1ae2bfdcc0187a", +"sha512:99fa3a55540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac", +] diff --git a/testsuite/tests/misc/hashes/my_index/index/cr/crate/crate-2.0.0.toml b/testsuite/tests/misc/hashes/my_index/index/cr/crate/crate-2.0.0.toml new file mode 100644 index 00000000..356abddd --- /dev/null +++ b/testsuite/tests/misc/hashes/my_index/index/cr/crate/crate-2.0.0.toml @@ -0,0 +1,16 @@ +description = "Sample crate" +name = "crate" +version = "2.0.0" +licenses = [] +maintainers = ["any@bo.dy"] +maintainers-logins = ["someone"] + +[origin] +# Relative to where the index and the crates are placed by the test set up +url = "file:../../../../crates/libhello_1.0.0.tgz" + +# These hashes are wrong +hashes = [ +"sha256:000000007c6997c5f68ea4bfe6134c318073fed38ec0f81ccb1ae2bfdcc0187a", +"sha512:00000000540d0655c87605b54af732f76a8a363015f183b06e98aa91e54c0e69397872718c5c16f436dd6de0fba506dc50c66d34a0e5c61fb63cb01fa22f35ac", +] diff --git a/testsuite/tests/misc/hashes/my_index/index/index.toml b/testsuite/tests/misc/hashes/my_index/index/index.toml new file mode 100644 index 00000000..bad265e4 --- /dev/null +++ b/testsuite/tests/misc/hashes/my_index/index/index.toml @@ -0,0 +1 @@ +version = "1.1" diff --git a/testsuite/tests/misc/hashes/test.py b/testsuite/tests/misc/hashes/test.py new file mode 100644 index 00000000..5e896248 --- /dev/null +++ b/testsuite/tests/misc/hashes/test.py @@ -0,0 +1,23 @@ +""" +Verify the recognition of all supported hash types +""" + +from drivers.alr import run_alr +from drivers.asserts import assert_eq, assert_match + +# Verify loading +p = run_alr("show", "crate") +assert_match(".*Origin.*with hashes " + "sha256:.{64}, sha512:.{128}", + p.out) + +# Verify actual hash use. v1 of crate is correct, v2 contains bad hashes + +# This can only succeed if all hashes match +p = run_alr("get", "crate=1") + +# Verify that a hash mismatch is also detected +p = run_alr("get", "crate=2", complain_on_error=False) +assert_match(".*release integrity test failed.*", p.out) + +print('SUCCESS') diff --git a/testsuite/tests/misc/hashes/test.yaml b/testsuite/tests/misc/hashes/test.yaml new file mode 100644 index 00000000..b7da6fe7 --- /dev/null +++ b/testsuite/tests/misc/hashes/test.yaml @@ -0,0 +1,5 @@ +driver: python-script +indexes: + my_index: + in_fixtures: false + copy_crates_src: true diff --git a/testsuite/tests/pin/all/my_index/index/index.toml b/testsuite/tests/pin/all/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/all/my_index/index/index.toml +++ b/testsuite/tests/pin/all/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/pin/change-type/my_index/index.toml b/testsuite/tests/pin/change-type/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/change-type/my_index/index.toml +++ b/testsuite/tests/pin/change-type/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/pin/downgrade/my_index/index/index.toml b/testsuite/tests/pin/downgrade/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/downgrade/my_index/index/index.toml +++ b/testsuite/tests/pin/downgrade/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/pin/manifest-invalid-pins/my_index/index/index.toml b/testsuite/tests/pin/manifest-invalid-pins/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/manifest-invalid-pins/my_index/index/index.toml +++ b/testsuite/tests/pin/manifest-invalid-pins/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/pin/pin-dir-with-regular/my_index/index.toml b/testsuite/tests/pin/pin-dir-with-regular/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/pin-dir-with-regular/my_index/index.toml +++ b/testsuite/tests/pin/pin-dir-with-regular/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/pin/pin-dir/my_index/index.toml b/testsuite/tests/pin/pin-dir/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/pin-dir/my_index/index.toml +++ b/testsuite/tests/pin/pin-dir/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/pin/post-update/my_index/index/index.toml b/testsuite/tests/pin/post-update/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/post-update/my_index/index/index.toml +++ b/testsuite/tests/pin/post-update/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/pin/twice-in-manifest/my_index/index.toml b/testsuite/tests/pin/twice-in-manifest/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/twice-in-manifest/my_index/index.toml +++ b/testsuite/tests/pin/twice-in-manifest/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/pin/unneeded-held/my_index/index/index.toml b/testsuite/tests/pin/unneeded-held/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/pin/unneeded-held/my_index/index/index.toml +++ b/testsuite/tests/pin/unneeded-held/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/printenv/double-set/my_index/index/index.toml b/testsuite/tests/printenv/double-set/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/printenv/double-set/my_index/index/index.toml +++ b/testsuite/tests/printenv/double-set/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/printenv/env-during-fetch/my_index/index/index.toml b/testsuite/tests/printenv/env-during-fetch/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/printenv/env-during-fetch/my_index/index/index.toml +++ b/testsuite/tests/printenv/env-during-fetch/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/printenv/linked-paths/my_index/index/index.toml b/testsuite/tests/printenv/linked-paths/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/printenv/linked-paths/my_index/index/index.toml +++ b/testsuite/tests/printenv/linked-paths/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/publish/check-build/my_index/index/index.toml b/testsuite/tests/publish/check-build/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/publish/check-build/my_index/index/index.toml +++ b/testsuite/tests/publish/check-build/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/publish/check-properties/my_index/index/index.toml b/testsuite/tests/publish/check-properties/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/publish/check-properties/my_index/index/index.toml +++ b/testsuite/tests/publish/check-properties/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/publish/tarball-plaindir-nonstd/my_index/index/index.toml b/testsuite/tests/publish/tarball-plaindir-nonstd/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/publish/tarball-plaindir-nonstd/my_index/index/index.toml +++ b/testsuite/tests/publish/tarball-plaindir-nonstd/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/publish/tarball-plaindir/my_index/index/index.toml b/testsuite/tests/publish/tarball-plaindir/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/publish/tarball-plaindir/my_index/index/index.toml +++ b/testsuite/tests/publish/tarball-plaindir/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/publish/tarball-repo-nonstd/my_index/index/index.toml b/testsuite/tests/publish/tarball-repo-nonstd/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/publish/tarball-repo-nonstd/my_index/index/index.toml +++ b/testsuite/tests/publish/tarball-repo-nonstd/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/publish/tarball-repo/my_index/index/index.toml b/testsuite/tests/publish/tarball-repo/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/publish/tarball-repo/my_index/index/index.toml +++ b/testsuite/tests/publish/tarball-repo/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/solver/compiler-installed/test.py b/testsuite/tests/solver/compiler-installed/test.py new file mode 100644 index 00000000..1c727efa --- /dev/null +++ b/testsuite/tests/solver/compiler-installed/test.py @@ -0,0 +1,78 @@ +""" +Check that, for generic gnat dependencies, no compilers are installed (only a +locally available one is used). +""" + +import subprocess +import re + +from drivers.alr import run_alr, init_local_crate, alr_with +from drivers.asserts import assert_eq, assert_match, match_solution + +# With no compiler selected, the external compiler in the environment should be +# the only one available. We will verify this and capture its version (which is +# actually the version returned by `make`) for later use + +# Verify only external compiler available +p = run_alr("toolchain") +assert_match(".*\n" # Headers + "gnat_external.*Available.*Detected.*\n", + p.out) + +# Capture version +version = re.search("[0-9.]+", p.out, re.MULTILINE).group() + +# When no compiler is selected, since the external one is available, it should +# be used before offering to download a new compiler. + +# Create a crate for our experiments +init_local_crate("xxx") + +# Check that a generic dependency results in the external being used +alr_with("gnat") +match_solution(f"gnat={version} (gnat_external) (installed)", escape=True) + +# Check that requesting a version different to the one externally available +# results in missing compiler, as Alire won't try to install one. +alr_with("gnat", delete=True, manual=False) +alr_with(f"gnat/={version}") +match_solution(f"gnat/={version} (direct,hinted)", escape=True) +# Hinted because we know the crate exists as external + +# Now, if the user installs a cross compiler, it will be used + +run_alr("toolchain", "--install", "gnat_cross_2") +run_alr("update") +match_solution("gnat=1.0.0 (gnat_cross_2) (installed)", escape=True) + +# Likewise, if we install a native compiler, it will be preferred to a +# cross-compiler. + +run_alr("toolchain", "--install", "gnat_native") +run_alr("update") +match_solution("gnat=2.0.0 (gnat_native) (installed)", escape=True) + +# If we remove the version exclusion, the external compiler will still be +# preferred as there is no selected compiler yet. + +alr_with("gnat", delete=True, manual=False) +alr_with("gnat") +match_solution(f"gnat={version} (gnat_external) (installed)", escape=True) + +# But, if the user selects a compiler as preferred, it will be used first + +run_alr("config", "--set", "toolchain.use.gnat", "gnat_cross_2=1.0.0") +run_alr("update") +match_solution("gnat=1.0.0 (gnat_cross_2) (installed)", escape=True) + +# Finally, if the crate requests explicitly an uninstalled compiler, it will be +# downloaded, installed, and used before the rest of installed compilers. + +alr_with("gnat_cross_1") +match_solution("gnat=9999.0.0 (gnat_cross_1) (installed)", escape=True) +match_solution("gnat_cross_1=9999.0.0 (installed)", escape=True) +# Verify it was actually installed +p = run_alr("toolchain") +assert_match(".*gnat_cross_1\s+9999.0.0\s+Available", p.out) + +print('SUCCESS') diff --git a/testsuite/tests/solver/compiler-installed/test.yaml b/testsuite/tests/solver/compiler-installed/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/solver/compiler-installed/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/solver/compiler-mixing/test.py b/testsuite/tests/solver/compiler-mixing/test.py new file mode 100644 index 00000000..2b1a0249 --- /dev/null +++ b/testsuite/tests/solver/compiler-mixing/test.py @@ -0,0 +1,87 @@ +""" +Check mixing gnat/gnat_xxx dependencies without configured preferred compiler +""" + +import subprocess +import os +import re + +from drivers.alr import run_alr, init_local_crate, alr_with +from drivers.asserts import assert_eq, assert_match, match_solution +from re import escape as e + +# Verify only external compiler available +p = run_alr("toolchain") +assert_match(".*\n" # Headers + "gnat_external.*Available.*Detected.*\n", + p.out) + +# Capture version +version = re.search("[0-9.]+", p.out, re.MULTILINE).group() + +# Prepare a couple of dependencies, one depending on gnat, and another one +# depending on gnat_native. + +init_local_crate("dep_generic") +alr_with("gnat") +os.chdir("..") + +init_local_crate("dep_targeted") +alr_with("gnat_native") # This step also installs the native compiler +os.chdir("..") + +# First we check that a root generic dependency mixes well with either of the +# two dependencies + +init_local_crate("xxx_generic_generic") +run_alr("with", "--use=../dep_generic") +alr_with("gnat") + +# gnat x gnat results in the external available compiler being used, preferred +# over the native also available compiler (but not selected) +match_solution(f"gnat={version} (gnat_external) (installed)", + escape=True) + +# If we add a precise dependency on e.g. the installed native compiler, this +# should override the external compiler +alr_with("gnat_native") +match_solution("gnat=2.0.0 (gnat_native) (installed)", escape=True) +match_solution("gnat_native=2.0.0 (installed)", escape=True) + +# Let us swap the generic dependency with a targeted dependency, starting from +# scratch + +os.chdir("..") +init_local_crate("xxx_generic_targeted") +run_alr("with", "--use=../dep_targeted") +alr_with("gnat") + +# In this case the only possible solution is with the targeted compiler +match_solution("gnat=" + e("2.0.0 (gnat_native) (installed)") + ".*" + + "gnat_native=" + e("2.0.0 (installed)") + ".*") + +# Second, we check a root targeted gnat with both dependencies + +os.chdir("..") +init_local_crate("xxx_targeted_generic") +run_alr("with", "--use=../dep_generic") +alr_with("gnat_native") + +# In this case the only possible solution is with the targeted compiler. The +# Generic dependency also appears, coming from the dep_generic crate +match_solution("gnat=" + e("2.0.0 (gnat_native) (installed)") + ".*" + + "gnat_native=" + e("2.0.0 (installed)") + ".*") + +# Last combination is targeted x targeted +os.chdir("..") +init_local_crate("xxx_targeted_targeted") +run_alr("with", "--use=../dep_targeted") +alr_with("gnat_native") + +# In this case the only possible solution is with the targeted compiler. The +# generic dependency no longer exists, as nobody requested a generic gnat. +match_solution("gnat_native=" + e("2.0.0 (installed)") + ".*") +p = run_alr("with", "--solve") +assert "gnat=" not in p.out, "Unexpected output" + +print('SUCCESS') diff --git a/testsuite/tests/solver/compiler-mixing/test.yaml b/testsuite/tests/solver/compiler-mixing/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/solver/compiler-mixing/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/solver/compiler-priorities/test.py b/testsuite/tests/solver/compiler-priorities/test.py new file mode 100644 index 00000000..76c3a913 --- /dev/null +++ b/testsuite/tests/solver/compiler-priorities/test.py @@ -0,0 +1,113 @@ +""" +Check compiler priorities in the solver. These priorities are: + - The selected compiler, if defined + - An externally available compiler + - Newest installed native compiler + - Newest installed cross-compiler + - Newest uninstalled native compiler + - Newest uninstalled cross-compiler +Generic dependencies on gnat= never cause compiler installation. Those only +match installed or externally available compilers. +""" + +import subprocess +import re + +from drivers.alr import run_alr, init_local_crate, alr_with +from drivers.asserts import assert_eq, assert_match, match_solution + +# With no compiler selected, the external compiler in the environment should be +# the only one available. We will verify this and capture its version (which is +# actually the version returned by `make` for later use + +# Verify only external compiler available +p = run_alr("toolchain") +assert_match(".*\n" # Headers + "gnat_external.*Available.*Detected.*\n", + p.out) + +# Capture version +version = re.search("[0-9.]+", p.out, re.MULTILINE).group() + +# When no compiler is selected, only the gnat_external one should be used +# unless a targeted compiler dependency is used + +# Create a crate for our experiments +init_local_crate("xxx") + +# Check that a generic dependency results in the external being used +alr_with("gnat") +match_solution(f"gnat={version} (gnat_external) (installed)", escape=True) + +# Check that adding a second dependency on native packaged compiler is honored. +# Both dependencies should appear in the solution. +alr_with("gnat_native") +match_solution("gnat=2.0.0 (gnat_native) (installed)", escape=True) +match_solution("gnat_native=2.0.0 (installed)", escape=True) + +# The previous dependency also should have caused the installation of the +# native compiler as an available compiler, which we will check: +p = run_alr("toolchain") +assert_match(".*gnat_native.*2.0.0.*Available.*", + p.out) + +# Move to a new crate +init_local_crate("yyy") + +# Preinstall the v9999 compiler +run_alr("toolchain", "--install", "gnat=9999") +# Note also that we don't say the exact compiler to use, but the only one that +# provides that version is a cross-compiler + +# Verify compiler availability +p = run_alr("toolchain") +assert_match(".*gnat_cross_1.*9999.*Available.*", + p.out) + +# Depend on any gnat. Since no default is selected, the external one is used, +# even if other installed compilers are newer (cross_2=9999) +alr_with("gnat") +match_solution(f"gnat={version} (gnat_external) (installed)", escape=True) + +# Depend on any gnat but the externally available. Since we have gnat_native=2 +# and gnat_cross_1=9999, normal version comparison would select the cross +# compiler, but native compilers take precedence. So the solution should +# match v2. +alr_with("gnat", delete=True, manual=False) +alr_with(f"gnat/={version}") +match_solution("gnat=2.0.0 (gnat_native)", escape=True) + +# If we uninstall the native compiler, the cross compiler will be preferred now +run_alr("toolchain", "--uninstall", "gnat_native=2") + +run_alr("update") +match_solution("gnat=9999.0.0 (gnat_cross_1)", escape=True) + +# Let's reinstall the newest native compiler and verify the previous situation +run_alr("toolchain", "--install", "gnat_native") +p = run_alr("toolchain") +assert_match(".*gnat_native.*2.0.0.*Available.*", + p.out) +run_alr("update") +match_solution("gnat=2.0.0 (gnat_native)", escape=True) + +# We can force the use of the cross-compiler by selecting it as default: +run_alr("config", "--global", + "--set", "toolchain.use.gnat", "gnat_cross_1=9999") +run_alr("update") +match_solution("gnat=9999.0.0 (gnat_cross_1) (installed)", escape=True) + +# Check that a targeted compiler is retrieved when needed. Note that another +# cross-compiler is still selected as default, but since we need a different +# one, this setting is properly ignored in favor of the correct cross compiler. + +init_local_crate("zzz") +alr_with("gnat") # Will be solved with the selected cross compiler 1 +match_solution("gnat=9999.0.0 (gnat_cross_1) (installed)", escape=True) + +alr_with("gnat_cross_2") +# Now, this compiler should appear in the solution and be available, as it +# overrides the preferred compiler +match_solution("gnat_cross_2=1.0.0 (installed)", escape=True) + +print('SUCCESS') diff --git a/testsuite/tests/solver/compiler-priorities/test.yaml b/testsuite/tests/solver/compiler-priorities/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/solver/compiler-priorities/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/solver/compiler-selected/test.py b/testsuite/tests/solver/compiler-selected/test.py new file mode 100644 index 00000000..97acf2b8 --- /dev/null +++ b/testsuite/tests/solver/compiler-selected/test.py @@ -0,0 +1,36 @@ +""" +Check solving with a configured preferred compiler +""" + +import subprocess +import os + +from drivers.alr import run_alr, init_local_crate, alr_with +from drivers.asserts import assert_eq, assert_match, match_solution +from re import escape as e + +# Select the default preferred compiler, which is the native packaged one +run_alr("toolchain", "--select") + +# Init a crate depending on gnat + +init_local_crate("xxx") +alr_with("gnat*") + +# Will appear in the solution as generic fulfilled by the preferred compiler +match_solution("gnat=2.0.0 (gnat_native) (installed)", escape=True) + +# Selecting another default will cause a corresponding change in the solution +run_alr("config", "--set", "toolchain.use.gnat", "gnat_cross_2=1") +run_alr("update") +match_solution("gnat=1.0.0 (gnat_cross_2) (installed)", escape=True) + +# Adding another incompatible compiler dependency should result in overriding +# the configured one +alr_with("gnat_cross_1") + +# Both dependencies will appear in the solution, matching the same crate +match_solution("gnat=9999.0.0 \(gnat_cross_1\) \(installed\).*" + "gnat_cross_1=9999.0.0 \(installed\)") + +print('SUCCESS') diff --git a/testsuite/tests/solver/compiler-selected/test.yaml b/testsuite/tests/solver/compiler-selected/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/solver/compiler-selected/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/solver/equivalences-conflict/test.py b/testsuite/tests/solver/equivalences-conflict/test.py new file mode 100644 index 00000000..bd8acb9e --- /dev/null +++ b/testsuite/tests/solver/equivalences-conflict/test.py @@ -0,0 +1,26 @@ +""" +Test that two crates providing the same third crate are incompatible +""" + +import subprocess +import os + +from drivers.alr import run_alr, init_local_crate, alr_with +from drivers.asserts import assert_eq, assert_match, match_solution +from re import escape as e + +# This test relies on two crates in the index: +# crate_equiv=2.0 also provides crate_virtual=1.0 +# crate_clash=1.0 also provides crate_virtual=1.0 +# Depending on the two of them cannot be solved, as that would mean two +# implementations of crate_virtual=1.0 at the same time + +init_local_crate("xxx") +alr_with("crate_equiv") +alr_with("crate_clash") + +match_solution("crate_equiv* (direct,missed)", escape=True) +# Because of alphabetical order, crate_clash is accepted first, and crate_equiv +# can no longer be accepted in the solution. + +print('SUCCESS') diff --git a/testsuite/tests/solver/equivalences-conflict/test.yaml b/testsuite/tests/solver/equivalences-conflict/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/solver/equivalences-conflict/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/solver/equivalences/test.py b/testsuite/tests/solver/equivalences/test.py new file mode 100644 index 00000000..054939a0 --- /dev/null +++ b/testsuite/tests/solver/equivalences/test.py @@ -0,0 +1,41 @@ +""" +Test solver using the "provides" field for regular crates +""" + +import subprocess +import os + +from drivers.alr import run_alr, init_local_crate, alr_with +from drivers.asserts import assert_eq, assert_match, match_solution +from re import escape as e + +# This test relies on two crates in the index: crate_lone=1.0 is unavailable. +# crate_equiv=2.0 also provides crate_lone=1.0 and crate_virtual=1.0. +# Finally there is crate_lone=2.0 that is available and nobody else provides. + +init_local_crate("xxx") +alr_with("crate_lone^1") + +# Since crate_lone is unavailable, in the solution we should find crate_equiv: +match_solution("crate_lone=2.0.0 (crate_equiv)", escape=True) + +# Likewise, a dependency on crate_virtual will be fulfilled by the same crate +alr_with("crate_virtual") +match_solution("crate_virtual=2.0.0 (crate_equiv)", escape=True) + +# Whereas a dependency on crate_equiv will show plainly without equivalence +alr_with("crate_equiv") +match_solution( + "Dependencies (solution):\n" + " crate_equiv=2.0.0 (origin: filesystem)\n" + " crate_lone=2.0.0 (crate_equiv) (origin: filesystem)\n" + " crate_virtual=2.0.0 (crate_equiv) (origin: filesystem)\n", + escape=True) + +# Finally check that a dependency on crate_lone^2 is only fulfilled by itself +os.chdir("..") +init_local_crate("yyy") +alr_with("crate_lone^2") +match_solution("crate_lone=2.0.0 (origin: filesystem)", escape=True) + +print('SUCCESS') diff --git a/testsuite/tests/solver/equivalences/test.yaml b/testsuite/tests/solver/equivalences/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/solver/equivalences/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/test/action-test/my_index/index/index.toml b/testsuite/tests/test/action-test/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/test/action-test/my_index/index/index.toml +++ b/testsuite/tests/test/action-test/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/toolchain/bad-switches/test.py b/testsuite/tests/toolchain/bad-switches/test.py new file mode 100644 index 00000000..1fee12c5 --- /dev/null +++ b/testsuite/tests/toolchain/bad-switches/test.py @@ -0,0 +1,20 @@ +""" +Check that bad combos of switches for toolchain are detected +""" + +from drivers.alr import run_alr +# from drivers.asserts import assert_eq, assert_match + +p = run_alr("toolchain", "--install", "--uninstall", complain_on_error=False) +assert p.status != 0, "Call should have failed" + +p = run_alr("toolchain", "--install", "--select", complain_on_error=False) +assert p.status != 0, "Call should have failed" + +p = run_alr("toolchain", "--select", "--uninstall", complain_on_error=False) +assert p.status != 0, "Call should have failed" + +# Bonus: test a proper invocation +p = run_alr("toolchain") + +print('SUCCESS') diff --git a/testsuite/tests/toolchain/bad-switches/test.yaml b/testsuite/tests/toolchain/bad-switches/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/toolchain/bad-switches/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/toolchain/basic/test.py b/testsuite/tests/toolchain/basic/test.py new file mode 100644 index 00000000..65959d1c --- /dev/null +++ b/testsuite/tests/toolchain/basic/test.py @@ -0,0 +1,55 @@ +""" +Check basic use: manual install, uninstall, and listing of toolchains +""" + +import re + +from drivers.alr import run_alr +from drivers.asserts import assert_eq, assert_match + +# Install a precise version of gnat +run_alr("toolchain", "--install", "gnat_native=1") + +# Verify that it appears as available +p = run_alr("toolchain") +assert_match(".*gnat_native.*" + re.escape("1.0.0") + ".*Available", + p.out) + +# Also that the external compiler is detected and always available +assert_match(".*gnat_external.*Available", p.out) + +# Also that the external compiler cannot be uninstalled (and short switch) +p = run_alr("toolchain", "-u", "gnat_external", complain_on_error=False) +assert_match(".*Only regular releases deployed through Alire can be removed.*", + p.out) + +# Verify that it can be uninstalled +run_alr("toolchain", "--uninstall", "gnat_native=1") +p = run_alr("toolchain") +assert "gnat_native" not in p.out, "Unexpected output" + +# Repeat install but without giving a version, and one should be autoidentified +# as the newest available version +p = run_alr("toolchain", "-i", "gnat_native", quiet=False) # Test short switch +assert_match(".*Requested crate resolved as gnat_native=2.0.0.*", + p.out) + +# Verify that we can explicitly install a second version for the same target +run_alr("toolchain", "--install", "gnat_native=1") +p = run_alr("toolchain") +assert_match(".*gnat_native.*" + re.escape("1.0.0") + ".*Available", + p.out) + +# Verify that uninstalling without specifying version isn't allowed when there +# are two matching crates installed. +p = run_alr("toolchain", "--uninstall", "gnat_native", + complain_on_error=False) +assert_match(".*Requested crate has several installed releases.*", + p.out) + +# Uninstall successfully by giving a version +run_alr("toolchain", "--uninstall", "gnat_native=2") +# Now we can uninstall without specifying the version of the remaining release +run_alr("toolchain", "--uninstall", "gnat_native") + +print('SUCCESS') diff --git a/testsuite/tests/toolchain/basic/test.yaml b/testsuite/tests/toolchain/basic/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/toolchain/basic/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/toolchain/directories/test.py b/testsuite/tests/toolchain/directories/test.py new file mode 100644 index 00000000..db155ce1 --- /dev/null +++ b/testsuite/tests/toolchain/directories/test.py @@ -0,0 +1,63 @@ +""" +Check created folders are where expected when installing binary compiler crates +""" + +import os +import re + +from drivers.alr import run_alr, init_local_crate, alr_with +from drivers.asserts import assert_eq, assert_match, match_solution +from drivers.helpers import contents + +# Identify config location +p = run_alr("version") +config_dir = re.search("config folder is ([^\n.]*)", p.out).group(1) +config_dir = config_dir.replace("\\", "/") +# The 'contents` function we use to compare these strings normalizes all paths +# to forward slashes, so we do the same with the config_dir + +unk_re = "[0-9]+\.[0-9]+\.[0-9]+_[0-9a-f]{8}" # Unknown version + Unknown hash + + +def config_path_re(crate): + return re.escape(f"{config_dir}/cache/dependencies/{crate}_") + unk_re + + +# First we test manual installation +run_alr("toolchain", "--install", "gnat_native") +# This next call returns all paths related to the installed compiler +paths = contents(config_dir, "gnat_native") +try: + assert len(paths) >= 1 and \ + re.search(config_path_re("gnat_native"), paths[0]), \ + "Unexpected contents: " + str(paths) +except: + print(f"erroneous regex was: {config_path_re('gnat_native')}") + print(f"erroneous path was: {paths[0]}") + raise + +# Uninstall the compiler and verify absence +run_alr("toolchain", "--uninstall", "gnat_native") +paths = contents(config_dir, "gnat_native") +assert len(paths) == 0, "Unexpected contents: " + str(paths) + +# Require the external compiler and verify no trace appears in install folder +# nor in local folder +init_local_crate("xxx") +alr_with("gnat_external") +match_solution("gnat_external=.* \(installed\)") +paths = contents(config_dir, "gnat_external") +assert len(paths) == 0, "Unexpected contents: " + str(paths) +paths = contents(".", "gnat_external") +assert len(paths) == 0, "Unexpected contents: " + str(paths) + +# Require a cross compiler and verify it is automatically installed +alr_with("gnat_external", delete=True, manual=False) +alr_with("gnat_cross_1") +match_solution("gnat_cross_1=.* \(installed\)") +paths = contents(config_dir, "gnat_cross_1") +assert len(paths) >= 1 and \ + re.search(config_path_re("gnat_cross_1"), paths[0]), \ + "Unexpected contents: " + str(paths) + +print('SUCCESS') diff --git a/testsuite/tests/toolchain/directories/test.yaml b/testsuite/tests/toolchain/directories/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/toolchain/directories/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/toolchain/select/test.py b/testsuite/tests/toolchain/select/test.py new file mode 100644 index 00000000..1a3f3340 --- /dev/null +++ b/testsuite/tests/toolchain/select/test.py @@ -0,0 +1,28 @@ +""" +Check toolchain selection assistant +""" + +import subprocess +import re + +from drivers.alr import run_alr +from drivers.asserts import assert_eq, assert_match + +# Activate the default compiler +p = run_alr("toolchain", "--select") + +# Check that the newest native compiler is the Default now (vs Available) +p = run_alr("toolchain") +assert_match(".*gnat_native.*" + re.escape("2.0.0") + ".*Default.*", + p.out) + +# I've (mosteo) been unable to connect stdin with an alr launched via # +# subprocess.run, so no way to do further interactive tests at this time. +# My attempt follows. (I also attempted using subprocess.Popen.) + +subprocess.run(["alr", "toolchain", "--select"], + input="2\n", text=True, + capture_output=True) +# This actually runs, but there is no input sent to alr. stdin=PIPE fails too. + +print('SUCCESS') diff --git a/testsuite/tests/toolchain/select/test.yaml b/testsuite/tests/toolchain/select/test.yaml new file mode 100644 index 00000000..8185c03b --- /dev/null +++ b/testsuite/tests/toolchain/select/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + toolchain_index: + in_fixtures: true diff --git a/testsuite/tests/update/selective/my_index/index/index.toml b/testsuite/tests/update/selective/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/update/selective/my_index/index/index.toml +++ b/testsuite/tests/update/selective/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/update/selective/my_index/updated/index/index.toml b/testsuite/tests/update/selective/my_index/updated/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/update/selective/my_index/updated/index/index.toml +++ b/testsuite/tests/update/selective/my_index/updated/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/with/auto-gpr-with/basic/my_index/index.toml b/testsuite/tests/with/auto-gpr-with/basic/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/with/auto-gpr-with/basic/my_index/index.toml +++ b/testsuite/tests/with/auto-gpr-with/basic/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/with/auto-gpr-with/gpr_in_subdir/my_index/index.toml b/testsuite/tests/with/auto-gpr-with/gpr_in_subdir/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/with/auto-gpr-with/gpr_in_subdir/my_index/index.toml +++ b/testsuite/tests/with/auto-gpr-with/gpr_in_subdir/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/with/narrow-pre1/my_index/index/index.toml b/testsuite/tests/with/narrow-pre1/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/with/narrow-pre1/my_index/index/index.toml +++ b/testsuite/tests/with/narrow-pre1/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/with/pin-dir/my_index/index/index.toml b/testsuite/tests/with/pin-dir/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/with/pin-dir/my_index/index/index.toml +++ b/testsuite/tests/with/pin-dir/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/workflows/action-command/my_index/index/index.toml b/testsuite/tests/workflows/action-command/my_index/index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/workflows/action-command/my_index/index/index.toml +++ b/testsuite/tests/workflows/action-command/my_index/index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" diff --git a/testsuite/tests/workflows/edit/my_index/index.toml b/testsuite/tests/workflows/edit/my_index/index.toml index 346c93fc..bad265e4 100644 --- a/testsuite/tests/workflows/edit/my_index/index.toml +++ b/testsuite/tests/workflows/edit/my_index/index.toml @@ -1 +1 @@ -version = "1.0" +version = "1.1" -- 2.39.5