diff options
-rw-r--r-- | src/rlx_release.erl | 9 | ||||
-rw-r--r-- | src/rlx_topo.erl | 237 | ||||
-rw-r--r-- | test/rlx_eunit_SUITE.erl | 8 |
3 files changed, 251 insertions, 3 deletions
diff --git a/src/rlx_release.erl b/src/rlx_release.erl index 0260402..5765079 100644 --- a/src/rlx_release.erl +++ b/src/rlx_release.erl @@ -144,7 +144,12 @@ goals(#release_t{goals=Goals}) -> {ok, t()}. realize(Rel, Pkgs0, World0) -> World1 = subset_world(Pkgs0, World0), - process_specs(realize_erts(Rel), World1). + case rlx_topo:sort_apps(World1) of + {ok, Pkgs1} -> + process_specs(realize_erts(Rel), Pkgs1); + Error={error, _} -> + Error + end. %% @doc this gives the application specs for the release. This can only be %% populated by the 'realize' call in this module. @@ -239,6 +244,8 @@ format_goal(Constraint) -> rlx_depsolver:format_constraint(Constraint). -spec format_error(Reason::term()) -> iolist(). +format_error({topo_error, E}) -> + rlx_topo:format_error(E); format_error({failed_to_parse, Con}) -> io_lib:format("Failed to parse constraint ~p", [Con]); format_error({invalid_constraint, _, Con}) -> diff --git a/src/rlx_topo.erl b/src/rlx_topo.erl new file mode 100644 index 0000000..b9c94b1 --- /dev/null +++ b/src/rlx_topo.erl @@ -0,0 +1,237 @@ +%% -*- erlang-indent-level: 4; indent-tabs-mode: nil; fill-column: 80 -*- +%%% Copyright 2012 Erlware, LLC. All Rights Reserved. +%%% +%%% This file is provided to you under the Apache License, +%%% Version 2.0 (the "License"); you may not use this file +%%% except in compliance with the License. You may obtain +%%% a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, +%%% software distributed under the License is distributed on an +%%% "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +%%% KIND, either express or implied. See the License for the +%%% specific language governing permissions and limitations +%%% under the License. +%%%------------------------------------------------------------------- +%%% @author Joe Armstrong +%%% @author Eric Merritt +%%% @doc +%%% This is a pretty simple topological sort for erlang. It was +%%% originally written for ermake by Joe Armstrong back in '98. It +%%% has been pretty heavily modified by Eric Merritt since '06 and modified again for Relx. +%%% +%%% A partial order on the set S is a set of pairs {Xi,Xj} such that +%%% some relation between Xi and Xj is obeyed. +%%% +%%% A topological sort of a partial order is a sequence of elements +%%% [X1, X2, X3 ...] such that if whenever {Xi, Xj} is in the partial +%%% order i < j +%%% @end +%%%------------------------------------------------------------------- +-module(rlx_topo). + +-export([sort/1, + sort_apps/1, + format_error/1]). + +-include("relx.hrl"). + +%%==================================================================== +%% Types +%%==================================================================== +-type pair() :: {DependentApp::atom(), PrimaryApp::atom()}. +-type name() :: AppName::atom(). +-type element() :: name() | pair(). + +%%==================================================================== +%% API +%%==================================================================== + +%% @doc This only does a topo sort on the list of applications and +%% assumes that there is only *one* version of each app in the list of +%% applications. This implies that you have already done the +%% constraint solve before you pass the list of apps here to be +%% sorted. +-spec sort_apps([rlx_app_info:t()]) -> + {ok, [rlx_app_info:t()]} | + relx:error(). +sort_apps(Apps) -> + Pairs = apps_to_pairs(Apps), + case sort(Pairs) of + {ok, Names} -> + {ok, names_to_apps(Names, Apps)}; + E -> + E + end. + +%% @doc Do a topological sort on the list of pairs. +-spec sort([pair()]) -> {ok, [atom()]} | relx:error(). +sort(Pairs) -> + iterate(Pairs, [], all(Pairs)). + +%% @doc nicely format the error from the sort. +-spec format_error(Reason::term()) -> iolist(). +format_error({cycle, Pairs}) -> + ["Cycle detected in dependency graph, this must be resolved " + "before we can continue:\n", + case Pairs of + [{P1, P2}] -> + [rlx_util:indent(2), erlang:atom_to_list(P2), "->", erlang:atom_to_list(P1)]; + [{P1, P2} | Rest] -> + [rlx_util:indent(2), erlang:atom_to_list(P2), "->", erlang:atom_to_list(P1), + [["-> ", erlang:atom_to_list(PP2), " -> ", erlang:atom_to_list(PP1)] || {PP1, PP2} <- Rest]]; + [] -> + [] + end]. + +%%==================================================================== +%% Internal Functions +%%==================================================================== +-spec names_to_apps([atom()], [rlx_app_info:t()]) -> [rlx_app_info:t()]. +names_to_apps(Names, Apps) -> + [find_app_by_name(Name, Apps) || Name <- Names]. + +-spec find_app_by_name(atom(), [rlx_app_info:t()]) -> rlx_app_info:t(). +find_app_by_name(Name, Apps) -> + {ok, App1} = + ec_lists:find(fun(App) -> + rlx_app_info:name(App) =:= Name + end, Apps), + App1. + +-spec apps_to_pairs([rlx_app_info:t()]) -> [pair()]. +apps_to_pairs(Apps) -> + lists:flatten([app_to_pairs(App) || App <- Apps]). + +-spec app_to_pairs(rlx_app_info:t()) -> [pair()]. +app_to_pairs(App) -> + [{DepApp, rlx_app_info:name(App)} || + DepApp <- + rlx_app_info:active_deps(App) ++ + rlx_app_info:library_deps(App)]. + + +%% @doc Iterate over the system. @private +-spec iterate([pair()], [name()], [name()]) -> + {ok, [name()]} | relx:error(). +iterate([], L, All) -> + {ok, remove_duplicates(L ++ subtract(All, L))}; +iterate(Pairs, L, All) -> + case subtract(lhs(Pairs), rhs(Pairs)) of + [] -> + ?RLX_ERROR({cycle, Pairs}); + Lhs -> + iterate(remove_pairs(Lhs, Pairs), L ++ Lhs, All) + end. + +-spec all([pair()]) -> [atom()]. +all(L) -> + lhs(L) ++ rhs(L). + +-spec lhs([pair()]) -> [atom()]. +lhs(L) -> + [X || {X, _} <- L]. + +-spec rhs([pair()]) -> [atom()]. +rhs(L) -> + [Y || {_, Y} <- L]. + +%% @doc all the elements in L1 which are not in L2 +%% @private +-spec subtract([element()], [element()]) -> [element()]. +subtract(L1, L2) -> + [X || X <- L1, not lists:member(X, L2)]. + +%% @doc remove dups from the list. @private +-spec remove_duplicates([element()]) -> [element()]. +remove_duplicates([H|T]) -> + case lists:member(H, T) of + true -> + remove_duplicates(T); + false -> + [H|remove_duplicates(T)] + end; +remove_duplicates([]) -> + []. + +%% @doc +%% removes all pairs from L2 where the first element +%% of each pair is a member of L1 +%% +%% L2' L1 = [X] L2 = [{X,Y}]. +%% @private +-spec remove_pairs([atom()], [pair()]) -> [pair()]. +remove_pairs(L1, L2) -> + [All || All={X, _Y} <- L2, not lists:member(X, L1)]. + +%%==================================================================== +%% Tests +%%==================================================================== +-ifdef(TEST). +-include_lib("eunit/include/eunit.hrl"). + +topo_1_test() -> + Pairs = [{one,two},{two,four},{four,six}, + {two,ten},{four,eight}, + {six,three},{one,three}, + {three,five},{five,eight}, + {seven,five},{seven,nine}, + {nine,four},{nine,ten}], + ?assertMatch({ok, [one,seven,two,nine,four,six,three,five,eight,ten]}, + sort(Pairs)). +topo_2_test() -> + Pairs = [{app2, app1}, {zapp1, app1}, {stdlib, app1}, + {app3, app2}, {kernel, app1}, {kernel, app3}, + {app2, zapp1}, {app3, zapp1}, {zapp2, zapp1}], + ?assertMatch({ok, [stdlib, kernel, zapp2, + app3, app2, zapp1, app1]}, + sort(Pairs)). + +topo_pairs_cycle_test() -> + Pairs = [{app2, app1}, {app1, app2}, {stdlib, app1}], + ?assertMatch({error, {_, {cycle, [{app2, app1}, {app1, app2}]}}}, + sort(Pairs)). + +topo_apps_cycle_test() -> + {ok, App1} = rlx_app_info:new(app1, "0.1", "/no-dir", [app2], [stdlib]), + {ok, App2} = rlx_app_info:new(app2, "0.1", "/no-dir", [app1], []), + Apps = [App1, App2], + ?assertMatch({error, {_, {cycle, [{app2,app1},{app1,app2}]}}}, + sort_apps(Apps)). + +topo_apps_good_test() -> + Apps = [App || + {ok, App} <- + [rlx_app_info:new(app1, "0.1", "/no-dir", [app2, zapp1], [stdlib, kernel]), + rlx_app_info:new(app2, "0.1", "/no-dir", [app3], []), + rlx_app_info:new(app3, "0.1", "/no-dir", [kernel], []), + rlx_app_info:new(zapp1, "0.1", "/no-dir", [app2,app3,zapp2], []), + rlx_app_info:new(stdlib, "0.1", "/no-dir", [], []), + rlx_app_info:new(kernel, "0.1", "/no-dir", [], []), + rlx_app_info:new(zapp2, "0.1", "/no-dir", [], [])]], + {ok, Sorted} = sort_apps(Apps), + ?assertMatch([stdlib, kernel, zapp2, + app3, app2, zapp1, app1], + [rlx_app_info:name(App) || App <- Sorted]). + +topo_apps_2_test() -> + Apps = [App || + {ok, App} <- + [rlx_app_info:new(app1, "0.1", "/no-dir", [app2, app3, app4, app5, + stdlib, kernel], + []), + rlx_app_info:new(app2, "0.1", "/no-dir", [stdlib, kernel], []), + rlx_app_info:new(app3, "0.1", "/no-dir", [stdlib, kernel], []), + rlx_app_info:new(app4, "0.1", "/no-dir", [stdlib, kernel], []), + rlx_app_info:new(app5, "0.1", "/no-dir", [stdlib, kernel], []), + rlx_app_info:new(stdlib, "0.1", "/no-dir", [], []), + rlx_app_info:new(kernel, "0.1", "/no-dir", [], []) + ]], + {ok, Sorted} = sort_apps(Apps), + ?assertMatch([stdlib, kernel, app2, + app3, app4, app5, app1], + [rlx_app_info:name(App) || App <- Sorted]). + +-endif. diff --git a/test/rlx_eunit_SUITE.erl b/test/rlx_eunit_SUITE.erl index d429f36..874e5a6 100644 --- a/test/rlx_eunit_SUITE.erl +++ b/test/rlx_eunit_SUITE.erl @@ -23,7 +23,8 @@ all/0, depsolver/1, goal/1, - app_info/1]). + app_info/1, + topo/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("eunit/include/eunit.hrl"). @@ -38,7 +39,7 @@ end_per_suite(_Config) -> ok. all() -> - [depsolver, goal, app_info]. + [depsolver, goal, app_info, topo]. depsolver(_Config) -> ok = eunit:test(rlx_depsolver). @@ -48,3 +49,6 @@ goal(_Config) -> app_info(_Config) -> ok = eunit:test(rlx_app_info). + +topo(_Config) -> + ok = eunit:test(rlx_topo). |