diff --git a/apps/rebar/src/rebar.hrl b/apps/rebar/src/rebar.hrl index fc0b04189..4ac2d6f9d 100644 --- a/apps/rebar/src/rebar.hrl +++ b/apps/rebar/src/rebar.hrl @@ -46,7 +46,7 @@ -type ms_field() :: '$1' | '_' | {'$1', '$2'}. %% TODO: change package and requirement keys to be required (:=) after dropping support for OTP-18 --record(package, {key :: {unicode:unicode_binary() | ms_field(), unicode:unicode_binary() | ms_field() | ec_semver:semver(), +-record(package, {key :: {unicode:unicode_binary() | ms_field(), unicode:unicode_binary() | ms_field() | rebar_semver:version(), unicode:unicode_binary() | ms_field()}, inner_checksum :: binary() | ms_field(), outer_checksum :: binary() | ms_field(), diff --git a/apps/rebar/src/rebar_app_utils.erl b/apps/rebar/src/rebar_app_utils.erl index f4526e4c5..12a125e88 100644 --- a/apps/rebar/src/rebar_app_utils.erl +++ b/apps/rebar/src/rebar_app_utils.erl @@ -328,7 +328,7 @@ update_source(AppInfo, {pkg, PkgName, PkgVsn, OldHash, Hash}, State) -> dependencies=Deps, retired=Retired} = Package, maybe_warn_retired(PkgName, PkgVsn1, Hash, Retired), - PkgVsn2 = list_to_binary(lists:flatten(ec_semver:format(PkgVsn1))), + PkgVsn2 = rebar_semver:format(PkgVsn1), AppInfo1 = rebar_app_info:source(AppInfo, {pkg, PkgName, PkgVsn2, OldHash1, Hash1, RepoConfig}), rebar_app_info:update_opts_deps(AppInfo1, Deps); not_found -> @@ -364,7 +364,7 @@ maybe_warn_retired(_, _, Hash, _) when is_binary(Hash) -> maybe_warn_retired(Name, Vsn, _, R=#{reason := Reason}) -> Message = maps:get(message, R, ""), ?WARN("Warning: package ~s-~s is retired: (~s) ~s", - [Name, ec_semver:format(Vsn), retire_reason(Reason), Message]); + [Name, rebar_semver:format(Vsn), retire_reason(Reason), Message]); maybe_warn_retired(_, _, _, _) -> ok. diff --git a/apps/rebar/src/rebar_packages.erl b/apps/rebar/src/rebar_packages.erl index f7444f296..4f88e34f0 100644 --- a/apps/rebar/src/rebar_packages.erl +++ b/apps/rebar/src/rebar_packages.erl @@ -11,7 +11,7 @@ ,resolve_version/6]). -ifdef(TEST). --export([new_package_table/0, find_highest_matching_/5, cmp_/4, cmpl_/4, valid_vsn/1]). +-export([new_package_table/0, find_highest_matching_/5]). -endif. -export_type([package/0]). @@ -55,16 +55,16 @@ get_all_names(State) -> _='_'}, [], ['$1']}])). --spec get_package_versions(unicode:unicode_binary(), ec_semver:semver(), +-spec get_package_versions(unicode:unicode_binary(), boolean(), unicode:unicode_binary(), ets:tid(), rebar_state:t()) -> [vsn()]. -get_package_versions(Dep, {_, AlphaInfo}, Repo, Table, State) -> +get_package_versions(Dep, AllowPreRelease, Repo, Table, State) -> ?MODULE:verify_table(State), - AllowPreRelease = rebar_state:get(State, deps_allow_prerelease, false) - orelse AlphaInfo =/= {[],[]}, + AllowPreRelease2 = rebar_state:get(State, deps_allow_prerelease, false) + orelse AllowPreRelease, ets:select(Table, [{#package{key={Dep, {'$1', '$2'}, Repo}, _='_'}, - [{'==', '$2', {{[],[]}}} || not AllowPreRelease], [{{'$1', '$2'}}]}]). + [{'==', '$2', {{[],[]}}} || not AllowPreRelease2], [{{'$1', '$2'}}]}]). -spec get_package(unicode:unicode_binary(), unicode:unicode_binary(), binary() | undefined | '_', @@ -74,23 +74,29 @@ get_package(Dep, Vsn, undefined, Repos, Table, State) -> get_package(Dep, Vsn, '_', Repos, Table, State); get_package(Dep, Vsn, Hash, Repos, Table, State) -> ?MODULE:verify_table(State), - MatchingPackages = ets:select(Table, [{#package{key={Dep, ec_semver:parse(Vsn), Repo}, - _='_'}, [], ['$_']} || Repo <- Repos]), - PackagesWithProperHash = lists:filter( - fun(#package{key = {_Dep, _Vsn, Repo}, outer_checksum = PkgChecksum}) -> - if (PkgChecksum =/= Hash) andalso (Hash =/= '_') -> - ?WARN("Checksum mismatch for package ~ts-~ts from repo ~ts", [Dep, Vsn, Repo]), - false; - true -> - true - end - end, MatchingPackages - ), - case PackagesWithProperHash of - %% have to allow multiple matches in the list for cases that Repo is `_` - [Package | _] -> - {ok, Package}; - [] -> + case rebar_semver:parse_version(Vsn) of + {ok, Parsed} -> + MatchingPackages = ets:select(Table, [{#package{key={Dep, Parsed, Repo}, + _='_'}, [], ['$_']} || Repo <- Repos]), + PackagesWithProperHash = lists:filter( + fun(#package{key = {_Dep, _Vsn, Repo}, outer_checksum = PkgChecksum}) -> + if (PkgChecksum =/= Hash) andalso (Hash =/= '_') -> + ?WARN("Checksum mismatch for package ~ts-~ts from repo ~ts", [Dep, Vsn, Repo]), + false; + true -> + true + end + end, MatchingPackages + ), + case PackagesWithProperHash of + %% have to allow multiple matches in the list for cases that Repo is `_` + [Package | _] -> + {ok, Package}; + [] -> + not_found + end; + + _ -> not_found end. @@ -174,56 +180,26 @@ package_dir(Repo, State) -> %% `~> 2.1.3-dev` | `>= 2.1.3-dev and < 2.2.0` %% `~> 2.0` | `>= 2.0.0 and < 3.0.0` %% `~> 2.1` | `>= 2.1.0 and < 3.0.0` -find_highest_matching(Dep, Constraint, Repo, Table, State) -> - try find_highest_matching_(Dep, Constraint, Repo, Table, State) of +find_highest_matching(Dep, DepVsn, Repo, Table, State) -> + case find_highest_matching_(Dep, DepVsn, Repo, Table, State) of none -> handle_missing_package(Dep, Repo, State, fun(State1) -> - find_highest_matching_(Dep, Constraint, Repo, Table, State1) + find_highest_matching_(Dep, DepVsn, Repo, Table, State1) end); Result -> Result - catch - _:_ -> - handle_missing_package(Dep, Repo, State, - fun(State1) -> - find_highest_matching_(Dep, Constraint, Repo, Table, State1) - end) end. -find_highest_matching_(Dep, Constraint, #{name := Repo}, Table, State) -> - try get_package_versions(Dep, Constraint, Repo, Table, State) of - [Vsn] -> - handle_single_vsn(Vsn, Constraint); - Vsns -> - case handle_vsns(Constraint, Vsns) of - none -> - none; - FoundVsn -> - {ok, FoundVsn} - end - catch - error:badarg -> - none - end. - -handle_vsns(Constraint, Vsns) -> - lists:foldl(fun(Version, Highest) -> - case ec_semver:pes(Version, Constraint) andalso - (Highest =:= none orelse ec_semver:gt(Version, Highest)) of - true -> - Version; - false -> - Highest - end - end, none, Vsns). - -handle_single_vsn(Vsn, Constraint) -> - case ec_semver:pes(Vsn, Constraint) of - true -> - {ok, Vsn}; - false -> - none +find_highest_matching_(Dep, DepVsn, #{name := Repo}, Table, State) when is_tuple(DepVsn) -> + find_highest_matching_(Dep, rebar_semver:format(DepVsn), Repo, Table, State); +find_highest_matching_(Dep, DepVsn, #{name := Repo}, Table, State) when is_binary(DepVsn) -> + case rebar_semver:parse_version(DepVsn) of + {ok, _} -> + resolve_version_(Dep, <<"~> "/utf8, DepVsn/binary>>, Repo, Table, State); + + {error, _} -> + resolve_version_(Dep, DepVsn, Repo, Table, State) end. verify_table(State) -> @@ -282,17 +258,24 @@ unverified_repo_message() -> "security reasons. The repository should be updated in order to be safer. " "You can disable this check by setting REBAR_NO_VERIFY_REPO_ORIGIN=1". -insert_releases(Name, Releases, Repo, Table) -> - [true = ets:insert(Table, - #package{key={Name, ec_semver:parse(Version), Repo}, - inner_checksum=parse_checksum(InnerChecksum), - outer_checksum=parse_checksum(OuterChecksum), - retired=maps:get(retired, Release, false), - dependencies=parse_deps(Dependencies)}) - || Release=#{inner_checksum := InnerChecksum, - outer_checksum := OuterChecksum, - version := Version, - dependencies := Dependencies} <- Releases]. +insert_releases(_, [], _, _) -> nil; +insert_releases(Name, [Release|Releases], Repo, Table) -> + #{ + inner_checksum := InnerChecksum, + outer_checksum := OuterChecksum, + version := Version, + dependencies := Dependencies + } = Release, + {ok, Parsed} = rebar_semver:parse_version(Version), + Package = #package{ + key={Name, Parsed, Repo}, + inner_checksum=parse_checksum(InnerChecksum), + outer_checksum=parse_checksum(OuterChecksum), + retired=maps:get(retired, Release, false), + dependencies=parse_deps(Dependencies) + }, + true = ets:insert(Table, Package), + insert_releases(Name, Releases, Repo, Table). -spec resolve_version(unicode:unicode_binary(), unicode:unicode_binary() | undefined, binary() | undefined, @@ -313,42 +296,30 @@ resolve_version(Dep, DepVsn, _OldHash, Hash, HexRegistry, State) when is_binary( {ok, RepoConfig} = rebar_hex_repos:get_repo_config(RepoName, RepoConfigs), {ok, Package, RepoConfig}; _ -> - Fun = fun(Repo) -> - case resolve_version_(Dep, DepVsn, Repo, HexRegistry, State) of - none -> - not_found; - {ok, Vsn} -> - get_package(Dep, Vsn, Hash, [Repo], HexRegistry, State) - end - end, - handle_missing_no_exception(Fun, Dep, State) + resolve_version_no_package(Dep, DepVsn, Hash, HexRegistry, State) end; -resolve_version(Dep, undefined, _OldHash, Hash, HexRegistry, State) -> - Fun = fun(Repo) -> - case highest_matching(Dep, {0,{[],[]}}, Repo, HexRegistry, State) of - none -> - not_found; - {ok, Vsn} -> - get_package(Dep, Vsn, Hash, [Repo], HexRegistry, State) - end - end, - handle_missing_no_exception(Fun, Dep, State); + resolve_version(Dep, DepVsn, _OldHash, Hash, HexRegistry, State) -> - case valid_vsn(DepVsn) of - false -> - {error, {invalid_vsn, DepVsn}}; - _ -> + resolve_version_no_package(Dep, DepVsn, Hash, HexRegistry, State). + +resolve_version_no_package(Dep, DepVsn, Hash, HexRegistry, State) -> + case rebar_semver:parse_constraint(DepVsn) of + {ok, _} -> Fun = fun(Repo) -> - case resolve_version_(Dep, DepVsn, Repo, HexRegistry, State) of - none -> - not_found; - {ok, Vsn} -> - get_package(Dep, Vsn, Hash, [Repo], HexRegistry, State) - end - end, - handle_missing_no_exception(Fun, Dep, State) + case resolve_version_(Dep, DepVsn, Repo, HexRegistry, State) of + none -> + not_found; + {ok, Vsn} -> + get_package(Dep, Vsn, Hash, [Repo], HexRegistry, State) + end + end, + handle_missing_no_exception(Fun, Dep, State); + + Error -> + Error end. + check_all_repos(Fun, RepoConfigs) -> ec_lists:search(fun(#{name := R}) -> Fun(R) @@ -374,92 +345,30 @@ handle_missing_no_exception(Fun, Dep, State) -> Result end. -resolve_version_(Dep, DepVsn, Repo, HexRegistry, State) -> - case DepVsn of - <<"~>", Vsn/binary>> -> - highest_matching(Dep, process_vsn(Vsn), Repo, HexRegistry, State); - <<">=", Vsn/binary>> -> - cmp(Dep, process_vsn(Vsn), Repo, HexRegistry, State, fun ec_semver:gte/2); - <<">", Vsn/binary>> -> - cmp(Dep, process_vsn(Vsn), Repo, HexRegistry, State, fun ec_semver:gt/2); - <<"<=", Vsn/binary>> -> - cmpl(Dep, process_vsn(Vsn), Repo, HexRegistry, State, fun ec_semver:lte/2); - <<"<", Vsn/binary>> -> - cmpl(Dep, process_vsn(Vsn), Repo, HexRegistry, State, fun ec_semver:lt/2); - <<"==", Vsn/binary>> -> - {ok, Vsn}; - Vsn -> - {ok, Vsn} - end. - -process_vsn(Vsn) -> - [Vsn1|_] = string:split(Vsn, <<" or ">>), - Vsn2 = string:trim(Vsn1), - ec_semver:parse(Vsn2). - -valid_vsn(Vsn) -> - %% Regepx from https://github.com/sindresorhus/semver-regex/blob/master/index.js - SemVerRegExp = "v?(0|[1-9][0-9]*)\\.(0|[1-9][0-9]*)(\\.(0|[1-9][0-9]*))?" - "(-[0-9a-z-]+(\\.[0-9a-z-]+)*)?(\\+[0-9a-z-]+(\\.[0-9a-z-]+)*)?", - SupportedVersions = "^(>=?|<=?|~>|==)?\\s*" ++ SemVerRegExp ++ "( or .*)?$", - re:run(Vsn, SupportedVersions, [unicode]) =/= nomatch. - -highest_matching(Dep, Vsn, Repo, HexRegistry, State) -> - find_highest_matching_(Dep, Vsn, #{name => Repo}, HexRegistry, State). - -cmp(Dep, Vsn, Repo, HexRegistry, State, CmpFun) -> - case get_package_versions(Dep, Vsn, Repo, HexRegistry, State) of - [] -> - none; - Vsns -> - cmp_(undefined, Vsn, Vsns, CmpFun) - end. - -cmp_(undefined, MinVsn, [], _CmpFun) -> - {ok, MinVsn}; -cmp_(HighestDepVsn, _MinVsn, [], _CmpFun) -> - {ok, HighestDepVsn}; - -cmp_(BestMatch, MinVsn, [Vsn | R], CmpFun) -> - case CmpFun(Vsn, MinVsn) of - true -> - cmp_(Vsn, Vsn, R, CmpFun); - false -> - cmp_(BestMatch, MinVsn, R, CmpFun) - end. - -%% We need to treat this differently since we want a version that is LOWER but -%% the highest possible one. -cmpl(Dep, Vsn, Repo, HexRegistry, State, CmpFun) -> - case get_package_versions(Dep, Vsn, Repo, HexRegistry, State) of - [] -> - none; - Vsns -> - cmpl_(undefined, Vsn, Vsns, CmpFun) +resolve_version_(Dep, Constraint, Repo, HexRegistry, State) -> + case rebar_semver:parse_constraint(Constraint) of + {ok, Match} -> + AllowPreRelease = rebar_semver:is_prerelease_or_build(Constraint), + AllVersions = get_package_versions(Dep, AllowPreRelease, Repo, HexRegistry, State), + resolve_version_loop(Match, AllVersions, none); + + Error -> + Error end. - -cmpl_(undefined, MaxVsn, [], _CmpFun) -> - {ok, MaxVsn}; -cmpl_(HighestDepVsn, _MaxVsn, [], _CmpFun) -> - {ok, HighestDepVsn}; - -cmpl_(undefined, MaxVsn, [Vsn | R], CmpFun) -> - case CmpFun(Vsn, MaxVsn) of - true -> - cmpl_(Vsn, MaxVsn, R, CmpFun); - false -> - cmpl_(undefined, MaxVsn, R, CmpFun) + +resolve_version_loop(_Constraint, [], none) -> none; +resolve_version_loop(_Constraint, [], BestMatch) -> {ok, BestMatch}; +resolve_version_loop(Constraint, [Vsn|R], none) -> + case rebar_semver:match(Vsn, Constraint) of + true -> resolve_version_loop(Constraint, R, Vsn); + _ -> resolve_version_loop(Constraint, R, none) end; - -cmpl_(BestMatch, MaxVsn, [Vsn | R], CmpFun) -> - case CmpFun(Vsn, MaxVsn) of +resolve_version_loop(Constraint, [Vsn|R], BestMatch) -> + case rebar_semver:match(Vsn, Constraint) of true -> - case ec_semver:gte(Vsn, BestMatch) of - true -> - cmpl_(Vsn, MaxVsn, R, CmpFun); - false -> - cmpl_(BestMatch, MaxVsn, R, CmpFun) + case rebar_semver:cmp(Vsn, BestMatch) of + gt -> resolve_version_loop(Constraint, R, Vsn); + _ -> resolve_version_loop(Constraint, R, BestMatch) end; - false -> - cmpl_(BestMatch, MaxVsn, R, CmpFun) + _ -> resolve_version_loop(Constraint, R, BestMatch) end. diff --git a/apps/rebar/src/rebar_semver.erl b/apps/rebar/src/rebar_semver.erl new file mode 100644 index 000000000..5404fb489 --- /dev/null +++ b/apps/rebar/src/rebar_semver.erl @@ -0,0 +1,113 @@ +-module(rebar_semver). +-export([ + parse_version/1, + parse_constraint/1, + is_valid/1, + is_prerelease_or_build/1, + match/2, + cmp/2, + format/1 +]). + +-export_type([version/0, constraint/0]). + +-type version() :: ec_semver:semver(). +-type constraint() :: fun((ec_semver:semver()) -> boolean()). + +-spec parse_version(binary()) -> {ok, version()} | {error, {invalid_vsn, binary()}}. +parse_version(Version) -> + case ec_semver:parse(Version) of + {C, _} when is_binary(C) -> + {error, {invalid_vsn, Version}}; + {{A, B}, _} when is_binary(A); is_binary(B) -> + {error, {invalid_vsn, Version}}; + {{A, B, C}, _} when is_binary(A); is_binary(B); is_binary(C) -> + {error, {invalid_vsn, Version}}; + {{A, B, C, D}, _} when is_binary(A); is_binary(B); is_binary(C); is_binary(D) -> + {error, {invalid_vsn, Version}}; + Parsed -> + {ok, Parsed} + end. + +-spec parse_constraint(undefined | binary()) -> {ok, constraint()} | {error, {invalid_vsn, binary()}}. +parse_constraint(undefined) -> + {ok, fun (_) -> true end}; +parse_constraint(Constraint) -> + case parse_constraint_ors(binary:split(Constraint, [<<" or ">>, <<"||">>], [global]), []) of + nomatch -> {error, {invalid_vsn, Constraint}}; + Match -> {ok, Match} + end. + +parse_constraint_ors([], []) -> nomatch; +parse_constraint_ors([], [Match]) -> Match; +parse_constraint_ors([], Matchers) -> + fun (Vsn) -> lists:any(fun (Match) -> Match(Vsn) end, Matchers) end; +parse_constraint_ors([And|Ors], Matchers) -> + case parse_constraint_ands(binary:split(And, [<<" and ">>, <<"&&">>], [global]), []) of + nomatch -> nomatch; + Match -> parse_constraint_ors(Ors, [Match|Matchers]) + end. + +parse_constraint_ands([], []) -> nomatch; +parse_constraint_ands([], [Match]) -> Match; +parse_constraint_ands([], Matchers) -> + fun (Vsn) -> lists:all(fun (Match) -> Match(Vsn) end, Matchers) end; +parse_constraint_ands([Pattern|Ands], Matchers) -> + case parse_constraint_pattern(Pattern) of + nomatch -> nomatch; + Match -> parse_constraint_ands(Ands, [Match|Matchers]) + end. + +parse_constraint_pattern(<<" ", Vsn/binary>>) -> + parse_constraint_pattern(Vsn); +parse_constraint_pattern(<<"==", Vsn/binary>>) -> + parse_version_constraint(Vsn, fun ec_semver:eql/2); +parse_constraint_pattern(<<">=", Vsn/binary>>) -> + parse_version_constraint(Vsn, fun ec_semver:gte/2); +parse_constraint_pattern(<<"<=", Vsn/binary>>) -> + parse_version_constraint(Vsn, fun ec_semver:lte/2); +parse_constraint_pattern(<<">", Vsn/binary>>) -> + parse_version_constraint(Vsn, fun ec_semver:gt/2); +parse_constraint_pattern(<<"<", Vsn/binary>>) -> + parse_version_constraint(Vsn, fun ec_semver:lt/2); +parse_constraint_pattern(<<"~>", Vsn/binary>>) -> + parse_version_constraint(Vsn, fun ec_semver:pes/2); +parse_constraint_pattern(Vsn) -> + parse_version_constraint(Vsn, fun ec_semver:eql/2). + +parse_version_constraint(Vsn, Match) -> + case parse_version(string:trim(Vsn)) of + {ok, Bound} -> fun (V) -> Match(V, Bound) end; + _ -> nomatch + end. + +-spec is_valid(undefined | binary()) -> boolean(). +is_valid(Vsn) -> + case parse_constraint(Vsn) of + {ok, _} -> true; + _ -> false + end. + +-spec is_prerelease_or_build(undefined | binary()) -> boolean(). +is_prerelease_or_build(undefined) -> false; +is_prerelease_or_build(Vsn) -> + binary:match(Vsn, [<<"-">>, <<"+">>]) =/= nomatch. + +-spec match(version(), constraint()) -> boolean(). +match(Version, Constraint) -> + Constraint(Version). + +-spec cmp(version(), version()) -> gt | lt | eq. +cmp(Vsn1, Vsn2) -> + case ec_semver:gt(Vsn1, Vsn2) of + true -> gt; + false -> + case ec_semver:lt(Vsn1, Vsn2) of + true -> lt; + false -> eq + end + end. + +-spec format(version()) -> binary(). +format(Vsn) -> + iolist_to_binary(ec_semver:format(Vsn)). diff --git a/apps/rebar/test/mock_pkg_resource.erl b/apps/rebar/test/mock_pkg_resource.erl index ec571f3c6..f609b5f36 100644 --- a/apps/rebar/test/mock_pkg_resource.erl +++ b/apps/rebar/test/mock_pkg_resource.erl @@ -173,8 +173,8 @@ to_index(AllDeps, Dict, Repos) -> DKB <- [ec_cnv:to_binary(DK)], DVB <- [ec_cnv:to_binary(DV)]], Repo = rebar_test_utils:random_element(Repos), - - ets:insert(?PACKAGE_TABLE, #package{key={N, ec_semver:parse(V), Repo}, + {ok, Parsed} = rebar_semver:parse_version(V), + ets:insert(?PACKAGE_TABLE, #package{key={N, Parsed, Repo}, dependencies=parse_deps(DepsList), retired=false, inner_checksum = <<"inner_checksum">>, @@ -182,12 +182,13 @@ to_index(AllDeps, Dict, Repos) -> end, ok, Dict), lists:foreach(fun({{Name, Vsn}, _}) -> + {ok, Parsed} = rebar_semver:parse_version(Vsn), case lists:any(fun(R) -> - ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(Name), ec_semver:parse(Vsn), R}) + ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(Name), Parsed, R}) end, Repos) of false -> Repo = rebar_test_utils:random_element(Repos), - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(Name), ec_semver:parse(Vsn), Repo}, + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(Name), Parsed, Repo}, dependencies=[], retired=false, inner_checksum = <<"inner_checksum">>, diff --git a/apps/rebar/test/rebar_deps_SUITE.erl b/apps/rebar/test/rebar_deps_SUITE.erl index 6e1f896ee..4f69ae74d 100644 --- a/apps/rebar/test/rebar_deps_SUITE.erl +++ b/apps/rebar/test/rebar_deps_SUITE.erl @@ -6,8 +6,7 @@ all() -> [sub_app_deps, newly_added_dep, newly_added_after_empty_lock, no_deps_empty_lock, http_proxy_settings, https_proxy_settings, http_os_proxy_settings, https_os_proxy_settings, - semver_matching_lt, semver_matching_lte, semver_matching_gt, - valid_version, top_override, {group, git}, {group, pkg}, + top_override, {group, git}, {group, pkg}, deps_cmd_needs_update_called ]. @@ -37,12 +36,6 @@ end_per_group(_, Config) -> init_per_testcase(valid_version, Config) -> rebar_test_utils:init_rebar_state(Config); -init_per_testcase(semver_matching_lt, Config) -> - rebar_test_utils:init_rebar_state(Config); -init_per_testcase(semver_matching_lte, Config) -> - rebar_test_utils:init_rebar_state(Config); -init_per_testcase(semver_matching_gt, Config) -> - rebar_test_utils:init_rebar_state(Config); init_per_testcase(newly_added_after_empty_lock, Config) -> rebar_test_utils:init_rebar_state(Config); init_per_testcase(no_deps_empty_lock, Config) -> @@ -443,68 +436,6 @@ https_os_proxy_settings(_Config) -> ?assertEqual({ok,{{"localhost", 1234}, []}}, httpc:get_option(https_proxy, rebar)). -semver_matching_lt(_Config) -> - MaxVsn = <<"0.2.0">>, - Vsns = [<<"0.1.7">>, <<"0.1.9">>, <<"0.1.8">>, <<"0.2.0">>, <<"0.2.1">>], - ?assertEqual({ok, <<"0.1.9">>}, - rebar_packages:cmpl_(undefined, MaxVsn, Vsns, - fun ec_semver:lt/2)). - -semver_matching_lte(_Config) -> - MaxVsn = <<"0.2.0">>, - Vsns = [<<"0.1.7">>, <<"0.1.9">>, <<"0.1.8">>, <<"0.2.0">>, <<"0.2.1">>], - ?assertEqual({ok, <<"0.2.0">>}, - rebar_packages:cmpl_(undefined, MaxVsn, Vsns, - fun ec_semver:lte/2)). - -semver_matching_gt(_Config) -> - MaxVsn = <<"0.2.0">>, - Vsns = [<<"0.1.7">>, <<"0.1.9">>, <<"0.1.8">>, <<"0.2.0">>, <<"0.2.1">>], - ?assertEqual({ok, <<"0.2.1">>}, - rebar_packages:cmp_(undefined, MaxVsn, Vsns, - fun ec_semver:gt/2)). -semver_matching_gte(_Config) -> - MaxVsn = <<"0.2.0">>, - Vsns = [<<"0.1.7">>, <<"0.1.9">>, <<"0.1.8">>, <<"0.2.0">>], - ?assertEqual({ok, <<"0.2.0">>}, - rebar_packages:cmp_(undefined, MaxVsn, Vsns, - fun ec_semver:gt/2)). - -valid_version(_Config) -> - ?assert(rebar_packages:valid_vsn(<<"0.1">>)), - ?assert(rebar_packages:valid_vsn(<<"0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<" 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<" 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"<0.1">>)), - ?assert(rebar_packages:valid_vsn(<<"<0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"< 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"< 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<">0.1">>)), - ?assert(rebar_packages:valid_vsn(<<">0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"> 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"> 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"<=0.1">>)), - ?assert(rebar_packages:valid_vsn(<<"<=0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"<= 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"<= 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<">=0.1">>)), - ?assert(rebar_packages:valid_vsn(<<">=0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<">= 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<">= 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"==0.1">>)), - ?assert(rebar_packages:valid_vsn(<<"==0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"== 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"== 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"~>0.1">>)), - ?assert(rebar_packages:valid_vsn(<<"~>0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"~> 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"~> 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"~> 0.1 or 0.5">>)), - ?assert(rebar_packages:valid_vsn(<<"~> 0.1-or-something">>)), - ?assertNot(rebar_packages:valid_vsn(<<"> 0.1.0 and < 0.2.0">>)), - ok. - - run(Config) -> {ok, RebarConfig} = file:consult(?config(rebarconfig, Config)), rebar_test_utils:run_and_check( diff --git a/apps/rebar/test/rebar_pkg_SUITE.erl b/apps/rebar/test/rebar_pkg_SUITE.erl index 1bfce0913..4c89073cf 100644 --- a/apps/rebar/test/rebar_pkg_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_SUITE.erl @@ -231,22 +231,22 @@ pkgs_provider(Config) -> find_highest_matching(_Config) -> State = rebar_state:new(), {ok, Vsn} = rebar_packages:find_highest_matching_( - <<"goodpkg">>, ec_semver:parse(<<"1.0.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + <<"goodpkg">>, <<"1.0.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), ?assertEqual({{1,0,1},{[],[]}}, Vsn), {ok, Vsn1} = rebar_packages:find_highest_matching( - <<"goodpkg">>, ec_semver:parse(<<"1.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + <<"goodpkg">>, <<"1.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), ?assertEqual({{1,1,1},{[],[]}}, Vsn1), {ok, Vsn2} = rebar_packages:find_highest_matching( - <<"goodpkg">>, ec_semver:parse(<<"2.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + <<"goodpkg">>, <<"2.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), ?assertEqual({{2,0,0},{[],[]}}, Vsn2), %% regression test. ~> constraints higher than the available packages would result %% in returning the first package version instead of 'none'. - ?assertEqual(none, rebar_packages:find_highest_matching_(<<"goodpkg">>, ec_semver:parse(<<"5.0">>), + ?assertEqual(none, rebar_packages:find_highest_matching_(<<"goodpkg">>, <<"5.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State)), - {ok, Vsn3} = rebar_packages:find_highest_matching_(<<"goodpkg">>, ec_semver:parse(<<"3.0.0-rc.0">>), + {ok, Vsn3} = rebar_packages:find_highest_matching_(<<"goodpkg">>, <<"3.0.0-rc.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), ?assertEqual({{3,0,0},{[<<"rc">>,0],[]}}, Vsn3). @@ -277,7 +277,8 @@ mock_config(Name, Config) -> lists:foreach(fun({{N, Vsn}, [Deps, InnerChecksum, OuterChecksum, _]}) -> case ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(N), Vsn, <<"hexpm">>}) of false -> - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), ec_semver:parse(Vsn), <<"hexpm">>}, + {ok, Parsed} = rebar_semver:parse_version(Vsn), + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), Parsed, <<"hexpm">>}, dependencies=Deps, retired=false, inner_checksum=InnerChecksum, diff --git a/apps/rebar/test/rebar_pkg_alias_SUITE.erl b/apps/rebar/test/rebar_pkg_alias_SUITE.erl index 5ba544de7..6aaea9c6f 100644 --- a/apps/rebar/test/rebar_pkg_alias_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_alias_SUITE.erl @@ -229,7 +229,8 @@ mock_config(Name, Config) -> lists:foreach(fun({{N, Vsn}, [Deps, Checksum, _]}) -> case ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(N), Vsn, <<"hexpm">>}) of false -> - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), ec_semver:parse(Vsn), <<"hexpm">>}, + {ok, Parsed} = rebar_semver:parse_version(Vsn), + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), Parsed, <<"hexpm">>}, dependencies=[{DAppName, {pkg, DN, DV, undefined}} || {DN, DV, _, DAppName} <- Deps], retired=false, outer_checksum=Checksum}); diff --git a/apps/rebar/test/rebar_pkg_repos_SUITE.erl b/apps/rebar/test/rebar_pkg_repos_SUITE.erl index 76654c131..4cb5ee26a 100644 --- a/apps/rebar/test/rebar_pkg_repos_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_repos_SUITE.erl @@ -492,16 +492,18 @@ setup_deps_and_repos(Deps, Repos) -> insert_deps(Deps) -> lists:foreach(fun({Name, Version, Repo, Retired}) -> + {ok, Parsed} = rebar_semver:parse_version(Version), ets:insert(?PACKAGE_TABLE, #package{key={rebar_utils:to_binary(Name), - ec_semver:parse(Version), + Parsed, rebar_utils:to_binary(Repo)}, dependencies=[], retired=Retired, inner_checksum = <<"inner checksum">>, outer_checksum = <<"outer checksum">>}); ({Name, Version, InnerChecksum, OuterChecksum, Repo, Retired}) -> + {ok, Parsed} = rebar_semver:parse_version(Version), ets:insert(?PACKAGE_TABLE, #package{key={rebar_utils:to_binary(Name), - ec_semver:parse(Version), + Parsed, rebar_utils:to_binary(Repo)}, dependencies=[], retired=Retired, diff --git a/apps/rebar/test/rebar_semver_SUITE.erl b/apps/rebar/test/rebar_semver_SUITE.erl new file mode 100644 index 000000000..03dea7b11 --- /dev/null +++ b/apps/rebar/test/rebar_semver_SUITE.erl @@ -0,0 +1,185 @@ +-module(rebar_semver_SUITE). + +-compile(export_all). + +-include_lib("eunit/include/eunit.hrl"). + +-define(assert_valid(Version), ?assert(rebar_semver:is_valid(Version))). +-define(assert_invalid(Version), ?assertNot(rebar_semver:is_valid(Version))). +-define(assert_matches(Version, Constraint), + ?assert(begin + {ok, ParsedVersion} = rebar_semver:parse_version(Version), + {ok, ParsedConstraint} = rebar_semver:parse_constraint(Constraint), + rebar_semver:match(ParsedVersion, ParsedConstraint) + end)). +-define(assert_matchesNot(Version, Constraint), + ?assertNot(begin + {ok, ParsedVersion} = rebar_semver:parse_version(Version), + {ok, ParsedConstraint} = rebar_semver:parse_constraint(Constraint), + rebar_semver:match(ParsedVersion, ParsedConstraint) + end)). + +all() -> + [valid_version, + invalid_version, + exact_matches, + range_matches, + approximate_matches, + and_matches, + or_matches, + prerelease_ordering, + prerelease_matching, + zero_versions, + tilde_upper_bounds, + complex_precedence]. + +valid_version(_Config) -> + ?assert_valid(<<"0.1">>), + ?assert_valid(<<"0.1.0">>), + ?assert_valid(<<" 0.1.0">>), + ?assert_valid(<<" 0.1.0">>), + ?assert_valid(<<"<0.1">>), + ?assert_valid(<<"<0.1.0">>), + ?assert_valid(<<"< 0.1.0">>), + ?assert_valid(<<"< 0.1.0">>), + ?assert_valid(<<">0.1">>), + ?assert_valid(<<">0.1.0">>), + ?assert_valid(<<"> 0.1.0">>), + ?assert_valid(<<"> 0.1.0">>), + ?assert_valid(<<"<=0.1">>), + ?assert_valid(<<"<=0.1.0">>), + ?assert_valid(<<"<= 0.1.0">>), + ?assert_valid(<<"<= 0.1.0">>), + ?assert_valid(<<">=0.1">>), + ?assert_valid(<<">=0.1.0">>), + ?assert_valid(<<">= 0.1.0">>), + ?assert_valid(<<">= 0.1.0">>), + ?assert_valid(<<"==0.1">>), + ?assert_valid(<<"==0.1.0">>), + ?assert_valid(<<"== 0.1.0">>), + ?assert_valid(<<"== 0.1.0">>), + ?assert_valid(<<"~>0.1">>), + ?assert_valid(<<"~>0.1.0">>), + ?assert_valid(<<"~> 0.1.0">>), + ?assert_valid(<<"~> 0.1.0">>), + ?assert_valid(<<"~> 0.1 or 0.5">>), + ?assert_valid(<<"~> 0.1-or-something">>), + ?assert_valid(<<"> 0.1.0 and < 0.2.0">>), + ?assert_valid(<<"> 0.1.0&&< 0.2.0">>), + ?assert_valid(<<"> 0.1.0 && < 0.2.0">>), + ?assert_valid(<<"> 0.1.0 && < 0.2.0">>), + ?assert_valid(<<"~> 6.6 or ~> 6.7">>), + ?assert_valid(<<"0.9.9-rc.1 or > 1.0.0 and < 2.0.0">>), + ?assert_valid(<<"~> 6.6||~> 6.7">>), + ?assert_valid(<<"~> 6.6 || ~> 6.7">>), + ?assert_valid(<<"~> 6.6 || ~> 6.7">>), + ok. + +invalid_version(_Config) -> + ?assert_invalid(<<"">>), + ?assert_invalid(<<"1.2.x">>), + ?assert_invalid(<<"abc">>), + ?assert_invalid(<<"1.2.three">>), + ?assert_invalid(<<"1.-2.3">>), + ?assert_invalid(<<".1.2.3">>), + ?assert_invalid(<<"1.2.">>), + ok. + +exact_matches(_) -> + ?assert_matches(<<"1.0.0">>, <<"1">>), + ?assert_matches(<<"1.0.0">>, <<"1.0">>), + ?assert_matches(<<"1.0.0">>, <<"1.0.0">>), + ?assert_matchesNot(<<"1.0.0-rc.1">>, <<"1.0.0-rc.2">>), + ?assert_matchesNot(<<"1.0.0">>, <<"1.0.0-rc.2">>), + ?assert_matchesNot(<<"1.0.0-rc.1">>, <<"1.0.0">>), + ?assert_matchesNot(<<"1.0.1">>, <<"1.0">>), + ?assert_matchesNot(<<"1.0.1">>, <<"1">>), + ok. + +range_matches(_) -> + ?assert_matches(<<"1.0.0">>, <<">=1">>), + ?assert_matches(<<"1.0.0">>, <<">=1.0">>), + ?assert_matches(<<"1.0.0">>, <<">=1.0.0">>), + ?assert_matches(<<"1.0.0">>, <<">=1.0-rc.1">>), + ?assert_matches(<<"99.0.0">>, <<">=1">>), + ?assert_matchesNot(<<"1.0.0">>, <<">1">>), + ?assert_matchesNot(<<"1.0.0">>, <<"<1">>), + ?assert_matches(<<"0.65.0">>, <<"<2">>), + ?assert_matchesNot(<<"1.5.5-rc.3">>, <<">2.0.0">>), + ok. + +approximate_matches(_) -> + ?assert_matches(<<"1.5.6-rc.3">>, <<"~> 1.5.5">>), + ?assert_matches(<<"1.3.2">>, <<"~> 1.0">>), + ?assert_matches(<<"1.3.2">>, <<"~> 1">>), + ?assert_matches(<<"1.3.2">>, <<"~> 1.3">>), + ?assert_matches(<<"1.3.2">>, <<"~> 1.3.2">>), + ?assert_matchesNot(<<"1.3.2">>, <<"~> 1.2.2">>), + ?assert_matches(<<"1.3.2">>, <<"~> 1.3.1-rc.1">>), + ?assert_matchesNot(<<"1.2.3">>, <<"~> 1.4">>), + ok. + +and_matches(_) -> + ?assert_matches(<<"1.2.3">>, <<">= 1.2 and < 2">>), + ?assert_matchesNot(<<"1.2.3">>, <<">= 1.2 and < 1.2">>), + ?assert_matchesNot(<<"1.2.3">>, <<">= 1.3 and < 2">>), + ?assert_matchesNot(<<"2.0.0">>, <<">= 1.2 and < 2">>), + ?assert_matches(<<"1.2.3">>, <<"~> 1.2 and ~>1">>), + ok. + +or_matches(_) -> + ?assert_matches(<<"3.8.6">>, <<"~> 2 or ~> 3">>), + ?assert_matches(<<"3.5.3">>, <<" >= 3 and < 4 or ~> 3.5.2">>), + ok. + +prerelease_ordering(_Config) -> + ?assert_matches(<<"1.0.0-alpha">>, <<">= 1.0.0-alpha">>), + ?assert_matches(<<"1.0.0-alpha.1">>, <<"> 1.0.0-alpha">>), + ?assert_matchesNot(<<"1.0.0-alpha">>, <<"> 1.0.0-alpha.1">>), + ?assert_matches(<<"1.0.0-alpha.beta">>, <<"> 1.0.0-alpha.1">>), + ?assert_matches(<<"1.0.0-beta">>, <<"> 1.0.0-alpha.beta">>), + ?assert_matches(<<"1.0.0-beta.2">>, <<"> 1.0.0-beta">>), + ?assert_matches(<<"1.0.0-beta.11">>, <<"> 1.0.0-beta.2">>), + ?assert_matches(<<"1.0.0-rc.1">>, <<"> 1.0.0-beta.11">>), + ?assert_matches(<<"1.0.0">>, <<"> 1.0.0-rc.1">>), + ok. + +prerelease_matching(_Config) -> + ?assert_matchesNot(<<"1.0.0-alpha">>, <<"1.0.0">>), + ?assert_matchesNot(<<"1.0.0-rc.1">>, <<"~> 1.0">>), + ?assert_matches(<<"1.0.0-rc.1">>, <<"~> 1.0.0-alpha">>), + ?assert_matches(<<"1.0.0-rc.1">>, <<">= 1.0.0-alpha and < 1.0.0">>), + ok. + +zero_versions(_Config) -> + ?assert_matches(<<"0.0.0">>, <<"0.0.0">>), + ?assert_matches(<<"0.0.1">>, <<"> 0.0.0">>), + ?assert_matches(<<"0.1.0">>, <<"> 0.0.1">>), + ?assert_matches(<<"0.0.5">>, <<"~> 0.0.1">>), + ?assert_matchesNot(<<"0.1.0">>, <<"~> 0.0.1">>), + ?assert_matches(<<"0.5.0">>, <<"~> 0.1">>), + ?assert_matchesNot(<<"1.0.0">>, <<"~> 0.1">>), + ?assert_matches(<<"0.0.0">>, <<">= 0">>), + ?assert_matches(<<"0.9.9">>, <<"< 1">>), + ok. + +tilde_upper_bounds(_Config) -> + ?assert_matches(<<"1.2.9">>, <<"~> 1.2.3">>), + ?assert_matchesNot(<<"1.3.0">>, <<"~> 1.2.3">>), + ?assert_matches(<<"1.9.9">>, <<"~> 1.2">>), + ?assert_matchesNot(<<"2.0.0">>, <<"~> 1.2">>), + ?assert_matches(<<"1.999.999">>, <<"~> 1.0">>), + ?assert_matches(<<"2.0.0">>, <<"~> 1">>), + ?assert_matches(<<"1.2.10">>, <<"~> 1.2.3">>), + ok. + +complex_precedence(_Config) -> + ?assert_matches(<<"0.4.0">>, <<"~> 1.0 and >= 1.2 or < 0.5">>), + ?assert_matchesNot(<<"1.1.0">>, <<"~> 1.0 and >= 1.2 or < 0.5">>), + ?assert_matches(<<"1.3.0">>, <<"~> 1.0 and >= 1.2 or < 0.5">>), + ?assert_matches(<<"1.5.0">>, <<"~> 1.0 or ~> 2.0 or ~> 3.0">>), + ?assert_matches(<<"2.5.0">>, <<"~> 1.0 or ~> 2.0 or ~> 3.0">>), + ?assert_matches(<<"3.5.0">>, <<"~> 1.0 or ~> 2.0 or ~> 3.0">>), + ?assert_matches(<<"3.2.1">>, <<"~> 3.3 || ~> 3.2.1">>), + ?assert_matchesNot(<<"4.5.0">>, <<"~> 1.0 or ~> 2.0 or ~> 3.0">>), + ok.