├── .gitignore ├── Makefile ├── README.md ├── deps ├── README.md ├── parse_trans │ ├── include │ │ └── codegen.hrl │ └── src │ │ ├── parse_trans.erl │ │ ├── parse_trans_codegen.erl │ │ ├── parse_trans_mod.erl │ │ └── parse_trans_pp.erl └── sheriff │ └── src │ └── sheriff.erl ├── examples ├── bridge │ ├── _old_versions │ │ ├── fair │ │ │ └── src │ │ │ │ ├── bridge.erl │ │ │ │ └── bridge_test.erl │ │ ├── fair_cpre │ │ │ └── src │ │ │ │ ├── bridge.erl │ │ │ │ └── bridge_test.erl │ │ └── plain │ │ │ └── src │ │ │ ├── bridge.erl │ │ │ └── bridge_test.erl │ ├── fair │ │ └── src │ │ │ ├── bridge.erl │ │ │ └── bridge_test.erl │ └── unfair │ │ └── src │ │ ├── bridge.erl │ │ └── bridge_test.erl ├── other │ └── src │ │ ├── ej1.erl │ │ ├── ej_paper.erl │ │ ├── library.erl │ │ ├── library_test.erl │ │ └── merge.erl ├── readers_writers │ ├── fair │ │ └── src │ │ │ ├── readers_writers.erl │ │ │ └── readers_writers_test.erl │ ├── fair_queues │ │ └── src │ │ │ ├── readers_writers.erl │ │ │ └── readers_writers_test.erl │ ├── unfair4readers │ │ └── src │ │ │ ├── readers_writers.erl │ │ │ └── readers_writers_test.erl │ ├── unfair4readers_queues │ │ └── src │ │ │ ├── readers_writers.erl │ │ │ └── readers_writers_test.erl │ ├── unfair4writers │ │ └── src │ │ │ ├── readers_writers.erl │ │ │ └── readers_writers_test.erl │ └── unfair4writers_queues │ │ └── src │ │ ├── readers_writers.erl │ │ └── readers_writers_test.erl ├── sel_recv │ ├── gen_server │ │ └── src │ │ │ ├── sel_recv.erl │ │ │ └── sel_recv_test.erl │ └── gen_server_qcpre │ │ └── src │ │ ├── sel_recv.erl │ │ └── sel_recv_test.erl └── semaphore │ ├── no_queues │ └── src │ │ ├── semaphore.erl │ │ └── semaphore_tests.erl │ └── queues │ └── src │ ├── semaphore.erl │ └── semaphore_tests.erl ├── include └── edbc.hrl ├── other └── TODO.md ├── scripts ├── edbc_edoc ├── edbc_erl ├── edbc_erlc └── edbc_erlcp └── src ├── edbc_free_vars_server.erl ├── edbc_lib.erl ├── edbc_parse_transform.erl ├── error_logger_mod.erl ├── gen_mod.erl ├── gen_server_cpre.erl ├── gen_server_qcpre.erl └── proc_lib_mod.erl /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *.beam 3 | 4 | *.dump 5 | 6 | src/output 7 | 8 | src/output2 9 | 10 | examples/bridge/fair/output 11 | 12 | output 13 | 14 | output_fair 15 | 16 | output_unfair 17 | 18 | output_unfair4readers 19 | 20 | output_unfair4writers 21 | 22 | output.xml 23 | 24 | doc/ 25 | 26 | especificacion.pdf 27 | 28 | output2 29 | examples/other/docs/* 30 | examples/other/src/ej_temp.erl 31 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | compile: 2 | @make depend 3 | @rm -Rf ebin 4 | @mkdir ebin 5 | @erlc -W0 -pa deps/sheriff/ebin -o ebin src/*.erl 6 | 7 | depend: 8 | @rm -Rf deps/parse_trans/ebin 9 | @mkdir deps/parse_trans/ebin 10 | @erlc -W0 -o deps/parse_trans/ebin deps/parse_trans/src/*.erl 11 | @rm -Rf deps/sheriff/ebin 12 | @mkdir deps/sheriff/ebin 13 | @erlc -W0 -pa deps/parse_trans/ebin -o deps/sheriff/ebin deps/sheriff/src/*.erl 14 | 15 | # Test cases 16 | 17 | run_bridge_fair: 18 | @scripts/edbc_erlc "examples/bridge/fair/src/*.erl" examples/bridge/fair/ebin 19 | @scripts/edbc_erl examples/bridge/fair/ebin "bridge_test:test()" 20 | 21 | run_bridge_unfair: 22 | @scripts/edbc_erlc "examples/bridge/unfair/src/*.erl" examples/bridge/unfair/ebin 23 | @scripts/edbc_erl examples/bridge/unfair/ebin "bridge_test:test()" 24 | 25 | load_ej1: 26 | @scripts/edbc_erlc examples/other/src/ej1.erl examples/other/ebin 27 | @scripts/edbc_erl examples/other/ebin 28 | 29 | load_ej1_noedbc: 30 | @scripts/edbc_erlcp examples/other/src/ej1.erl examples/other/ebin 31 | @scripts/edbc_erl examples/other/ebin 32 | 33 | doc_ej1: 34 | @scripts/edbc_edoc examples/other/src/ej1.erl examples/other/docs 35 | 36 | load_merge: 37 | @scripts/edbc_erlc examples/other/src/merge.erl examples/other/ebin 38 | @scripts/edbc_erl examples/other/ebin 39 | 40 | run_library: 41 | @scripts/edbc_erlc "examples/other/src/library*.erl" examples/other/ebin 42 | @scripts/edbc_erl examples/other/ebin "library_test:test1()" 43 | 44 | run_rw_unfair4writers: 45 | @scripts/edbc_erlc "examples/readers_writers/unfair4writers/src/*.erl" examples/readers_writers/unfair4writers/ebin 46 | @scripts/edbc_erl examples/readers_writers/unfair4writers/ebin "readers_writers_test:test()" 47 | 48 | run_rw_unfair4readers: 49 | @scripts/edbc_erlc "examples/readers_writers/unfair4readers/src/*.erl" examples/readers_writers/unfair4readers/ebin 50 | @scripts/edbc_erl examples/readers_writers/unfair4readers/ebin "readers_writers_test:test()" 51 | 52 | run_rw_fair: 53 | @scripts/edbc_erlc "examples/readers_writers/fair/src/*.erl" examples/readers_writers/fair/ebin 54 | @scripts/edbc_erl examples/readers_writers/fair/ebin "readers_writers_test:test()" 55 | 56 | test_semaphore: 57 | @scripts/edbc_erlc "examples/semaphore/no_queues/src/*.erl" examples/semaphore/no_queues/ebin 58 | @scripts/edbc_erl examples/semaphore/no_queues/ebin "semaphore_tests:test()" 59 | 60 | test_sel_recv: 61 | @scripts/edbc_erlc "examples/sel_recv/gen_server/src/*.erl" examples/sel_recv/gen_server/ebin 62 | @erl -pa examples/sel_recv/gen_server/ebin -eval "sel_recv_test:test()" -eval -s erlang halt 63 | 64 | test_sel_recv_q: 65 | @scripts/edbc_erlc "examples/sel_recv/gen_server_qcpre/src/*.erl" examples/sel_recv/gen_server_qcpre/ebin 66 | @erl -pa "examples/sel_recv/gen_server_qcpre/ebin" "ebin" "deps/sheriff/ebin" "deps/parse_trans/ebin" -eval "sel_recv_test:test()" -s erlang halt 67 | 68 | load_ej_paper: 69 | @scripts/edbc_erlc examples/other/src/ej_paper.erl examples/other/ebin 70 | @scripts/edbc_erl examples/other/ebin 71 | 72 | doc_ej_paper: 73 | @scripts/edbc_edoc examples/other/src/ej_paper.erl examples/other/docs 74 | 75 | load_ej_temp: 76 | @scripts/edbc_erlc examples/other/src/ej_temp.erl examples/other/ebin 77 | @scripts/edbc_erl examples/other/ebin 78 | 79 | # Test cases (Queued versions) 80 | 81 | run_rw_fair_q: 82 | @scripts/edbc_erlc "examples/readers_writers/fair_queues/src/*.erl" examples/readers_writers/fair_queues/ebin 83 | @scripts/edbc_erl examples/readers_writers/fair_queues/ebin "readers_writers_test:test()" 84 | 85 | run_rw_unfair4writers_q: 86 | @scripts/edbc_erlc "examples/readers_writers/unfair4writers_queues/src/*.erl" examples/readers_writers/unfair4writers_queues/ebin 87 | @scripts/edbc_erl examples/readers_writers/unfair4writers_queues/ebin "readers_writers_test:test()" 88 | 89 | run_rw_unfair4readers_q: 90 | @scripts/edbc_erlc "examples/readers_writers/unfair4readers_queues/src/*.erl" examples/readers_writers/unfair4readers_queues/ebin 91 | @scripts/edbc_erl examples/readers_writers/unfair4readers_queues/ebin "readers_writers_test:test()" 92 | 93 | test_semaphore_q: 94 | @scripts/edbc_erlc "examples/semaphore/queues/src/*.erl" examples/semaphore/queues/ebin 95 | @scripts/edbc_erl examples/semaphore/queues/ebin "semaphore_tests:test()" 96 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Erlang Design By Contract 2 | -------------------------------------------------------------------------------- /deps/README.md: -------------------------------------------------------------------------------- 1 | # Dependencies 2 | 3 | https://github.com/extend/sheriff 4 | 5 | https://github.com/uwiger/parse_trans -------------------------------------------------------------------------------- /deps/parse_trans/include/codegen.hrl: -------------------------------------------------------------------------------- 1 | %%% The contents of this file are subject to the Erlang Public License, 2 | %%% Version 1.1, (the "License"); you may not use this file except in 3 | %%% compliance with the License. You may obtain a copy of the License at 4 | %%% http://www.erlang.org/EPLICENSE 5 | %% 6 | %% Software distributed under the License is distributed on an "AS IS" 7 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 8 | %% the License for the specific language governing rights and limitations 9 | %% under the License. 10 | %% 11 | %% The Original Code is parse_trans-2.0. 12 | %% 13 | %% Copyright (c) 2014 Ericsson AB 14 | %% 15 | %% Contributor(s): ______________________________________. 16 | 17 | %%------------------------------------------------------------------- 18 | %% File : codegen.hrl 19 | %% @author : Ulf Wiger 20 | %% @end 21 | %% Description : 22 | %% 23 | %% Created : 25 Feb 2010 by Ulf Wiger 24 | %%------------------------------------------------------------------- 25 | -compile({parse_transform, parse_trans_codegen}). 26 | -------------------------------------------------------------------------------- /deps/parse_trans/src/parse_trans_codegen.erl: -------------------------------------------------------------------------------- 1 | %% -*- erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %% -------------------------------------------------- 3 | %% This file is provided to you under the Apache License, 4 | %% Version 2.0 (the "License"); you may not use this file 5 | %% except in compliance with the License. You may obtain 6 | %% a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, 11 | %% software distributed under the License is distributed on an 12 | %% "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 13 | %% KIND, either express or implied. See the License for the 14 | %% specific language governing permissions and limitations 15 | %% under the License. 16 | %% -------------------------------------------------- 17 | %% File : parse_trans_codegen.erl 18 | %% @author : Ulf Wiger 19 | %% @end 20 | %%------------------------------------------------------------------- 21 | 22 | %% @doc Parse transform for code generation pseduo functions 23 | %% 24 | %%

...

25 | %% 26 | %% @end 27 | 28 | -module(parse_trans_codegen). 29 | 30 | -export([parse_transform/2]). 31 | -export([format_error/1]). 32 | 33 | %% @spec (Forms, Options) -> NewForms 34 | %% 35 | %% @doc 36 | %% Searches for calls to pseudo functions in the module `codegen', 37 | %% and converts the corresponding erlang code to a data structure 38 | %% representing the abstract form of that code. 39 | %% 40 | %% The purpose of these functions is to let the programmer write 41 | %% the actual code that is to be generated, rather than manually 42 | %% writing abstract forms, which is more error prone and cannot be 43 | %% checked by the compiler until the generated module is compiled. 44 | %% 45 | %% Supported functions: 46 | %% 47 | %%

gen_function/2

48 | %% 49 | %% Usage: `codegen:gen_function(Name, Fun)' 50 | %% 51 | %% Substitutes the abstract code for a function with name `Name' 52 | %% and the same behaviour as `Fun'. 53 | %% 54 | %% `Fun' can either be a anonymous `fun', which is then converted to 55 | %% a named function, or it can be an `implicit fun', e.g. 56 | %% `fun is_member/2'. In the latter case, the referenced function is fetched 57 | %% and converted to an abstract form representation. It is also renamed 58 | %% so that the generated function has the name `Name'. 59 | %%

60 | %% Another alternative is to wrap a fun inside a list comprehension, e.g. 61 | %% 

 62 | %% f(Name, L) ->
 63 | %%     codegen:gen_function(
 64 | %%         Name,
 65 | %%         [ fun({'$var',X}) ->
 66 | %%              {'$var', Y}
 67 | %%           end || {X, Y} <- L ]).
 68 | %%
69 | %%

70 | %% Calling the above with `f(foo, [{1,a},{2,b},{3,c}])' will result in 71 | %% generated code corresponding to: 72 | %% 

 73 | %% foo(1) -> a;
 74 | %% foo(2) -> b;
 75 | %% foo(3) -> c.
 76 | %%
77 | %% 78 | %%

gen_functions/1

79 | %% 80 | %% Takes a list of `{Name, Fun}' tuples and produces a list of abstract 81 | %% data objects, just as if one had written 82 | %% `[codegen:gen_function(N1,F1),codegen:gen_function(N2,F2),...]'. 83 | %% 84 | %%

exprs/1

85 | %% 86 | %% Usage: `codegen:exprs(Fun)' 87 | %% 88 | %% `Fun' is either an anonymous function, or an implicit fun with only one 89 | %% function clause. This "function" takes the body of the fun and produces 90 | %% a data type representing the abstract form of the list of expressions in 91 | %% the body. The arguments of the function clause are ignored, but can be 92 | %% used to ensure that all necessary variables are known to the compiler. 93 | %% 94 | %%

gen_module/3

95 | %% 96 | %% Generates abstract forms for a complete module definition. 97 | %% 98 | %% Usage: `codegen:gen_module(ModuleName, Exports, Functions)' 99 | %% 100 | %% `ModuleName' is either an atom or a {'$var', V} reference. 101 | %% 102 | %% `Exports' is a list of `{Function, Arity}' tuples. 103 | %% 104 | %% `Functions' is a list of `{Name, Fun}' tuples analogous to that for 105 | %% `gen_functions/1'. 106 | %% 107 | %%

Variable substitution

108 | %% 109 | %% It is possible to do some limited expansion (importing a value 110 | %% bound at compile-time), using the construct {'$var', V}, where 111 | %% `V' is a bound variable in the scope of the call to `gen_function/2'. 112 | %% 113 | %% Example: 114 | %% 
115 | %% gen(Name, X) ->
116 | %%    codegen:gen_function(Name, fun(L) -> lists:member({'$var',X}, L) end).
117 | %%
118 | %% 119 | %% After transformation, calling `gen(contains_17, 17)' will yield the 120 | %% abstract form corresponding to: 121 | %% 
122 | %% contains_17(L) ->
123 | %%    lists:member(17, L).
124 | %%
125 | %% 126 | %%

Form substitution

127 | %% 128 | %% It is possible to inject abstract forms, using the construct 129 | %% {'$form', F}, where `F' is bound to a parsed form in 130 | %% the scope of the call to `gen_function/2'. 131 | %% 132 | %% Example: 133 | %% 
134 | %% gen(Name, F) ->
135 | %%    codegen:gen_function(Name, fun(X) -> X =:= {'$form',F} end).
136 | %%
137 | %% 138 | %% After transformation, calling `gen(is_foo, {atom,0,foo})' will yield the 139 | %% abstract form corresponding to: 140 | %% 
141 | %% is_foo(X) ->
142 | %%    X =:= foo.
143 | %%
144 | %% @end 145 | %% 146 | parse_transform(Forms, Options) -> 147 | Context = parse_trans:initial_context(Forms, Options), 148 | {NewForms, _} = 149 | parse_trans:do_depth_first( 150 | fun xform_fun/4, _Acc = Forms, Forms, Context), 151 | parse_trans:return(parse_trans:revert(NewForms), Context). 152 | 153 | xform_fun(application, Form, _Ctxt, Acc) -> 154 | MFA = erl_syntax_lib:analyze_application(Form), 155 | L = erl_syntax:get_pos(Form), 156 | case MFA of 157 | {codegen, {gen_module, 3}} -> 158 | [NameF, ExportsF, FunsF] = 159 | erl_syntax:application_arguments(Form), 160 | NewForms = gen_module(NameF, ExportsF, FunsF, L, Acc), 161 | {NewForms, Acc}; 162 | {codegen, {gen_function, 2}} -> 163 | [NameF, FunF] = 164 | erl_syntax:application_arguments(Form), 165 | NewForm = gen_function(NameF, FunF, L, L, Acc), 166 | {NewForm, Acc}; 167 | {codegen, {gen_function, 3}} -> 168 | [NameF, FunF, LineF] = 169 | erl_syntax:application_arguments(Form), 170 | NewForm = gen_function( 171 | NameF, FunF, L, erl_syntax:integer_value(LineF), Acc), 172 | {NewForm, Acc}; 173 | {codegen, {gen_function_alt, 3}} -> 174 | [NameF, FunF, AltF] = 175 | erl_syntax:application_arguments(Form), 176 | NewForm = gen_function_alt(NameF, FunF, AltF, L, L, Acc), 177 | {NewForm, Acc}; 178 | {codegen, {gen_functions, 1}} -> 179 | [List] = erl_syntax:application_arguments(Form), 180 | Elems = erl_syntax:list_elements(List), 181 | NewForms = lists:map( 182 | fun(E) -> 183 | [NameF, FunF] = erl_syntax:tuple_elements(E), 184 | gen_function(NameF, FunF, L, L, Acc) 185 | end, Elems), 186 | {erl_syntax:list(NewForms), Acc}; 187 | {codegen, {exprs, 1}} -> 188 | [FunF] = erl_syntax:application_arguments(Form), 189 | [Clause] = erl_syntax:fun_expr_clauses(FunF), 190 | [{clause,_,_,_,Body}] = parse_trans:revert([Clause]), 191 | NewForm = substitute(erl_parse:abstract(Body)), 192 | {NewForm, Acc}; 193 | _ -> 194 | {Form, Acc} 195 | end; 196 | xform_fun(_, Form, _Ctxt, Acc) -> 197 | {Form, Acc}. 198 | 199 | gen_module(NameF, ExportsF, FunsF, L, Acc) -> 200 | case erl_syntax:type(FunsF) of 201 | list -> 202 | try gen_module_(NameF, ExportsF, FunsF, L, Acc) 203 | catch 204 | error:E -> 205 | ErrStr = parse_trans:format_exception(error, E), 206 | {error, {L, ?MODULE, ErrStr}} 207 | end; 208 | _ -> 209 | ErrStr = parse_trans:format_exception( 210 | error, "Argument must be a list"), 211 | {error, {L, ?MODULE, ErrStr}} 212 | end. 213 | 214 | gen_module_(NameF, ExportsF, FunsF, L0, Acc) -> 215 | P = erl_syntax:get_pos(NameF), 216 | ModF = case parse_trans:revert_form(NameF) of 217 | {atom,_,_} = Am -> Am; 218 | {tuple,_,[{atom,_,'$var'}, 219 | {var,_,V}]} -> 220 | {var,P,V} 221 | end, 222 | cons( 223 | {cons,P, 224 | {tuple,P, 225 | [{atom,P,attribute}, 226 | {integer,P,1}, 227 | {atom,P,module}, 228 | ModF]}, 229 | substitute( 230 | abstract( 231 | [{attribute,P,export, 232 | lists:map( 233 | fun(TupleF) -> 234 | [F,A] = erl_syntax:tuple_elements(TupleF), 235 | {erl_syntax:atom_value(F), erl_syntax:integer_value(A)} 236 | end, erl_syntax:list_elements(ExportsF))}]))}, 237 | lists:map( 238 | fun(FTupleF) -> 239 | Pos = erl_syntax:get_pos(FTupleF), 240 | [FName, FFunF] = erl_syntax:tuple_elements(FTupleF), 241 | gen_function(FName, FFunF, L0, Pos, Acc) 242 | end, erl_syntax:list_elements(FunsF))). 243 | 244 | cons({cons,L,H,T}, L2) -> 245 | {cons,L,H,cons(T, L2)}; 246 | cons({nil,L}, [H|T]) -> 247 | Pos = erl_syntax:get_pos(H), 248 | {cons,L,H,cons({nil,Pos}, T)}; 249 | cons({nil,L}, []) -> 250 | {nil,L}. 251 | 252 | 253 | 254 | gen_function(NameF, FunF, L0, L, Acc) -> 255 | try gen_function_(NameF, FunF, [], L, Acc) 256 | catch 257 | error:E -> 258 | ErrStr = parse_trans:format_exception(error, E), 259 | {error, {L0, ?MODULE, ErrStr}} 260 | end. 261 | 262 | gen_function_alt(NameF, FunF, AltF, L0, L, Acc) -> 263 | try gen_function_(NameF, FunF, AltF, L, Acc) 264 | catch 265 | error:E -> 266 | ErrStr = parse_trans:format_exception(error, E), 267 | {error, {L0, ?MODULE, ErrStr}} 268 | end. 269 | 270 | gen_function_(NameF, FunF, AltF, L, Acc) -> 271 | case erl_syntax:type(FunF) of 272 | T when T==implicit_fun; T==fun_expr -> 273 | {Arity, Clauses} = gen_function_clauses(T, NameF, FunF, L, Acc), 274 | {tuple, 1, [{atom, 1, function}, 275 | {integer, 1, L}, 276 | NameF, 277 | {integer, 1, Arity}, 278 | substitute(abstract(Clauses))]}; 279 | list_comp -> 280 | %% Extract the fun from the LC 281 | [Template] = parse_trans:revert( 282 | [erl_syntax:list_comp_template(FunF)]), 283 | %% Process fun in the normal fashion (as above) 284 | {Arity, Clauses} = gen_function_clauses(erl_syntax:type(Template), 285 | NameF, Template, L, Acc), 286 | Body = erl_syntax:list_comp_body(FunF), 287 | %% Collect all variables from the LC generator(s) 288 | %% We want to produce an abstract representation of something like: 289 | %% {function,1,Name,Arity, 290 | %% lists:flatten( 291 | %% [(fun(V1,V2,...) -> 292 | %% ... 293 | %% end)(__V1,__V2,...) || {__V1,__V2,...} <- L])} 294 | %% where the __Vn vars are our renamed versions of the LC generator 295 | %% vars. This allows us to instantiate the clauses at run-time. 296 | Vars = lists:flatten( 297 | [sets:to_list(erl_syntax_lib:variables( 298 | erl_syntax:generator_pattern(G))) 299 | || G <- Body]), 300 | Vars1 = [list_to_atom("__" ++ atom_to_list(V)) || V <- Vars], 301 | VarMap = lists:zip(Vars, Vars1), 302 | Body1 = 303 | [erl_syntax:generator( 304 | rename_vars(VarMap, gen_pattern(G)), 305 | gen_body(G)) || G <- Body], 306 | [RevLC] = parse_trans:revert( 307 | [erl_syntax:list_comp( 308 | {call, 1, 309 | {'fun',1, 310 | {clauses, 311 | [{clause,1,[{var,1,V} || V <- Vars],[], 312 | [substitute( 313 | abstract(Clauses))] 314 | }]} 315 | }, [{var,1,V} || V <- Vars1]}, Body1)]), 316 | AltC = case AltF of 317 | [] -> {nil,1}; 318 | _ -> 319 | {Arity, AltC1} = gen_function_clauses( 320 | erl_syntax:type(AltF), 321 | NameF, AltF, L, Acc), 322 | substitute(abstract(AltC1)) 323 | end, 324 | {tuple,1,[{atom,1,function}, 325 | {integer, 1, L}, 326 | NameF, 327 | {integer, 1, Arity}, 328 | {call, 1, {remote, 1, {atom, 1, lists}, 329 | {atom,1,flatten}}, 330 | [{op, 1, '++', RevLC, AltC}]}]} 331 | end. 332 | 333 | gen_pattern(G) -> 334 | erl_syntax:generator_pattern(G). 335 | 336 | gen_body(G) -> 337 | erl_syntax:generator_body(G). 338 | 339 | rename_vars(Vars, Tree) -> 340 | erl_syntax_lib:map( 341 | fun(T) -> 342 | case erl_syntax:type(T) of 343 | variable -> 344 | V = erl_syntax:variable_name(T), 345 | {_,V1} = lists:keyfind(V,1,Vars), 346 | erl_syntax:variable(V1); 347 | _ -> 348 | T 349 | end 350 | end, Tree). 351 | 352 | gen_function_clauses(implicit_fun, _NameF, FunF, _L, Acc) -> 353 | AQ = erl_syntax:implicit_fun_name(FunF), 354 | Name = erl_syntax:atom_value(erl_syntax:arity_qualifier_body(AQ)), 355 | Arity = erl_syntax:integer_value( 356 | erl_syntax:arity_qualifier_argument(AQ)), 357 | NewForm = find_function(Name, Arity, Acc), 358 | ClauseForms = erl_syntax:function_clauses(NewForm), 359 | {Arity, ClauseForms}; 360 | gen_function_clauses(fun_expr, _NameF, FunF, _L, _Acc) -> 361 | ClauseForms = erl_syntax:fun_expr_clauses(FunF), 362 | Arity = get_arity(ClauseForms), 363 | {Arity, ClauseForms}. 364 | 365 | find_function(Name, Arity, Forms) -> 366 | [Form] = [F || {function,_,N,A,_} = F <- Forms, 367 | N == Name, 368 | A == Arity], 369 | Form. 370 | 371 | abstract(ClauseForms) -> 372 | erl_parse:abstract(parse_trans:revert(ClauseForms)). 373 | 374 | substitute({tuple,L0, 375 | [{atom,_,tuple}, 376 | {integer,_,L}, 377 | {cons,_, 378 | {tuple,_,[{atom,_,atom},{integer,_,_},{atom,_,'$var'}]}, 379 | {cons,_, 380 | {tuple,_,[{atom,_,var},{integer,_,_},{atom,_,V}]}, 381 | {nil,_}}}]}) -> 382 | {call, L0, {remote,L0,{atom,L0,erl_parse}, 383 | {atom,L0,abstract}}, 384 | [{var, L0, V}, {integer, L0, L}]}; 385 | substitute({tuple,L0, 386 | [{atom,_,tuple}, 387 | {integer,_,_}, 388 | {cons,_, 389 | {tuple,_,[{atom,_,atom},{integer,_,_},{atom,_,'$form'}]}, 390 | {cons,_, 391 | {tuple,_,[{atom,_,var},{integer,_,_},{atom,_,F}]}, 392 | {nil,_}}}]}) -> 393 | {var, L0, F}; 394 | substitute([]) -> 395 | []; 396 | substitute([H|T]) -> 397 | [substitute(H) | substitute(T)]; 398 | substitute(T) when is_tuple(T) -> 399 | list_to_tuple(substitute(tuple_to_list(T))); 400 | substitute(X) -> 401 | X. 402 | 403 | get_arity(Clauses) -> 404 | Ays = [length(erl_syntax:clause_patterns(C)) || C <- Clauses], 405 | case lists:usort(Ays) of 406 | [Ay] -> 407 | Ay; 408 | Other -> 409 | erlang:error(ambiguous, Other) 410 | end. 411 | 412 | 413 | format_error(E) -> 414 | case io_lib:deep_char_list(E) of 415 | true -> 416 | E; 417 | _ -> 418 | io_lib:write(E) 419 | end. 420 | -------------------------------------------------------------------------------- /deps/parse_trans/src/parse_trans_mod.erl: -------------------------------------------------------------------------------- 1 | %%============================================================================ 2 | %% Copyright 2014 Ulf Wiger 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %%============================================================================ 16 | %% 17 | %% Based on meck_mod.erl from http://github.com/eproxus/meck.git 18 | %% Original author: Adam Lindberg 19 | %% 20 | -module(parse_trans_mod). 21 | %% Interface exports 22 | -export([transform_module/3]). 23 | 24 | -export([abstract_code/1]). 25 | -export([beam_file/1]). 26 | -export([compile_and_load_forms/1]). 27 | -export([compile_and_load_forms/2]). 28 | -export([compile_options/1]). 29 | -export([rename_module/2]). 30 | 31 | %% Types 32 | -type erlang_form() :: term(). 33 | -type compile_options() :: [term()]. 34 | 35 | %%============================================================================ 36 | %% Interface exports 37 | %%============================================================================ 38 | 39 | transform_module(Mod, PT, Options) -> 40 | File = beam_file(Mod), 41 | Forms = abstract_code(File), 42 | Context = parse_trans:initial_context(Forms, Options), 43 | PTMods = if is_atom(PT) -> [PT]; 44 | is_function(PT, 2) -> [PT]; 45 | is_list(PT) -> PT 46 | end, 47 | Transformed = lists:foldl(fun(PTx, Fs) when is_function(PTx, 2) -> 48 | PTx(Fs, Options); 49 | (PTMod, Fs) -> 50 | PTMod:parse_transform(Fs, Options) 51 | end, Forms, PTMods), 52 | parse_trans:optionally_pretty_print(Transformed, Options, Context), 53 | compile_and_load_forms(Transformed, get_compile_options(Options)). 54 | 55 | 56 | -spec abstract_code(binary()) -> erlang_form(). 57 | abstract_code(BeamFile) -> 58 | case beam_lib:chunks(BeamFile, [abstract_code]) of 59 | {ok, {_, [{abstract_code, {raw_abstract_v1, Forms}}]}} -> 60 | Forms; 61 | {ok, {_, [{abstract_code, no_abstract_code}]}} -> 62 | erlang:error(no_abstract_code) 63 | end. 64 | 65 | -spec beam_file(module()) -> binary(). 66 | beam_file(Module) -> 67 | % code:which/1 cannot be used for cover_compiled modules 68 | case code:get_object_code(Module) of 69 | {_, Binary, _Filename} -> Binary; 70 | error -> throw({object_code_not_found, Module}) 71 | end. 72 | 73 | -spec compile_and_load_forms(erlang_form()) -> ok. 74 | compile_and_load_forms(AbsCode) -> compile_and_load_forms(AbsCode, []). 75 | 76 | -spec compile_and_load_forms(erlang_form(), compile_options()) -> ok. 77 | compile_and_load_forms(AbsCode, Opts) -> 78 | case compile:forms(AbsCode, Opts) of 79 | {ok, ModName, Binary} -> 80 | load_binary(ModName, Binary, Opts); 81 | {ok, ModName, Binary, _Warnings} -> 82 | load_binary(ModName, Binary, Opts) 83 | end. 84 | 85 | -spec compile_options(binary() | module()) -> compile_options(). 86 | compile_options(BeamFile) when is_binary(BeamFile) -> 87 | case beam_lib:chunks(BeamFile, [compile_info]) of 88 | {ok, {_, [{compile_info, Info}]}} -> 89 | proplists:get_value(options, Info); 90 | _ -> 91 | [] 92 | end; 93 | compile_options(Module) -> 94 | proplists:get_value(options, Module:module_info(compile)). 95 | 96 | -spec rename_module(erlang_form(), module()) -> erlang_form(). 97 | rename_module([{attribute, Line, module, _OldName}|T], NewName) -> 98 | [{attribute, Line, module, NewName}|T]; 99 | rename_module([H|T], NewName) -> 100 | [H|rename_module(T, NewName)]. 101 | 102 | %%============================================================================== 103 | %% Internal functions 104 | %%============================================================================== 105 | 106 | load_binary(Name, Binary, Opts) -> 107 | code:purge(Name), 108 | File = beam_filename(Name, Opts), 109 | case code:load_binary(Name, File, Binary) of 110 | {module, Name} -> ok; 111 | {error, Reason} -> exit({error_loading_module, Name, Reason}) 112 | end. 113 | 114 | get_compile_options(Options) -> 115 | case lists:keyfind(compile_options, 1, Options) of 116 | {_, COpts} -> 117 | COpts; 118 | false -> 119 | [] 120 | end. 121 | 122 | beam_filename(Mod, Opts) -> 123 | case lists:keyfind(outdir, 1, Opts) of 124 | {_, D} -> 125 | filename:join(D, atom_to_list(Mod) ++ code:objfile_extension()); 126 | false -> 127 | "" 128 | end. 129 | -------------------------------------------------------------------------------- /deps/parse_trans/src/parse_trans_pp.erl: -------------------------------------------------------------------------------- 1 | %% -*- erlang-indent-level: 4;indent-tabs-mode: nil -*- 2 | %% -------------------------------------------------- 3 | %% This file is provided to you under the Apache License, 4 | %% Version 2.0 (the "License"); you may not use this file 5 | %% except in compliance with the License. You may obtain 6 | %% a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, 11 | %% software distributed under the License is distributed on an 12 | %% "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 13 | %% KIND, either express or implied. See the License for the 14 | %% specific language governing permissions and limitations 15 | %% under the License. 16 | %% -------------------------------------------------- 17 | %% File : parse_trans_pp.erl 18 | %% @author : Ulf Wiger 19 | %% @end 20 | %% Description : 21 | %% 22 | %% Created : 3 Aug 2010 by Ulf Wiger 23 | %% -------------------------------------------------- 24 | 25 | %% @doc Generic parse transform library for Erlang. 26 | %% 27 | %% This module contains some useful utility functions for inspecting 28 | %% the results of parse transforms or code generation. 29 | %% The function `main/1' is called from escript, and can be used to 30 | %% pretty-print debug info in a .beam file from a Linux shell. 31 | %% 32 | %% Using e.g. the following bash alias: 33 | %% 
 34 | %% alias pp='escript $PARSE_TRANS_ROOT/ebin/parse_trans_pp.beam'
 35 | %%%
36 | %% a file could be pretty-printed using the following command: 37 | %% 38 | %% `$ pp ex_codegen.beam | less' 39 | %% @end 40 | 41 | -module(parse_trans_pp). 42 | 43 | -export([ 44 | pp_src/2, 45 | pp_beam/1, pp_beam/2 46 | ]). 47 | 48 | -export([main/1]). 49 | 50 | 51 | -spec main([string()]) -> any(). 52 | main([F]) -> 53 | pp_beam(F). 54 | 55 | 56 | %% @spec (Forms, Out::filename()) -> ok 57 | %% 58 | %% @doc Pretty-prints the erlang source code corresponding to Forms into Out 59 | %% 60 | -spec pp_src(parse_trans:forms(), file:filename()) -> 61 | ok. 62 | pp_src(Forms0, F) -> 63 | Forms = epp:restore_typed_record_fields(revert(Forms0)), 64 | Str = [io_lib:fwrite("~s~n", 65 | [lists:flatten([erl_pp:form(Fm) || 66 | Fm <- Forms])])], 67 | file:write_file(F, list_to_binary(Str)). 68 | 69 | %% @spec (Beam::filename()) -> string() | {error, Reason} 70 | %% 71 | %% @doc 72 | %% Reads debug_info from the beam file Beam and returns a string containing 73 | %% the pretty-printed corresponding erlang source code. 74 | %% @end 75 | -spec pp_beam(file:filename()) -> ok | {error, any()}. 76 | pp_beam(Beam) -> 77 | case pp_beam_to_str(Beam) of 78 | {ok, Str} -> 79 | io:put_chars(Str); 80 | Other -> 81 | Other 82 | end. 83 | 84 | %% @spec (Beam::filename(), Out::filename()) -> ok | {error, Reason} 85 | %% 86 | %% @doc 87 | %% Reads debug_info from the beam file Beam and pretty-prints it as 88 | %% Erlang source code, storing it in the file Out. 89 | %% @end 90 | %% 91 | -spec pp_beam(file:filename(), file:filename()) -> ok | {error,any()}. 92 | pp_beam(F, Out) -> 93 | case pp_beam_to_str(F) of 94 | {ok, Str} -> 95 | file:write_file(Out, list_to_binary(Str)); 96 | Other -> 97 | Other 98 | end. 99 | 100 | pp_beam_to_str(F) -> 101 | case beam_lib:chunks(F, [abstract_code]) of 102 | {ok, {_, [{abstract_code,{_,AC0}}]}} -> 103 | AC = epp:restore_typed_record_fields(AC0), 104 | {ok, lists:flatten( 105 | %% io_lib:fwrite("~s~n", [erl_prettypr:format( 106 | %% erl_syntax:form_list(AC))]) 107 | io_lib:fwrite("~s~n", [lists:flatten( 108 | [erl_pp:form(Form) || 109 | Form <- AC])]) 110 | )}; 111 | Other -> 112 | {error, Other} 113 | end. 114 | 115 | -spec revert(parse_trans:forms()) -> 116 | parse_trans:forms(). 117 | revert(Tree) -> 118 | [erl_syntax:revert(T) || T <- lists:flatten(Tree)]. 119 | -------------------------------------------------------------------------------- /deps/sheriff/src/sheriff.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2012, Loïc Hoguin 2 | %% 3 | %% Based on the awesome original work and research 4 | %% by William Dang and Hamza Mahmood. 5 | %% 6 | %% Copyright (c) 2011, William Dang , 7 | %% Hamza Mahmood 8 | %% 9 | %% Permission to use, copy, modify, and/or distribute this software for any 10 | %% purpose with or without fee is hereby granted, provided that the above 11 | %% copyright notice and this permission notice appear in all copies. 12 | %% 13 | %% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 14 | %% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 15 | %% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 16 | %% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 17 | %% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 18 | %% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 19 | %% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 20 | 21 | -module(sheriff). 22 | -compile({parse_transform, parse_trans_codegen}). 23 | 24 | -export([check/2, parse_transform/2, build_type/3]). 25 | 26 | %% @doc Return whether a value matches an Erlang type. 27 | %% 28 | %% This function takes two arguments: the value, and the type it will 29 | %% be matched against. Currently the type must be given either as 30 | %% an atom Type (for a local type of arity 0) or as a {Module, Type} 31 | %% tuple (for an external type of arity 0). Built-in types or types 32 | %% of other arities aren't supported as an argument at this point. 33 | %% To work around this limitation you need to define your own base 34 | %% type that will be a super-type of other built-in or user types. 35 | %% 36 | %% This function is actually a placeholder and will never be called, 37 | %% as Sheriff will replace all the sheriff:check/2 calls by a call 38 | %% to the generated validation function for the given type. 39 | -spec check(any(), atom() | {atom(), atom()}) -> boolean(). 40 | check(<<"sheriff world">>, world) -> true; 41 | check(_, _) -> false. 42 | 43 | parse_transform(Forms, _Options) -> 44 | %% @todo We only need to go through the top-level stuff. 45 | {_, Types} = parse_trans:depth_first( 46 | fun retrieve_types/4, [], Forms, []), 47 | Module = parse_trans:get_module(Forms), 48 | Funcs = gen_check_funcs(Types, Module), 49 | Forms2 = insert_funcs(Forms, Funcs, Types), 50 | {Forms3, _} = parse_trans:depth_first( 51 | fun replace_calls/4, Module, Forms2, []), 52 | parse_trans:revert(Forms3). 53 | 54 | retrieve_types(attribute, Form, _, Acc) -> 55 | case erl_syntax_lib:analyze_attribute(Form) of 56 | {type, {type, Type}} -> 57 | {Form, [Type|Acc]}; 58 | _ -> 59 | {Form, Acc} 60 | end; 61 | retrieve_types(_, Form, _, Acc) -> 62 | {Form, Acc}. 63 | 64 | gen_check_funcs(Types, Module) -> 65 | gen_check_funcs(Types, Module, []). 66 | gen_check_funcs([], Module, Acc) -> 67 | Func = codegen:gen_function('sherif_$_type_$_generic_$', 68 | fun(Val, Type) when is_atom(Type) -> 69 | TypeFunc = list_to_atom("sheriff_$_type_$_" ++ atom_to_list(Type)), 70 | {'$var', Module}:TypeFunc(Val); 71 | (Val, Type) when is_list(Type) -> 72 | {ModulePart, TypePart} = try 73 | [ModulePart2, TypePart2] = string:tokens(Type, ":"), 74 | [TypePart3, ")"] = string:tokens(TypePart2, "("), 75 | {ModulePart2, TypePart3} 76 | catch error:{badmatch, _} -> 77 | error(badarg) 78 | end, 79 | ModuleAtom = list_to_atom(ModulePart), 80 | TypeAtom = list_to_atom(TypePart), 81 | 'sherif_$_type_$_generic_$'(Val, {ModuleAtom, TypeAtom}); 82 | (Val, {ModuleAtom, TypeAtom}) -> 83 | TypeFunc = list_to_atom("sheriff_$_type_$_" ++ atom_to_list(TypeAtom)), 84 | ModuleAtom:TypeFunc(Val) 85 | end), 86 | [Func | Acc]; 87 | gen_check_funcs([{{record, Name}, Tree, []}|Tail], Module, Acc) -> 88 | FuncName = record_to_func_name(Name), 89 | Value = {var, 0, 'Sheriff_check_value'}, 90 | [Exprs] = build_record_exprs(Tree, Module, Value), 91 | Func = codegen:gen_function(FuncName, fun(Sheriff_check_value) -> 92 | {'$form', Exprs} 93 | end), 94 | gen_check_funcs(Tail, Module, [Func|Acc]); 95 | %% Special cases for types aliasing any() or term() to avoid an 96 | %% unnecessary warning with the variable being unused. 97 | gen_check_funcs([{Name, {type, L, TypeName, []}, Args}|Tail], Module, Acc) 98 | when TypeName =:= any; TypeName =:= term -> 99 | FuncName = type_to_func_name(Name), 100 | FuncArity = 1 + length(Args), 101 | Value = {var, 0, '_Sheriff_check_value'}, 102 | Func = {function, 0, FuncName, FuncArity, [ 103 | {clause, 0, [Value|Args], [], [{atom, L, true}]} 104 | ]}, 105 | gen_check_funcs(Tail, Module, [Func|Acc]); 106 | gen_check_funcs([{Name, Tree, Args}|Tail], Module, Acc) -> 107 | FuncName = type_to_func_name(Name), 108 | FuncArity = 1 + length(Args), 109 | Value = {var, 0, 'Sheriff_check_value'}, 110 | Exprs = build_exprs([Tree], Module, Value), 111 | Func = {function, 0, FuncName, FuncArity, [ 112 | {clause, 0, [Value|Args], [], Exprs} 113 | ]}, 114 | gen_check_funcs(Tail, Module, [Func|Acc]). 115 | 116 | build_exprs(Types, Module, Value) -> 117 | build_exprs(Types, Module, Value, []). 118 | build_exprs([], _, _, Acc) -> 119 | lists:reverse(Acc); 120 | build_exprs([Type|Tail], Module, Value, Acc) -> 121 | Expr = build_type(Type, Module, Value), 122 | build_exprs(Tail, Module, Value, [Expr|Acc]). 123 | 124 | build_record_exprs(Fields, Module, Value) -> 125 | [build_intersection(build_record_fields(Fields, Module, Value, 2, []))]. 126 | 127 | build_record_fields([], _, _, _, Acc) -> 128 | lists:reverse(Acc); 129 | %% Ignore untyped record fields. 130 | build_record_fields([Field|Tail], Module, Value, Pos, Acc) 131 | when element(1, Field) =:= record_field -> 132 | build_record_fields(Tail, Module, Value, Pos + 1, Acc); 133 | build_record_fields([Field|Tail], Module, Value, Pos, Acc) -> 134 | Expr = build_record_field(Field, Module, Value, Pos), 135 | build_record_fields(Tail, Module, Value, Pos + 1, [Expr|Acc]). 136 | 137 | build_record_field({typed_record_field, _, Type}, Module, Value, Pos) -> 138 | [Elem] = codegen:exprs(fun() -> 139 | element({'$var', Pos}, {'$form', Value}) 140 | end), 141 | build_type(Type, Module, Elem). 142 | 143 | %% Extract type information from annotated types. 144 | build_type({ann_type, _, [{var, _, _}, Type]}, Module, Value) -> 145 | build_type(Type, Module, Value); 146 | build_type(Expr = {atom, _, _}, _, Value) -> 147 | build_identity(Expr, Value); 148 | build_type(Expr = {integer, _, _}, _, Value) -> 149 | build_identity(Expr, Value); 150 | build_type(Expr = {op, _, '-', {integer, _, _}}, _, Value) -> 151 | build_identity(Expr, Value); 152 | build_type({remote_type, _, [{atom, _, Module}, {atom, _, Type}, Args]}, 153 | _, Value) -> 154 | FuncName = type_to_func_name(Type), 155 | [Exprs] = codegen:exprs(fun() -> 156 | apply({'$var', Module}, {'$var', FuncName}, 157 | [{'$form', Value}] ++ {'$var', Args}) 158 | end), 159 | Exprs; 160 | build_type({type, L, any, []}, _, _) -> 161 | {atom, L, true}; 162 | build_type({type, L, arity, []}, Module, Value) -> 163 | build_type({type, L, range, [{integer, L, 0}, {integer, L, 255}]}, 164 | Module, Value); 165 | build_type({type, _, atom, []}, _, Value) -> 166 | [Exprs] = codegen:exprs(fun() -> 167 | is_atom({'$form', Value}) 168 | end), 169 | Exprs; 170 | build_type({type, L, binary, []}, Module, Value) -> 171 | build_type({type, L, binary, [{integer, L, 0}, {integer, L, 8}]}, 172 | Module, Value); 173 | %% This one is <<>> specifically. 174 | build_type({type, L, binary, [{integer, _, 0}, {integer, _, 0}]}, 175 | _, Value) -> 176 | build_identity({bin, L, []}, Value); 177 | build_type({type, _, binary, [{integer, _, Size}, {integer, _, 0}]}, 178 | _, Value) -> 179 | [Exprs] = codegen:exprs(fun() -> 180 | is_bitstring({'$form', Value}) andalso 181 | bit_size({'$form', Value}) =:= {'$var', Size} 182 | end), 183 | Exprs; 184 | build_type({type, _, binary, [{integer, _, MinSize}, {integer, _, Div}]}, 185 | _, Value) -> 186 | [Exprs] = codegen:exprs(fun() -> 187 | is_bitstring({'$form', Value}) andalso 188 | (bit_size({'$form', Value}) - {'$var', MinSize}) 189 | rem {'$var', Div} =:= 0 190 | end), 191 | Exprs; 192 | build_type({type, _, bitstring, []}, _, Value) -> 193 | [Exprs] = codegen:exprs(fun() -> 194 | is_bitstring({'$form', Value}) 195 | end), 196 | Exprs; 197 | build_type({type, _, boolean, []}, _, Value) -> 198 | [Exprs] = codegen:exprs(fun() -> 199 | is_boolean({'$form', Value}) 200 | end), 201 | Exprs; 202 | build_type({type, L, byte, []}, Module, Value) -> 203 | build_type({type, L, range, [{integer, L, 0}, {integer, L, 255}]}, 204 | Module, Value); 205 | build_type({type, L, char, []}, Module, Value) -> 206 | build_type({type, L, range, [{integer, L, 0}, {integer, L, 16#10ffff}]}, 207 | Module, Value); 208 | build_type({type, _, float, []}, _, Value) -> 209 | [Exprs] = codegen:exprs(fun() -> 210 | is_float({'$form', Value}) 211 | end), 212 | Exprs; 213 | %% We can only check the function arity when provided. 214 | build_type({type, _, 'fun', [{type, _, product, Product}, _]}, _, Value) -> 215 | Arity = length(Product), 216 | [Exprs] = codegen:exprs(fun() -> 217 | is_function({'$form', Value}, {'$var', Arity}) 218 | end), 219 | Exprs; 220 | build_type({type, _, 'fun', _}, _, Value) -> 221 | [Exprs] = codegen:exprs(fun() -> 222 | is_function({'$form', Value}) 223 | end), 224 | Exprs; 225 | build_type({type, _, integer, []}, _, Value) -> 226 | [Exprs] = codegen:exprs(fun() -> 227 | is_integer({'$form', Value}) 228 | end), 229 | Exprs; 230 | %% @todo {type, _, iolist, []} 231 | build_type({type, _, list, []}, _, Value) -> 232 | [Exprs] = codegen:exprs(fun() -> 233 | is_list({'$form', Value}) andalso 234 | ({'$form', Value} =:= [] orelse is_list(tl({'$form', Value}))) 235 | end), 236 | Exprs; 237 | build_type({type, L, list, Types}, Module, Value) -> 238 | LCValue = {var, L, 'L'}, 239 | InExprs = build_union(build_exprs(Types, Module, LCValue)), 240 | [Exprs] = codegen:exprs(fun() -> 241 | is_list({'$form', Value}) andalso 242 | ({'$form', Value} =:= [] orelse is_list(tl({'$form', Value}))) andalso 243 | true =/= lists:member(false, 244 | [{'$form', InExprs} || {'$form', LCValue} <- {'$form', Value}]) 245 | end), 246 | Exprs; 247 | build_type({type, _, maybe_improper_list, []}, _, Value) -> 248 | [Exprs] = codegen:exprs(fun() -> 249 | is_list({'$form', Value}) 250 | end), 251 | Exprs; 252 | %% @todo 253 | %build_type({type, L, maybe_improper_list, 254 | % [{integer, _, Type1}, {integer, _, Type2}]}, Module, Value) -> 255 | %% @todo Same as the two above with nonempty_maybe_improper_list. 256 | build_type({type, L, mfa, []}, Module, Value) -> 257 | build_tuple([{type, L, atom, []}, {type, L, atom, []}, 258 | {type, L, byte, []}], Module, Value); 259 | build_type({type, L, module, []}, Module, Value) -> 260 | build_type({type, L, atom, []}, Module, Value); 261 | build_type({type, _, neg_integer, []}, _, Value) -> 262 | [Exprs] = codegen:exprs(fun() -> 263 | is_integer({'$form', Value}) andalso {'$form', Value} < 0 264 | end), 265 | Exprs; 266 | build_type({type, _, nil, []}, _, Value) -> 267 | [Exprs] = codegen:exprs(fun() -> 268 | {'$form', Value} =:= [] 269 | end), 270 | Exprs; 271 | build_type({type, L, no_return, []}, Module, Value) -> 272 | build_type({type, L, none, []}, Module, Value); 273 | build_type({type, L, node, []}, Module, Value) -> 274 | build_type({type, L, atom, []}, Module, Value); 275 | build_type({type, _, nonempty_list, []}, _, Value) -> 276 | [Exprs] = codegen:exprs(fun() -> 277 | is_list({'$form', Value}) andalso 278 | {'$form', Value} =/= [] andalso 279 | is_list(tl({'$form', Value})) 280 | end), 281 | Exprs; 282 | build_type({type, L, nonempty_list, Types}, Module, Value) -> 283 | LCValue = {var, L, 'L'}, 284 | InExprs = build_union(build_exprs(Types, Module, LCValue)), 285 | [Exprs] = codegen:exprs(fun() -> 286 | is_list({'$form', Value}) andalso 287 | {'$form', Value} =/= [] andalso 288 | is_list(tl({'$form', Value})) andalso 289 | true =/= lists:member(false, 290 | [{'$form', InExprs} || {'$form', LCValue} <- {'$form', Value}]) 291 | end), 292 | Exprs; 293 | build_type({type, L, nonempty_string, []}, Module, Value) -> 294 | StrExpr = build_type({type, L, string, []}, Module, Value), 295 | [Exprs] = codegen:exprs(fun() -> 296 | {'$form', StrExpr} andalso {'$form', Value} =/= [] 297 | end), 298 | Exprs; 299 | build_type({type, _, non_neg_integer, []}, _, Value) -> 300 | [Exprs] = codegen:exprs(fun() -> 301 | is_integer({'$form', Value}) andalso 0 =< {'$form', Value} 302 | end), 303 | Exprs; 304 | build_type({type, L, none, []}, _, _) -> 305 | {atom, L, false}; 306 | build_type({type, _, number, []}, _, Value) -> 307 | [Exprs] = codegen:exprs(fun() -> 308 | is_integer({'$form', Value}) orelse is_float({'$form', Value}) 309 | end), 310 | Exprs; 311 | build_type({type, _, pid, []}, _, Value) -> 312 | [Exprs] = codegen:exprs(fun() -> 313 | is_pid({'$form', Value}) 314 | end), 315 | Exprs; 316 | build_type({type, _, port, []}, _, Value) -> 317 | [Exprs] = codegen:exprs(fun() -> 318 | is_port({'$form', Value}) 319 | end), 320 | Exprs; 321 | build_type({type, _, pos_integer, []}, _, Value) -> 322 | [Exprs] = codegen:exprs(fun() -> 323 | is_integer({'$form', Value}) andalso 0 < {'$form', Value} 324 | end), 325 | Exprs; 326 | build_type({type, _, range, [From, To]}, _, Value) -> 327 | [Exprs] = codegen:exprs(fun() -> 328 | {'$form', From} =< {'$form', Value} andalso 329 | {'$form', Value} =< {'$form', To} 330 | end), 331 | Exprs; 332 | build_type({type, _, record, [{atom, _, Record}]}, _, Value) -> 333 | FuncName = record_to_func_name(Record), 334 | [Exprs] = codegen:exprs(fun() -> 335 | is_record({'$form', Value}, {'$var', Record}) andalso 336 | {'$var', FuncName}({'$form', Value}) 337 | end), 338 | Exprs; 339 | build_type({type, _, reference, []}, _, Value) -> 340 | [Exprs] = codegen:exprs(fun() -> 341 | is_reference({'$form', Value}) 342 | end), 343 | Exprs; 344 | build_type({type, L, string, []}, Module, Value) -> 345 | build_type({type, L, list, [{type, L, char, []}]}, Module, Value); 346 | build_type({type, L, term, []}, Module, Value) -> 347 | build_type({type, L, any, []}, Module, Value); 348 | build_type({type, _, timeout, []}, _, Value) -> 349 | [Exprs] = codegen:exprs(fun() -> 350 | {'$form', Value} =:= infinity orelse 351 | is_integer({'$form', Value}) andalso 0 =< {'$form', Value} 352 | end), 353 | Exprs; 354 | build_type({type, _, tuple, any}, _, Value) -> 355 | [Exprs] = codegen:exprs(fun() -> 356 | is_tuple({'$form', Value}) 357 | end), 358 | Exprs; 359 | build_type({type, _, tuple, []}, _, Value) -> 360 | [Exprs] = codegen:exprs(fun() -> 361 | {'$form', Value} =:= {} 362 | end), 363 | Exprs; 364 | build_type({type, _, tuple, Types}, Module, Value) -> 365 | build_tuple(Types, Module, Value); 366 | build_type({type, _, union, Types}, Module, Value) -> 367 | build_union(build_exprs(Types, Module, Value)); 368 | build_type({type, _, Custom, Args}, Module, Value) -> 369 | FuncName = type_to_func_name(Custom), 370 | [Exprs] = codegen:exprs(fun() -> 371 | apply({'$var', Module}, {'$var', FuncName}, 372 | [{'$form', Value}] ++ {'$var', Args}) 373 | end), 374 | Exprs; 375 | build_type({var, L, '_'}, Module, Value) -> 376 | build_type({type, L, any, []}, Module, Value); 377 | %% For type parameters, we dynamically obtain the validation AST 378 | %% for the parameter, then eval it and return the result. 379 | build_type(Expr = {var, _, _}, Module, Value) -> 380 | [Exprs] = codegen:exprs(fun() -> 381 | %% Hide the variable Result in a fun to avoid conflicts 382 | %% when a type has more than one parameter. 383 | (fun() -> 384 | {value, Result, []} = erl_eval:exprs( 385 | [sheriff:build_type( 386 | {'$form', Expr}, 387 | {'$var', Module}, 388 | erl_parse:abstract({'$form', Value}))], 389 | []), 390 | Result 391 | end)() 392 | end), 393 | Exprs. 394 | 395 | build_identity(Expr, Value) -> 396 | [Exprs] = codegen:exprs(fun() -> 397 | {'$form', Expr} =:= {'$form', Value} 398 | end), 399 | Exprs. 400 | 401 | build_tuple(Types = [Type|Tail], Module, Value) -> 402 | Size = length(Types), 403 | First = build_tuple_element(Type, Module, Value, 1), 404 | Elems = build_tuple_elements(Tail, Module, Value, 2, First), 405 | [Exprs] = codegen:exprs(fun() -> 406 | is_tuple({'$form', Value}) andalso 407 | size({'$form', Value}) =:= {'$var', Size} andalso 408 | {'$form', Elems} 409 | end), 410 | Exprs. 411 | 412 | build_tuple_elements([], _, _, _, Expr) -> 413 | Expr; 414 | build_tuple_elements([Type|Tail], Module, Value, N, Expr2) -> 415 | Expr1 = build_tuple_element(Type, Module, Value, N), 416 | [Elems] = codegen:exprs(fun() -> 417 | {'$form', Expr1} andalso {'$form', Expr2} 418 | end), 419 | build_tuple_elements(Tail, Module, Value, N + 1, Elems). 420 | 421 | build_tuple_element(Type, Module, Value, N) -> 422 | [Elem] = codegen:exprs(fun() -> 423 | element({'$var', N}, {'$form', Value}) 424 | end), 425 | build_type(Type, Module, Elem). 426 | 427 | build_intersection([Expr|Tail]) -> 428 | build_intersection(Tail, Expr). 429 | build_intersection([], Expr) -> 430 | Expr; 431 | build_intersection([Expr1|Tail], Expr2) -> 432 | [Intersection] = codegen:exprs(fun() -> 433 | {'$form', Expr1} andalso {'$form', Expr2} 434 | end), 435 | build_intersection(Tail, Intersection). 436 | 437 | build_union([Expr|Tail]) -> 438 | build_union(Tail, Expr). 439 | build_union([], Expr) -> 440 | Expr; 441 | build_union([Expr1|Tail], Expr2) -> 442 | [Union] = codegen:exprs(fun() -> 443 | {'$form', Expr1} orelse {'$form', Expr2} 444 | end), 445 | build_union(Tail, Union). 446 | 447 | insert_funcs(Forms, Funcs, Types) -> 448 | Forms2 = parse_trans:do_insert_forms(below, Funcs, Forms, 449 | parse_trans:initial_context(Forms, [])), 450 | lists:foldl(fun({Type, _, Args}, FormsAcc) -> 451 | case Type of 452 | {record, _} -> 453 | FormsAcc; 454 | Type -> 455 | FuncName = type_to_func_name(Type), 456 | FuncArity = 1 + length(Args), 457 | parse_trans:export_function(FuncName, FuncArity, FormsAcc) 458 | end 459 | end, Forms2, Types). 460 | 461 | replace_calls(application, Form, _Ctx, ThisModule) -> 462 | case erl_syntax_lib:analyze_application(Form) of 463 | {sheriff, {check, 2}} -> 464 | Pos = erl_syntax:get_pos(Form), 465 | Args = erl_syntax:application_arguments(Form), 466 | Vars = [hd(Args)], 467 | [CheckVar, TypeVar] = parse_trans:revert(Args), 468 | Form2 = case TypeVar of 469 | {var, _, _} -> 470 | erl_syntax:application( 471 | erl_syntax:atom('sherif_$_type_$_generic_$'), 472 | Args); 473 | {string, _, String} -> 474 | {ok, Ts, _} = erl_scan:string( 475 | "-type sheriff_string_arg() :: " ++ String ++ "."), 476 | {ok, {attribute, _, type, {sheriff_string_arg, Type, []}}} 477 | = erl_parse:parse_form(Ts), 478 | build_type(Type, ThisModule, CheckVar); 479 | {tuple, _, [{atom, _, Module}, {atom, _, Type}]} -> 480 | FuncName = type_to_func_name(Type), 481 | erl_syntax:application(erl_syntax:atom(Module), 482 | erl_syntax:atom(FuncName), Vars); 483 | {atom, _, Type} -> 484 | FuncName = type_to_func_name(Type), 485 | erl_syntax:application(erl_syntax:atom(FuncName), Vars) 486 | end, 487 | Form3 = erl_syntax:set_pos(Form2, Pos), 488 | {Form3, ThisModule}; 489 | _ -> 490 | {Form, ThisModule} 491 | end; 492 | replace_calls(_, Form, _Ctx, ThisModule) -> 493 | {Form, ThisModule}. 494 | 495 | type_to_func_name(Type) when is_atom(Type) -> 496 | list_to_atom("sheriff_$_type_$_" ++ atom_to_list(Type)). 497 | 498 | record_to_func_name(Record) when is_atom(Record) -> 499 | list_to_atom("sheriff_$_record_$_" ++ atom_to_list(Record)). 500 | -------------------------------------------------------------------------------- /examples/bridge/_old_versions/fair/src/bridge.erl: -------------------------------------------------------------------------------- 1 | -module(bridge). 2 | -behaviour(gen_server). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -define(THRESHOLD(Total), Total div 2). 7 | % -define(THRESHOLD_LIMIT(Total), Total div 20). 8 | -define(LIMIT_TIMES_SIZE, 2). 9 | -define(LIMIT_TIMES_SIZE_TO_STOP, 1.2). 10 | -define(LIMIT_PASS, 5). 11 | 12 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). 13 | 14 | -export([start/1, request_enter/1, warn_exit/0, stop/0]). 15 | 16 | % These are all wrappers for calls to the server 17 | start(Total) -> 18 | gen_server:start_link({local, ?MODULE}, ?MODULE, [Total], []). 19 | request_enter(EntryPoint) -> 20 | gen_server:call(?MODULE, {request_enter, EntryPoint}). 21 | warn_exit() -> 22 | % io:format("LLEGA\n"), 23 | % gen_server:cast(?MODULE, warn_exit). 24 | gen_server:cast(?MODULE, warn_exit). 25 | stop() -> 26 | gen_server:stop(?MODULE). 27 | 28 | ?INVARIANT(fun invariant/1). 29 | 30 | invariant({Passing, Waiting, Total}) -> 31 | % io:format("ARRIBA: ~p\n", [{Passing, Waiting, Total}]), 32 | Res = 33 | is_integer(Passing) 34 | andalso 35 | is_integer(Total) 36 | andalso 37 | is_list(Waiting) 38 | andalso 39 | not(critical_waiting(Waiting, Total, ?LIMIT_TIMES_SIZE)), 40 | % io:format("ACABA: ~p\n", [Res]), 41 | % io:format("NS: ~p\n", [check_limit(n, s, Waiting, ?LIMIT_TIMES_SIZE)]), 42 | % io:format("SN: ~p\n", [check_limit(s, n, Waiting, ?LIMIT_TIMES_SIZE)]), 43 | Res. 44 | 45 | check_limit(EntryA, EntryB, Waiting, Limit) -> 46 | waiting(Waiting, EntryA) > (Limit * waiting(Waiting, EntryB)). 47 | 48 | waiting(Waiting, EntryPoint) -> 49 | length([EntryPoint || {_, EntryPointW} <- Waiting, EntryPointW == EntryPoint]). 50 | 51 | critical_waiting(Waiting, Total, Limit) -> 52 | ( check_limit(n, s, Waiting, Limit) 53 | orelse 54 | check_limit(s, n, Waiting, Limit) 55 | ) 56 | andalso 57 | (waiting(Waiting, n) + waiting(Waiting, s)) >= ?THRESHOLD(Total). 58 | 59 | who_is_critical(Waiting) -> 60 | case check_limit(n, s, Waiting, ?LIMIT_TIMES_SIZE_TO_STOP) of 61 | true -> 62 | n; 63 | false -> 64 | s 65 | end. 66 | 67 | 68 | % This is called when a connection is made to the server 69 | init([Total]) -> 70 | {ok, {0, [], Total}}. 71 | 72 | 73 | % handle_call is invoked in response to gen_server:call 74 | handle_call({request_enter, EntryPoint}, {From, _}, {Passing, Waiting, Total}) -> 75 | % io:format("{request_enter, EntryPoint}: ~p\n", [{request_enter, EntryPoint}]), 76 | {Reply, {NPassing, NWaiting}} = 77 | case Passing of 78 | 0 -> 79 | case critical_waiting(Waiting, Total, ?LIMIT_TIMES_SIZE_TO_STOP) of 80 | true -> 81 | case who_is_critical(Waiting) of 82 | EntryPoint -> 83 | {pass, {ns2int(EntryPoint), Waiting -- [{From, EntryPoint}]}}; 84 | _ -> 85 | {wait, {0, [{From, EntryPoint} | (Waiting -- [{From, EntryPoint}])] }} 86 | end; 87 | false -> 88 | {pass, {ns2int(EntryPoint), Waiting -- [{From, EntryPoint}]}} 89 | end; 90 | N when is_integer(N), N > 0, abs(N) < ?LIMIT_PASS -> 91 | FunPassOrWait = 92 | fun() -> 93 | case EntryPoint of 94 | n -> 95 | {pass, {Passing + 1, Waiting -- [{From, n}]}}; 96 | s -> 97 | {wait, {Passing, [{From, s} | (Waiting -- [{From, s}])] }} 98 | end 99 | end, 100 | case critical_waiting(Waiting, Total, ?LIMIT_TIMES_SIZE_TO_STOP) of 101 | true -> 102 | {wait, {Passing, [{From, EntryPoint} | (Waiting -- [{From, EntryPoint}])] }}; 103 | false -> 104 | FunPassOrWait() 105 | end; 106 | N when is_integer(N), N < 0, abs(N) < ?LIMIT_PASS -> 107 | FunPassOrWait = 108 | fun() -> 109 | case EntryPoint of 110 | n -> 111 | {wait, {Passing, [{From, n} | (Waiting -- [{From, n}])]}}; 112 | s -> 113 | {pass, {Passing - 1, Waiting -- [{From, s}]}} 114 | end 115 | end, 116 | case critical_waiting(Waiting, Total, ?LIMIT_TIMES_SIZE_TO_STOP) of 117 | true -> 118 | {wait, {Passing, [{From, EntryPoint} | (Waiting -- [{From, EntryPoint}])] }}; 119 | false -> 120 | FunPassOrWait() 121 | end; 122 | N when is_integer(N), abs(N) == ?LIMIT_PASS -> 123 | {wait, {Passing, [{From, EntryPoint} | (Waiting -- [{From, EntryPoint}])] }} 124 | end, 125 | % io:format("{Reply, {NPassing, NWaiting}}: ~p\n", [{Reply, {NPassing, NWaiting}}]), 126 | {reply, Reply, {NPassing, NWaiting, Total}}; 127 | 128 | % handle_call(warn_exit, From, {Passing, Waiting}) -> 129 | % NPassing = 130 | % case Passing < 0 of 131 | % true -> 132 | % Passing + 1; 133 | % false -> 134 | % Passing - 1 135 | % end, 136 | % % io:format("NPassing: ~p\n", [NPassing]), 137 | % {reply, ok, {NPassing, Waiting}}; 138 | 139 | handle_call(_Message, _From, State) -> 140 | % io:format("Error: ~p\n", [_Message]), 141 | {reply, error, State}. 142 | % ?POST(fun post_handle_call/0). 143 | 144 | % We get compile warnings from gen_server unless we define these 145 | % handle_cast(_Message, Library) -> 146 | % {noreply, Library}. 147 | handle_cast(warn_exit, {Passing, Waiting, Total}) -> 148 | NPassing = 149 | case Passing < 0 of 150 | true -> 151 | Passing + 1; 152 | false -> 153 | Passing - 1 154 | end, 155 | % io:format("NPassing: ~p\n", [NPassing]), 156 | {noreply, {NPassing, Waiting, Total}}; 157 | handle_cast(_Other, State) -> 158 | {noreply, State}. 159 | 160 | handle_info(_Message, Library) -> 161 | {noreply, Library}. 162 | terminate(_Reason, _Library) -> 163 | ok. 164 | code_change(_OldVersion, Library, _Extra) -> 165 | {ok, Library}. 166 | 167 | ns2int(n) -> 1; 168 | ns2int(s) -> -1. 169 | 170 | -------------------------------------------------------------------------------- /examples/bridge/_old_versions/fair/src/bridge_test.erl: -------------------------------------------------------------------------------- 1 | -module(bridge_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | compile:file(bridge, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | % timer:sleep(10000), 11 | bridge:stop(). 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | bridge:start(Total), 18 | Pids = create_cars(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_cars(N) -> 29 | PidsN = 30 | create_cars(lists:seq(1, N div 2), n), 31 | PidsS = 32 | create_cars(lists:seq((N div 2) + 1, N), s), 33 | rearrange_list(PidsN ++ PidsS). 34 | 35 | rearrange_list(L) -> 36 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 37 | 38 | create_cars(Ids, EntryPoint) -> 39 | Self = self(), 40 | lists:map( 41 | fun(Id) -> 42 | spawn( 43 | fun() -> 44 | put(parent, Self), 45 | car(Id, EntryPoint) 46 | end) 47 | end, 48 | Ids). 49 | 50 | car(Id, EntryPoint) -> 51 | receive 52 | start -> 53 | timer:sleep(100), 54 | car_loop(Id, EntryPoint) 55 | end. 56 | 57 | car_loop(Id, EntryPoint) -> 58 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 59 | Answer = 60 | bridge:request_enter(EntryPoint), 61 | case Answer of 62 | wait -> 63 | % io:format("Car ~p wait for entering from ~p\n", [Id, EntryPoint]), 64 | timer:sleep(100), 65 | car_loop(Id, EntryPoint); 66 | pass -> 67 | timer:sleep(100), 68 | bridge:warn_exit(), 69 | io:format("Car ~p passed entering from ~p\n", [Id, EntryPoint]), 70 | % car_loop(Id, EntryPoint) 71 | get(parent)!finished 72 | end. 73 | 74 | 75 | -------------------------------------------------------------------------------- /examples/bridge/_old_versions/fair_cpre/src/bridge.erl: -------------------------------------------------------------------------------- 1 | -module(bridge). 2 | -behaviour(gen_server_cpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -define(THRESHOLD(Total), Total div 20). 7 | 8 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/2]). 9 | 10 | -export([start/1, request_enter/1, warn_exit/0, stop/0]). 11 | 12 | % These are all wrappers for calls to the server 13 | start(Total) -> 14 | gen_server_cpre:start_link({local, ?MODULE}, ?MODULE, [Total], []). 15 | request_enter(EntryPoint) -> 16 | gen_server_cpre:call(?MODULE, {request_enter, EntryPoint}). 17 | warn_exit() -> 18 | % io:format("LLEGA\n"), 19 | % gen_server:call(?MODULE, warn_exit). 20 | gen_server_cpre:cast(?MODULE, warn_exit). 21 | stop() -> 22 | gen_server_cpre:stop(?MODULE). 23 | 24 | ?INVARIANT(fun invariant/1). 25 | 26 | invariant({Passing, Waiting, Total}) -> 27 | is_integer(Passing) 28 | andalso 29 | is_integer(Total) 30 | andalso 31 | is_list(Waiting) 32 | andalso 33 | length(Waiting) =< ?THRESHOLD(Total) 34 | . 35 | 36 | % This is called when a connection is made to the server 37 | init([Total]) -> 38 | {ok, {0, [], Total}}. 39 | 40 | 41 | % cpre(_, _) -> 42 | % true. 43 | cpre({request_enter, _}, {Passing, Waiting, Total}) -> 44 | % io:format("CPRE: ~p\n", [{Waiting, Total}]), 45 | Res = 46 | case length(Waiting) == ?THRESHOLD(Total) of 47 | true -> 48 | case Waiting of 49 | [] -> 50 | true; 51 | [_|_] -> 52 | case Passing of 53 | 0 -> 54 | true; 55 | _ -> 56 | false 57 | end 58 | end; 59 | false -> 60 | true 61 | end, 62 | % io:format("CPRE Res: ~p\n", [Res]), 63 | Res; 64 | cpre(_, _) -> 65 | % io:format("CPRE true\n", []), 66 | true. 67 | 68 | 69 | % handle_call is invoked in response to gen_server:call 70 | handle_call({request_enter, EntryPoint}, {From, _}, {Passing, Waiting, Total}) -> 71 | % io:format("{Passing, Waiting: ~p\n", [{Passing, length(Waiting)}]), 72 | {Reply, {NPassing, NWaiting}} = 73 | case Passing of 74 | 0 -> 75 | case EntryPoint of 76 | n -> 77 | {pass, {1, Waiting -- [{From, n}]}}; 78 | s -> 79 | {pass, {-1, Waiting -- [{From, s}]}} 80 | end; 81 | N when is_integer(N), N > 0 -> 82 | case EntryPoint of 83 | n -> 84 | {pass, {Passing + 1, Waiting -- [{From, n}]}}; 85 | s -> 86 | {wait, {Passing, [{From, s} | (Waiting -- [{From, n}])] }} 87 | end; 88 | N when is_integer(N), N < 0 -> 89 | case EntryPoint of 90 | n -> 91 | {wait, {Passing, [{From, n} | (Waiting -- [{From, n}])]}}; 92 | s -> 93 | {pass, {Passing - 1, Waiting -- [{From, s}]}} 94 | end 95 | end, 96 | % io:format("{Reply, NState}: ~p\n", [{Reply, NState}]), 97 | {reply, Reply, {NPassing, NWaiting, Total}}; 98 | 99 | % handle_call(warn_exit, From, {Passing, Waiting}) -> 100 | % NPassing = 101 | % case Passing < 0 of 102 | % true -> 103 | % Passing + 1; 104 | % false -> 105 | % Passing - 1 106 | % end, 107 | % % io:format("NPassing: ~p\n", [NPassing]), 108 | % {reply, ok, {NPassing, Waiting}}; 109 | 110 | handle_call(_Message, _From, State) -> 111 | % io:format("Error: ~p\n", [_Message]), 112 | {reply, error, State}. 113 | % ?POST(fun post_handle_call/0). 114 | 115 | % We get compile warnings from gen_server unless we define these 116 | % handle_cast(_Message, Library) -> 117 | % {noreply, Library}. 118 | handle_cast(warn_exit, {Passing, Waiting, Total}) -> 119 | NPassing = 120 | case Passing < 0 of 121 | true -> 122 | Passing + 1; 123 | false -> 124 | Passing - 1 125 | end, 126 | % io:format("NPassing: ~p\n", [NPassing]), 127 | {noreply, {NPassing, Waiting, Total}}; 128 | handle_cast(_Other, State) -> 129 | {noreply, State}. 130 | 131 | handle_info(_Message, Library) -> 132 | {noreply, Library}. 133 | terminate(_Reason, _Library) -> 134 | ok. 135 | code_change(_OldVersion, Library, _Extra) -> 136 | {ok, Library}. 137 | 138 | -------------------------------------------------------------------------------- /examples/bridge/_old_versions/fair_cpre/src/bridge_test.erl: -------------------------------------------------------------------------------- 1 | -module(bridge_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | compile:file(bridge, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | % timer:sleep(10000), 11 | bridge:stop(). 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | bridge:start(Total), 18 | Pids = create_cars(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_cars(N) -> 29 | PidsN = 30 | create_cars(lists:seq(1, N div 2), n), 31 | PidsS = 32 | create_cars(lists:seq((N div 2) + 1, N), s), 33 | rearrange_list(PidsN ++ PidsS). 34 | 35 | rearrange_list(L) -> 36 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 37 | 38 | create_cars(Ids, EntryPoint) -> 39 | Self = self(), 40 | lists:map( 41 | fun(Id) -> 42 | spawn( 43 | fun() -> 44 | put(parent, Self), 45 | car(Id, EntryPoint) 46 | end) 47 | end, 48 | Ids). 49 | 50 | car(Id, EntryPoint) -> 51 | receive 52 | start -> 53 | timer:sleep(100), 54 | car_loop(Id, EntryPoint) 55 | end. 56 | 57 | car_loop(Id, EntryPoint) -> 58 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 59 | Answer = 60 | bridge:request_enter(EntryPoint), 61 | case Answer of 62 | wait -> 63 | % io:format("Car ~p wait for entering from ~p\n", [Id, EntryPoint]), 64 | timer:sleep(100), 65 | car_loop(Id, EntryPoint); 66 | pass -> 67 | timer:sleep(100), 68 | bridge:warn_exit(), 69 | io:format("Car ~p passed entering from ~p\n", [Id, EntryPoint]), 70 | % car_loop(Id, EntryPoint) 71 | get(parent)!finished 72 | end. 73 | 74 | 75 | -------------------------------------------------------------------------------- /examples/bridge/_old_versions/plain/src/bridge.erl: -------------------------------------------------------------------------------- 1 | % c(bridge, [{d, edbc}]). 2 | 3 | -module(bridge). 4 | -behaviour(gen_server). 5 | 6 | -include_lib("edbc.hrl"). 7 | 8 | -define(THRESHOLD(Total), Total div 5). 9 | 10 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). 11 | 12 | -export([start/1, request_enter/1, warn_exit/0, stop/0]). 13 | 14 | % These are all wrappers for calls to the server 15 | start(Total) -> 16 | gen_server:start_link({local, ?MODULE}, ?MODULE, [Total], []). 17 | request_enter(EntryPoint) -> 18 | gen_server:call(?MODULE, {request_enter, EntryPoint}). 19 | warn_exit() -> 20 | % io:format("LLEGA\n"), 21 | % gen_server:call(?MODULE, warn_exit). 22 | gen_server:cast(?MODULE, warn_exit). 23 | stop() -> 24 | gen_server:stop(?MODULE). 25 | 26 | ?INVARIANT(fun invariant/1). 27 | 28 | invariant({Passing, Waiting, Total}) -> 29 | is_integer(Passing) 30 | andalso 31 | is_integer(Total) 32 | andalso 33 | is_list(Waiting) 34 | andalso 35 | length(Waiting) =< ?THRESHOLD(Total) 36 | . 37 | 38 | % This is called when a connection is made to the server 39 | init([Total]) -> 40 | {ok, {0, [], Total}}. 41 | 42 | 43 | % handle_call is invoked in response to gen_server:call 44 | handle_call({request_enter, EntryPoint}, {From, _}, {Passing, Waiting, Total}) -> 45 | {Reply, {NPassing, NWaiting}} = 46 | case Passing of 47 | 0 -> 48 | case EntryPoint of 49 | n -> 50 | {pass, {1, Waiting -- [{From, n}]}}; 51 | s -> 52 | {pass, {-1, Waiting -- [{From, s}]}} 53 | end; 54 | N when is_integer(N), N > 0 -> 55 | case EntryPoint of 56 | n -> 57 | {pass, {Passing + 1, Waiting -- [{From, n}]}}; 58 | s -> 59 | {wait, {Passing, [{From, s} | (Waiting -- [{From, n}])] }} 60 | end; 61 | N when is_integer(N), N < 0 -> 62 | case EntryPoint of 63 | n -> 64 | {wait, {Passing, [{From, n} | (Waiting -- [{From, n}])]}}; 65 | s -> 66 | {pass, {Passing - 1, Waiting -- [{From, s}]}} 67 | end 68 | end, 69 | % io:format("{Reply, NState}: ~p\n", [{Reply, NState}]), 70 | {reply, Reply, {NPassing, NWaiting, Total}}; 71 | 72 | % handle_call(warn_exit, From, {Passing, Waiting}) -> 73 | % NPassing = 74 | % case Passing < 0 of 75 | % true -> 76 | % Passing + 1; 77 | % false -> 78 | % Passing - 1 79 | % end, 80 | % % io:format("NPassing: ~p\n", [NPassing]), 81 | % {reply, ok, {NPassing, Waiting}}; 82 | 83 | handle_call(_Message, _From, State) -> 84 | % io:format("Error: ~p\n", [_Message]), 85 | {reply, error, State}. 86 | % ?POST(fun post_handle_call/0). 87 | 88 | % We get compile warnings from gen_server unless we define these 89 | % handle_cast(_Message, Library) -> 90 | % {noreply, Library}. 91 | handle_cast(warn_exit, {Passing, Waiting, Total}) -> 92 | NPassing = 93 | case Passing < 0 of 94 | true -> 95 | Passing + 1; 96 | false -> 97 | Passing - 1 98 | end, 99 | % io:format("NPassing: ~p\n", [NPassing]), 100 | {noreply, {NPassing, Waiting, Total}}; 101 | handle_cast(_Other, State) -> 102 | {noreply, State}. 103 | 104 | handle_info(_Message, Library) -> 105 | {noreply, Library}. 106 | terminate(_Reason, _Library) -> 107 | ok. 108 | code_change(_OldVersion, Library, _Extra) -> 109 | {ok, Library}. 110 | 111 | -------------------------------------------------------------------------------- /examples/bridge/_old_versions/plain/src/bridge_test.erl: -------------------------------------------------------------------------------- 1 | -module(bridge_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | compile:file(bridge, [{d,edbc}]), 7 | start(), 8 | % timer:sleep(10000), 9 | bridge:stop(). 10 | 11 | 12 | start() -> 13 | Total = 14 | 1000, 15 | bridge:start(Total), 16 | Pids = create_cars(Total), 17 | [Pid!start || Pid <- Pids], 18 | [ 19 | receive 20 | finished -> 21 | ok 22 | end 23 | || _ <- Pids]. 24 | 25 | 26 | create_cars(N) -> 27 | PidsN = 28 | create_cars(lists:seq(1, N div 2), n), 29 | PidsS = 30 | create_cars(lists:seq((N div 2) + 1, N), s), 31 | rearrange_list(PidsN ++ PidsS). 32 | 33 | rearrange_list(L) -> 34 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 35 | 36 | create_cars(Ids, EntryPoint) -> 37 | Self = self(), 38 | lists:map( 39 | fun(Id) -> 40 | spawn( 41 | fun() -> 42 | put(parent, Self), 43 | car(Id, EntryPoint) 44 | end) 45 | end, 46 | Ids). 47 | 48 | car(Id, EntryPoint) -> 49 | receive 50 | start -> 51 | timer:sleep(100), 52 | car_loop(Id, EntryPoint) 53 | end. 54 | 55 | car_loop(Id, EntryPoint) -> 56 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 57 | Answer = 58 | bridge:request_enter(EntryPoint), 59 | case Answer of 60 | wait -> 61 | % io:format("Car ~p wait for entering from ~p\n", [Id, EntryPoint]), 62 | timer:sleep(100), 63 | car_loop(Id, EntryPoint); 64 | pass -> 65 | timer:sleep(100), 66 | bridge:warn_exit(), 67 | io:format("Car ~p passed entering from ~p\n", [Id, EntryPoint]), 68 | % car_loop(Id, EntryPoint) 69 | get(parent)!finished 70 | end. 71 | 72 | 73 | -------------------------------------------------------------------------------- /examples/bridge/fair/src/bridge.erl: -------------------------------------------------------------------------------- 1 | -module(bridge). 2 | -behaviour(gen_server_cpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -define(THRESHOLD(Total), Total div 20). 7 | 8 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 9 | 10 | -export([start/0, request_enter/1, warn_arrival/1, warn_exit/1, stop/0]). 11 | 12 | 13 | -record(state, 14 | { 15 | passing = 0, % Negative indicates that the cars are passing from N to S. Possitive from S to N. 16 | waitingN = false, 17 | waitingS = false, 18 | prev_state = none 19 | }). 20 | 21 | 22 | % These are all wrappers for calls to the server 23 | start() -> 24 | gen_server_cpre:start_link({local, ?MODULE}, ?MODULE, [], []). 25 | request_enter(EntryPoint) -> 26 | gen_server_cpre:call(?MODULE, {request_enter, EntryPoint}, infinity). 27 | warn_arrival(ExitPoint) -> 28 | gen_server_cpre:call(?MODULE, {warn_arrival, ExitPoint}, infinity). 29 | warn_exit(ExitPoint) -> 30 | gen_server_cpre:call(?MODULE, {warn_exit, ExitPoint}, infinity). 31 | stop() -> 32 | gen_server_cpre:stop(?MODULE). 33 | 34 | ?INVARIANT(fun invariant/1). 35 | 36 | invariant( 37 | State = 38 | #state{ 39 | passing = Passing, 40 | waitingN = WaitingN, 41 | waitingS = WaitingS, 42 | prev_state = PrevState 43 | }) -> 44 | % io:format("State: ~p\n", [State]), 45 | is_integer(Passing) 46 | andalso 47 | is_boolean(WaitingN) 48 | andalso 49 | is_boolean(WaitingS) 50 | andalso 51 | case PrevState of 52 | #state{} -> 53 | true; 54 | none -> 55 | true; 56 | _ -> 57 | {false, "The state term is not the expected."} 58 | end 59 | andalso 60 | case PrevState of 61 | #state{} -> 62 | % If the state change corresponds to a car that passed. 63 | case abs(Passing) > abs(PrevState#state.passing) of 64 | true -> 65 | case {PrevState#state.waitingN, PrevState#state.waitingS} of 66 | {true, true} -> 67 | case PrevState#state.passing == 0 of 68 | true -> 69 | true; 70 | false -> 71 | % If both are waiting it means that the direction that was being used have stopped 72 | { 73 | false, 74 | lists:flatten( 75 | io_lib:format( 76 | "There were cars waiting on both sides. A priority should be given to the cars that wanted to enter from the opposite side of the current way.\n" 77 | ++ "State info\nCars waiting N (previous state): ~p\nCars waiting S (previous state): ~p\nPrevious passing: ~p\n Current passing: ~p\n", 78 | [PrevState#state.waitingN, PrevState#state.waitingS, PrevState#state.passing, State#state.passing])) 79 | } 80 | end; 81 | {true, false} -> 82 | case Passing < 0 of 83 | true -> 84 | true; 85 | false -> 86 | % If there where only cars waiting at N then they should pass. 87 | { 88 | false, 89 | lists:flatten( 90 | io_lib:format( 91 | "There were cars waiting on the north side. They should pass.\n" 92 | ++ "State info\nCars waiting N (previous state): ~p\nCars waiting S (previous state): ~p\nPrevious passing: ~p\n Current passing: ~p\n", 93 | [PrevState#state.waitingN, PrevState#state.waitingS, PrevState#state.passing, State#state.passing])) 94 | } 95 | end; 96 | {false, true} -> 97 | case Passing > 0 of 98 | true -> 99 | true; 100 | false -> 101 | % If there where only cars waiting at S then they should pass. 102 | { 103 | false, 104 | lists:flatten( 105 | io_lib:format( 106 | "There were cars waiting on the south side. They should pass.\n" 107 | ++ "State info\nCars waiting N (previous state): ~p\nCars waiting S (previous state): ~p\nPrevious passing: ~p\n Current passing: ~p\n", 108 | [PrevState#state.waitingN, PrevState#state.waitingS, PrevState#state.passing, State#state.passing])) 109 | } 110 | end; 111 | {false, false} -> 112 | %It is not possible for a car to pass without previously being waiting 113 | {false, "A car passed without be previously waiting."} 114 | end; 115 | false -> 116 | true 117 | end; 118 | _ -> 119 | true 120 | end 121 | . 122 | 123 | % This is called when a connection is made to the server 124 | init([]) -> 125 | {ok, #state{}}. 126 | 127 | 128 | % cpre(_, _) -> 129 | % true. 130 | cpre({request_enter, n}, _, State = #state{passing = Passing, waitingS = false}) when Passing < 0 -> 131 | { 132 | true, 133 | State 134 | }; 135 | % Next two clauses could be unified 136 | cpre({request_enter, n}, _, State = #state{passing = Passing, waitingS = true}) when Passing < 0 -> 137 | { 138 | false, 139 | State 140 | }; 141 | cpre({request_enter, s}, _, State = #state{passing = Passing}) when Passing < 0 -> 142 | { 143 | false, 144 | State 145 | }; 146 | cpre({request_enter, s}, _, State = #state{passing = Passing, waitingN = false}) when Passing > 0 -> 147 | { 148 | true, 149 | State 150 | }; 151 | % Next two clauses could be unified 152 | cpre({request_enter, s}, _, State = #state{passing = Passing, waitingN = true}) when Passing > 0 -> 153 | { 154 | false, 155 | State 156 | }; 157 | cpre({request_enter, n}, _, State = #state{passing = Passing}) when Passing > 0 -> 158 | { 159 | false, 160 | State 161 | }; 162 | cpre(_, _, State) -> 163 | { 164 | true, 165 | State 166 | }. 167 | 168 | 169 | % handle_call is invoked in response to gen_server:call 170 | handle_call({request_enter, EntryPoint}, _, State) -> 171 | {Reply, NState} = 172 | {pass, pass(State, EntryPoint)}, 173 | {reply, Reply, update_prev_state(State, NState)}; 174 | handle_call({warn_arrival, EntryPoint}, _, State) -> 175 | {Reply, NState} = 176 | {ok, wait(State, EntryPoint)}, 177 | {reply, Reply, update_prev_state(State, NState)}; 178 | handle_call({warn_exit, EntryPoint}, _, State) -> 179 | {Reply, NState} = 180 | exit_car(State, EntryPoint), 181 | {reply, Reply, NState}; 182 | handle_call(_Message, _From, State) -> 183 | % io:format("Error: ~p\n", [_Message]), 184 | {reply, error, State}. 185 | 186 | 187 | handle_cast(_Other, State) -> 188 | {noreply, State}. 189 | 190 | handle_info(_Message, Library) -> 191 | {noreply, Library}. 192 | terminate(_Reason, _Library) -> 193 | ok. 194 | code_change(_OldVersion, Library, _Extra) -> 195 | {ok, Library}. 196 | 197 | update_prev_state(State, NState) -> 198 | NState#state{ 199 | prev_state = State#state{prev_state = none} % To avoid create a useless big structure 200 | }. 201 | 202 | wait(State, n) -> 203 | State#state{waitingN = true}; 204 | wait(State, s) -> 205 | State#state{waitingS = true}. 206 | 207 | pass(State = #state{passing = Passing}, n) -> 208 | State#state{passing = Passing - 1, waitingN = false}; %If only one car could be waiting, when it passes we know that there are no more cars waiting there. 209 | pass(State = #state{passing = Passing}, s) -> 210 | State#state{passing = Passing + 1, waitingS = false}. 211 | 212 | exit_car(State, n) -> 213 | exit_car( 214 | State, 215 | fun(Passing) -> Passing < 0 end, 216 | fun(Passing) -> Passing + 1 end); 217 | exit_car(State, s) -> 218 | exit_car( 219 | State, 220 | fun(Passing) -> Passing > 0 end, 221 | fun(Passing) -> Passing - 1 end). 222 | 223 | exit_car(State = #state{passing = Passing}, FunCompare, FunUpdate) -> 224 | case FunCompare(Passing) of 225 | true -> 226 | {ok, update_prev_state(State, State#state{passing = FunUpdate(Passing)})}; 227 | false -> 228 | {nosense, State} 229 | end. -------------------------------------------------------------------------------- /examples/bridge/fair/src/bridge_test.erl: -------------------------------------------------------------------------------- 1 | -module(bridge_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | % compile:file(bridge, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | % timer:sleep(10000), 11 | bridge:stop(). 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | bridge:start(), 18 | Pids = create_sensors(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_sensors(N) -> 29 | PidEntN = 30 | create_sensor(N, entry, n), 31 | PidSalN = 32 | create_sensor(N, exit, n), 33 | PidEntS = 34 | create_sensor(N, entry, s), 35 | PidSalS = 36 | create_sensor(N, exit, s), 37 | rearrange_list([PidEntN, PidSalN, PidEntS, PidSalS]). 38 | 39 | rearrange_list(L) -> 40 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 41 | 42 | create_sensor(N, Type, Place) -> 43 | Self = self(), 44 | spawn( 45 | fun() -> 46 | sensor(N, Type, Place, Self) 47 | end). 48 | 49 | sensor(N, Type, Place, Self) -> 50 | receive 51 | start -> 52 | sensor_loop(N, Type, Place, Self) 53 | end. 54 | 55 | sensor_loop(0, _, _, Self) -> 56 | Self ! finished; 57 | sensor_loop(N, entry, Place, Self) -> 58 | Wait = 59 | rand:uniform(100) + 100, 60 | timer:sleep(Wait), 61 | ok = 62 | bridge:warn_arrival(Place), 63 | pass = 64 | bridge:request_enter(Place), 65 | io:format("A car entered from ~p.\n",[Place]), 66 | sensor_loop(N - 1, entry, Place, Self); 67 | sensor_loop(N, exit, Place, Self) -> 68 | Wait = 69 | rand:uniform(100) + 100, 70 | timer:sleep(Wait), 71 | case bridge:warn_exit(Place) of 72 | nosense -> 73 | sensor_loop(N, exit, Place, Self); 74 | ok -> 75 | io:format("A car exited. It entered from ~p.\n",[Place]), 76 | sensor_loop(N - 1, exit, Place, Self) 77 | end. 78 | 79 | 80 | -------------------------------------------------------------------------------- /examples/bridge/unfair/src/bridge.erl: -------------------------------------------------------------------------------- 1 | -module(bridge). 2 | -behaviour(gen_server_cpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -define(THRESHOLD(Total), Total div 20). 7 | 8 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 9 | 10 | -export([start/0, request_enter/1, warn_arrival/1, warn_exit/1, stop/0]). 11 | 12 | 13 | -record(state, 14 | { 15 | passing = 0, % Negative indicates that the cars are passing from N to S. Possitive from S to N. 16 | waitingN = false, 17 | waitingS = false, 18 | prev_state = none 19 | }). 20 | 21 | 22 | % These are all wrappers for calls to the server 23 | start() -> 24 | gen_server_cpre:start_link({local, ?MODULE}, ?MODULE, [], []). 25 | request_enter(EntryPoint) -> 26 | gen_server_cpre:call(?MODULE, {request_enter, EntryPoint}, infinity). 27 | warn_arrival(ExitPoint) -> 28 | gen_server_cpre:call(?MODULE, {warn_arrival, ExitPoint}, infinity). 29 | warn_exit(ExitPoint) -> 30 | gen_server_cpre:call(?MODULE, {warn_exit, ExitPoint}, infinity). 31 | stop() -> 32 | gen_server_cpre:stop(?MODULE). 33 | 34 | ?INVARIANT(fun invariant_starvation/1). 35 | 36 | invariant( 37 | State = 38 | #state{ 39 | passing = Passing, 40 | waitingN = WaitingN, 41 | waitingS = WaitingS, 42 | prev_state = PrevState 43 | }) -> 44 | % io:format("State: ~p\n", [State]), 45 | is_integer(Passing) 46 | andalso 47 | is_boolean(WaitingN) 48 | andalso 49 | is_boolean(WaitingS) 50 | andalso 51 | case PrevState of 52 | #state{} -> 53 | true; 54 | none -> 55 | true; 56 | _ -> 57 | false 58 | end 59 | . 60 | 61 | invariant_starvation( 62 | State = 63 | #state{ 64 | passing = Passing, 65 | waitingN = WaitingN, 66 | waitingS = WaitingS, 67 | prev_state = PrevState 68 | }) -> 69 | % io:format("State: ~p\n", [State]), 70 | is_integer(Passing) 71 | andalso 72 | is_boolean(WaitingN) 73 | andalso 74 | is_boolean(WaitingS) 75 | andalso 76 | case PrevState of 77 | #state{} -> 78 | true; 79 | none -> 80 | true; 81 | _ -> 82 | {false, "The state term is not the expected."} 83 | end 84 | % Starvation condition 85 | andalso 86 | case PrevState of 87 | #state{} -> 88 | % If the state change corresponds to a car that passed. 89 | case abs(Passing) > abs(PrevState#state.passing) of 90 | true -> 91 | case {PrevState#state.waitingN, PrevState#state.waitingS} of 92 | {true, true} -> 93 | case PrevState#state.passing == 0 of 94 | true -> 95 | true; 96 | false -> 97 | % If both are waiting it means that the direction that was being used have stopped 98 | { 99 | false, 100 | lists:flatten( 101 | io_lib:format( 102 | "There were cars waiting on both sides. A priority should be given to the cars that wanted to enter from the opposite side of the current way.\n" 103 | ++ "State info\nCars waiting N (previous state): ~p\nCars waiting S (previous state): ~p\nPrevious passing: ~p\n Current passing: ~p\n", 104 | [PrevState#state.waitingN, PrevState#state.waitingS, PrevState#state.passing, State#state.passing])) 105 | } 106 | end; 107 | {true, false} -> 108 | case Passing < 0 of 109 | true -> 110 | true; 111 | false -> 112 | % If there where only cars waiting at N then they should pass. 113 | { 114 | false, 115 | lists:flatten( 116 | io_lib:format( 117 | "There were cars waiting on the north side. They should pass.\n" 118 | ++ "State info\nCars waiting N (previous state): ~p\nCars waiting S (previous state): ~p\nPrevious passing: ~p\n Current passing: ~p\n", 119 | [PrevState#state.waitingN, PrevState#state.waitingS, PrevState#state.passing, State#state.passing])) 120 | } 121 | end; 122 | {false, true} -> 123 | case Passing > 0 of 124 | true -> 125 | true; 126 | false -> 127 | % If there where only cars waiting at S then they should pass. 128 | { 129 | false, 130 | lists:flatten( 131 | io_lib:format( 132 | "There were cars waiting on the south side. They should pass.\n" 133 | ++ "State info\nCars waiting N (previous state): ~p\nCars waiting S (previous state): ~p\nPrevious passing: ~p\n Current passing: ~p\n", 134 | [PrevState#state.waitingN, PrevState#state.waitingS, PrevState#state.passing, State#state.passing])) 135 | } 136 | end; 137 | {false, false} -> 138 | %It is not possible for a car to pass without previously being waiting 139 | {false, "A car passed without be previously waiting."} 140 | end; 141 | false -> 142 | true 143 | end; 144 | _ -> 145 | true 146 | end 147 | . 148 | 149 | % This is called when a connection is made to the server 150 | init([]) -> 151 | {ok, #state{}}. 152 | 153 | 154 | cpre(A, B, C) -> 155 | Res = cpre_(A, B, C), 156 | case Res of 157 | {false, _} -> 158 | % io:format("cpre: ~p\n", [{{A, B, C}, Res}]); 159 | ok; 160 | _ -> 161 | ok 162 | end, 163 | Res. 164 | 165 | 166 | % cpre(_, _) -> 167 | % true. 168 | cpre_({request_enter, s}, _, State = #state{passing = Passing}) when Passing < 0 -> 169 | { 170 | false, 171 | State 172 | }; 173 | cpre_({request_enter, n}, _, State = #state{passing = Passing}) when Passing > 0 -> 174 | { 175 | false, 176 | State 177 | }; 178 | % cpre({request_enter, s}, _, State = #state{passing = Passing}) when Passing > 0 -> 179 | % { 180 | % true, 181 | % State 182 | % }; 183 | % cpre({request_enter, n}, _, State = #state{passing = Passing}) when Passing < 0 -> 184 | % { 185 | % true, 186 | % State 187 | % }; 188 | cpre_(_, _, State) -> 189 | { 190 | true, 191 | State 192 | }. 193 | 194 | 195 | % handle_call is invoked in response to gen_server:call 196 | handle_call({request_enter, EntryPoint}, _, State) -> 197 | {Reply, NState} = 198 | {pass, pass(State, EntryPoint)}, 199 | % io:format("NState RE: ~p\n", [{EntryPoint, NState#state.passing, _Form}]), 200 | {reply, Reply, update_prev_state(State, NState)}; 201 | handle_call({warn_arrival, EntryPoint}, _, State) -> 202 | {Reply, NState} = 203 | {ok, wait(State, EntryPoint)}, 204 | {reply, Reply, update_prev_state(State, NState)}; 205 | handle_call({warn_exit, EntryPoint}, _, State) -> 206 | {Reply, NState} = 207 | exit_car(State, EntryPoint), 208 | % io:format("NState WE: ~p\n", [{_From, EntryPoint, Reply, NState#state.passing}]), 209 | {reply, Reply, NState}; 210 | handle_call(_Message, _From, State) -> 211 | % io:format("Error: ~p\n", [_Message]), 212 | {reply, error, State}. 213 | 214 | 215 | handle_cast(_Other, State) -> 216 | {noreply, State}. 217 | 218 | handle_info(_Message, Library) -> 219 | {noreply, Library}. 220 | terminate(_Reason, _Library) -> 221 | ok. 222 | code_change(_OldVersion, Library, _Extra) -> 223 | {ok, Library}. 224 | 225 | update_prev_state(State, NState) -> 226 | NState#state{ 227 | prev_state = State#state{prev_state = none} % To avoid create a useless big structure 228 | }. 229 | 230 | wait(State, n) -> 231 | State#state{waitingN = true}; 232 | wait(State, s) -> 233 | State#state{waitingS = true}. 234 | 235 | pass(State = #state{passing = Passing}, n) -> 236 | State#state{passing = Passing - 1, waitingN = false}; 237 | pass(State = #state{passing = Passing}, s) -> 238 | State#state{passing = Passing + 1, waitingS = false}. 239 | 240 | exit_car(State, n) -> 241 | exit_car( 242 | State, 243 | fun(Passing) -> Passing < 0 end, 244 | fun(Passing) -> Passing + 1 end); 245 | exit_car(State, s) -> 246 | exit_car( 247 | State, 248 | fun(Passing) -> Passing > 0 end, 249 | fun(Passing) -> Passing - 1 end). 250 | 251 | exit_car(State = #state{passing = Passing}, FunCompare, FunUpdate) -> 252 | case FunCompare(Passing) of 253 | true -> 254 | {ok, update_prev_state(State, State#state{passing = FunUpdate(Passing)})}; 255 | false -> 256 | {nosense, State} 257 | end. -------------------------------------------------------------------------------- /examples/bridge/unfair/src/bridge_test.erl: -------------------------------------------------------------------------------- 1 | -module(bridge_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | % compile:file(bridge, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | % timer:sleep(10000), 11 | bridge:stop(). 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | bridge:start(), 18 | Pids = create_sensors(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_sensors(N) -> 29 | PidEntN = 30 | create_sensor(N, entry, n), 31 | PidSalN = 32 | create_sensor(N, exit, n), 33 | PidEntS = 34 | create_sensor(N, entry, s), 35 | PidSalS = 36 | create_sensor(N, exit, s), 37 | rearrange_list([PidEntN, PidSalN, PidEntS, PidSalS]). 38 | 39 | rearrange_list(L) -> 40 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 41 | 42 | create_sensor(N, Type, Place) -> 43 | Self = self(), 44 | spawn( 45 | fun() -> 46 | sensor(N, Type, Place, Self) 47 | end). 48 | 49 | sensor(N, Type, Place, Self) -> 50 | receive 51 | start -> 52 | sensor_loop(N, Type, Place, Self) 53 | end. 54 | 55 | sensor_loop(0, _, _, Self) -> 56 | Self ! finished; 57 | sensor_loop(N, entry, Place, Self) -> 58 | Wait = 59 | rand:uniform(100) + 100, 60 | timer:sleep(Wait), 61 | ok = 62 | bridge:warn_arrival(Place), 63 | pass = 64 | bridge:request_enter(Place), 65 | io:format("A car entered from ~p.\n",[Place]), 66 | sensor_loop(N - 1, entry, Place, Self); 67 | sensor_loop(N, exit, Place, Self) -> 68 | Wait = 69 | rand:uniform(100) + 100, 70 | timer:sleep(Wait), 71 | case bridge:warn_exit(Place) of 72 | nosense -> 73 | sensor_loop(N, exit, Place, Self); 74 | ok -> 75 | io:format("A car exited. It entered from ~p.\n",[Place]), 76 | sensor_loop(N - 1, exit, Place, Self) 77 | end. 78 | 79 | 80 | -------------------------------------------------------------------------------- /examples/other/src/ej1.erl: -------------------------------------------------------------------------------- 1 | -module(ej1). 2 | -export([f/1, g/1, h/2, i/2, f_rec/2, f_time/1, f_pure/0, f_type/2, start/0]). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | 7 | ?PRE(fun pre_f/0). 8 | f(0) -> 1; 9 | f(N) -> 10 | Prev = f(N-1), 11 | % ?assert(pre_f_i(Prev, N)), 12 | % Bound variables are sent 13 | % ?PRE_I(fun pre_f_i/0), 14 | % Bound variables are not sent (for reusable contracts) 15 | % ?PRE_I(fun pre_f_i/2. [Prev, N ]), 16 | Prev * 3. 17 | ?POST(fun post_f/0). 18 | 19 | % ?PRE(fun pre_g/0). 20 | ?PRE(fun() -> (?P(1) == 1) orelse (?P(1) == 2) end). 21 | g(1) -> 2; 22 | g(2) -> 3. 23 | ?POST(fun() -> (?R == 2) orelse (?R == 3) end). 24 | 25 | ?PRE(fun pre_h/0). 26 | h(X, Y) -> 27 | X / Y. 28 | 29 | i(Elem, List) -> 30 | [Elem,1 | List]. 31 | ?POST(fun post_i/0). 32 | 33 | pre_f() -> 34 | case ?P(1) >= 0 of 35 | true -> 36 | true; 37 | false -> 38 | { 39 | false, 40 | "The first parameter should be greater than or equal to 0." 41 | } 42 | end. 43 | 44 | post_f() -> 45 | io:format("f(~p) = ~p\n", [?P(1), ?R]), 46 | ?R >= ?P(1). 47 | 48 | % pre_g() -> 49 | % (?P(1) == 1) orelse (?P(1) == 2). 50 | 51 | pre_h() -> 52 | C1 = 53 | ?P(1) /= ?P(2), 54 | C2 = 55 | ?P(2) /= 0, 56 | C1 and C2. 57 | 58 | post_i() -> 59 | (length(?P(2)) + 1) == length(?R). 60 | 61 | 62 | % ?DECREASES([?P(1), ?P(2)]). 63 | ?DECREASES(?P(2)). 64 | ?PRE(fun() -> ?P(1) < ?P(2) end). 65 | 66 | %% @doc This is a very useful function. 67 | 68 | % Example of a failing call 69 | % ej1:f_rec(1,4). 70 | f_rec(M, N) -> 71 | io:format("{M, N}: ~p\n", [{M, N}]), 72 | case M of 73 | 0 -> 74 | f_rec(M + 1, N + 2); 75 | N -> 76 | f_rec(M - 1, N - 1); 77 | _ -> 78 | case N of 79 | 0 -> 80 | M; 81 | _ -> 82 | f_rec(M, N - 1) 83 | end 84 | end. 85 | 86 | %% @doc This is a very useful function. 87 | %% 88 | %% 89 | %% Intersting 90 | %% Function 91 | 92 | 93 | % Sample of failing predicate 94 | ?EXPECTED_TIME(fun() -> length(?P(1)) * 50 end). 95 | % Sample of correct predicate 96 | % ?EXPECTED_TIME(fun() -> 20 + (length(?P(1)) * 100) end). 97 | % Sample of predicate timeouting 98 | % ?TIMEOUT(fun() -> length(?P(1)) end). 99 | % Sample of predicate no timeouting 100 | ?TIMEOUT(fun() -> 20 + (length(?P(1)) * 100) end). 101 | % -spec f_time(list(any())) -> list(any()). 102 | -spec f_time(integer()) -> integer(). 103 | 104 | 105 | % Sample call 106 | % ej1:f_time(lists:seq(1,10)). 107 | f_time(L) -> 108 | [timer:sleep(100) || _ <- L]. 109 | 110 | 111 | %% @doc This is a very useful function. 112 | 113 | ?PURE. 114 | f_pure() -> 115 | % Detected side-effect operations 116 | % os:cmd("ls"), 117 | % io:format("I'm not pure"), 118 | % spawn(fun() -> ok end), 119 | % self()!hi, 120 | % dets:open_file(table, []), 121 | ets:new(table, [set]), 122 | % rand:uniform(30), 123 | % put(r, 1), 124 | % Not-detected side-effect operations 125 | % get(r), 126 | % This exits are reported as they are (they are not affected by the tracing). However, the tracestack is lost. 127 | % 3/0, 128 | % exit("out"), 129 | % throw("out"), 130 | ok. 131 | 132 | % -spec f_type(list(integer())) -> list(atom()). 133 | -spec f_type([integer()], integer()) -> [integer()]. 134 | %% @doc This is a very useful function. 135 | 136 | f_type(L, X) -> 137 | % case sheriff:check(L, "list(integer())") of 138 | % true -> 139 | % [timer:sleep(100) || _ <- L]; 140 | % false -> 141 | % {error, badarg} 142 | % end. 143 | [length(L) + X | L]. 144 | 145 | -spec start() -> atom(). 146 | start() -> 147 | ok. 148 | 149 | % pre_f_i(Prev, N = 2) -> 150 | % io:format("Prev: ~p\n", [Prev]), 151 | % Prev > N. 152 | 153 | % pre_f_i(Prev, N) -> 154 | % io:format("Prev: ~p\n", [Prev]), 155 | % Prev > N. 156 | 157 | % pre_f_i() -> 158 | % Prev > N, 159 | % true. -------------------------------------------------------------------------------- /examples/other/src/ej_paper.erl: -------------------------------------------------------------------------------- 1 | -module(ej_paper). 2 | -export([ 3 | abs/1, 4 | multiple_returns/2, 5 | max/2, 6 | wrong_abs_wrong_post/1, 7 | wrong_abs_partial_right_post/1, 8 | wrong_abs_right_post/1, 9 | abs_neg/1, 10 | fib/1, 11 | find/2, 12 | binary_search/2, 13 | area/1, 14 | g1/0, 15 | g2/0, 16 | g3/0, 17 | g4/0, 18 | f_time/1, 19 | f_time2/1, 20 | qsort/1, 21 | qsort_tr/1, 22 | isort/1, 23 | sum_lol/1, 24 | di/1 25 | ]). 26 | 27 | -include_lib("edbc.hrl"). 28 | 29 | % method Abs(x: int) returns (y: int) 30 | % ensures 0 <= y 31 | % { 32 | % ... 33 | % } 34 | 35 | 36 | abs(0) -> 37 | 0; 38 | abs(N) -> 39 | case N > 0 of 40 | true -> 41 | N; 42 | false -> 43 | -N 44 | end. 45 | 46 | ?POST(fun() -> ?R >= 0 end). 47 | 48 | % method MultipleReturns(x: int, y: int) returns (more: int, less: int) 49 | % requires 0 < y 50 | % ensures less < x 51 | % ensures x < more 52 | % { 53 | % more := x + y; 54 | % less := x - y; 55 | % } 56 | 57 | % This call makes the postcondition fails when the precondition is not defined: 58 | % ej_paper:multiple_returns(3, -4). 59 | % This is not failing without pre: 60 | % ej_paper:multiple_returns(3, 4). 61 | 62 | ?PRE(fun() -> ?P(2) > 0 end). 63 | 64 | multiple_returns(X, Y) -> 65 | {X + Y, X - Y}. 66 | 67 | ?POST( 68 | fun() -> 69 | {M, L} = ?R, 70 | L < ?P(1) andalso ?P(1) < M 71 | end). 72 | 73 | % method Max(a: int, b:int) returns (c: int) 74 | % ensures (c == a || c == b) && c >= a && c >= b; 75 | % { 76 | % if (a > b) 77 | % { return a; } 78 | % else 79 | % { return b; } 80 | % } 81 | 82 | max(X, Y) -> 83 | case X > Y of 84 | true -> 85 | X; 86 | false -> 87 | Y 88 | end. 89 | 90 | ?POST( 91 | fun() -> 92 | (?R == ?P(1) orelse ?R == ?P(2)) 93 | andalso 94 | (?R >= ?P(1) andalso ?R >= ?P(2)) 95 | end). 96 | 97 | 98 | % method Abs(x: int) returns (y: int) 99 | % ensures 0 <= y 100 | % { 101 | % y := 0; 102 | % } 103 | 104 | wrong_abs_wrong_post(N) -> 105 | 0. 106 | 107 | ?POST(fun() -> ?R >= 0 end). 108 | 109 | 110 | % method Abs(x: int) returns (y: int) 111 | % ensures 0 <= y 112 | % ensures 0 <= x ==> x == y 113 | % { 114 | % y := 0; 115 | % } 116 | 117 | wrong_abs_partial_right_post(N) -> 118 | 0. 119 | 120 | ?POST( 121 | fun() -> 122 | (?R >= 0) 123 | andalso 124 | (?P(1) < 0 orelse ?P(1) == ?R) 125 | end). 126 | 127 | % method Abs(x: int) returns (y: int) 128 | % ensures 0 <= y 129 | % ensures 0 <= x ==> x == y 130 | % ensures x < 0 ==> y == -x 131 | % { 132 | % y := 0; 133 | % } 134 | 135 | wrong_abs_right_post(N) -> 136 | 0. 137 | 138 | ?POST( 139 | fun() -> 140 | (?R >= 0) 141 | andalso 142 | (?R == ?P(1) orelse ?R == -?P(1)) 143 | end). 144 | 145 | 146 | % method Abs(x: int) returns (y: int) 147 | % requires x < 0 148 | % { 149 | % ... 150 | % } 151 | 152 | ?PRE(fun() -> ?P(1) < 0 end). 153 | 154 | abs_neg(N) -> 155 | -N. 156 | 157 | ?POST(fun() -> ?R > 0 andalso ?R == -?P(1) end). 158 | 159 | % function fib(n: nat): nat 160 | % decreases n 161 | % { 162 | % if n == 0 then 0 else 163 | % if n == 1 then 1 else 164 | % fib(n - 1) + fib(n - 2) 165 | % } 166 | 167 | ?PRE(fun() -> ?P(1) >= 0 end). 168 | ?SDECREASES(?P(1)). 169 | -spec fib(integer()) -> integer(). 170 | 171 | % To see how it fails just remove the clause for number 1. 172 | 173 | fib(0) -> 174 | 0; 175 | fib(1) -> 176 | 1; 177 | fib(N) -> 178 | fib(N - 1) + fib(N - 2). 179 | 180 | 181 | % method Find(a: array, key: int) returns (index: int) 182 | % requires a != null 183 | % ensures 0 <= index ==> index < a.Length && a[index] == key 184 | % ensures index < 0 ==> forall k :: 0 <= k < a.Length ==> a[k] != key 185 | % { 186 | % // Open in editor for a challenge... 187 | % } 188 | 189 | ?PRE(fun() -> length(?P(1)) > 0 end). 190 | 191 | % -spec find(list(integer()), integer()) -> integer(). 192 | 193 | % ?PURE. 194 | 195 | % ?DECREASES(?P(1)). 196 | 197 | 198 | find(L, K) -> 199 | find(L, K, 1). 200 | 201 | ?POST( 202 | fun() -> 203 | ?R < 0 204 | orelse 205 | (?R < length(?P(1)) andalso lists:nth(?R, ?P(1)) == ?P(2)) 206 | end). 207 | ?POST( 208 | fun() -> 209 | ?R > 0 210 | orelse 211 | lists:all(fun(K) -> K /= ?P(2) end, ?P(1)) 212 | end). 213 | 214 | % Actual find function. 215 | 216 | find([], _, _) -> 217 | -1; 218 | find([K | T], K, N) -> 219 | N; 220 | find([_ | T], K, N) -> 221 | find(T, K, N + 1). 222 | 223 | 224 | % method BinarySearch(a: array, key: int) returns (index: int) 225 | % requires a != null && sorted(a) 226 | % ensures ... 227 | % { 228 | % ... 229 | % } 230 | 231 | 232 | ?PRE( 233 | fun() -> 234 | length(?P(1)) > 0 235 | andalso 236 | lists:sort(?P(1)) == ?P(1) 237 | end). 238 | 239 | % https://gist.github.com/Janiczek/3133037 240 | 241 | binary_search(List, N) -> 242 | Length = length(List), 243 | Middle = (Length + 1) div 2, %% saves us hassle with odd/even indexes 244 | 245 | case Middle of 246 | 0 -> 247 | -1; %% empty list -> item not found 248 | _ -> 249 | 250 | Item = lists:nth(Middle, List), 251 | 252 | case Item of 253 | N -> 254 | Middle; %% yay, found it! 255 | _ -> 256 | case Item > N of 257 | true -> 258 | binary_search( 259 | lists:sublist(List, Length - Middle), N); %% LT, search on left side 260 | false -> 261 | binary_search( 262 | lists:nthtail(Middle, List), N) %% GT, search on right side 263 | end 264 | end 265 | end. 266 | 267 | 268 | ?POST( 269 | fun() -> 270 | ?R < 0 271 | orelse 272 | (?R < length(?P(1)) andalso lists:nth(?R, ?P(1)) == ?P(2)) 273 | end). 274 | ?POST( 275 | fun() -> 276 | ?R > 0 277 | orelse 278 | lists:all(fun(K) -> K /= ?P(2) end, ?P(1)) 279 | end). 280 | 281 | ?PRE( 282 | fun() -> 283 | case ?P(1) of 284 | {square, Side} when is_integer(Side) -> 285 | true; 286 | {circle, Radius} when is_number(Radius) -> 287 | true; 288 | {triangle, A, B, C} -> 289 | true; 290 | _ -> 291 | {false, "The figure is not valid."} 292 | end 293 | end). 294 | ?PURE. 295 | 296 | area({square, Side}) when is_integer(Side) -> 297 | Side * Side; 298 | area({circle, Radius}) when is_number(Radius) -> 299 | % io:format("Radius: ~p\n", [Radius]), 300 | 3.14 * Radius * Radius; %% well, almost 301 | area({triangle, A, B, C}) -> 302 | S = (A + B + C) / 2, 303 | math:sqrt(S * (S-A) * (S-B) * (S-C)). 304 | 305 | 306 | %% A higher order function which depends on its first argument. 307 | fold(_Fun, Acc, []) -> 308 | Acc; 309 | fold(Fun, Acc, [H|T]) -> 310 | fold(Fun, Fun(H, Acc), T). 311 | %% A pure closure is passed to a higher order function 312 | %% so function g1/0 will be determined pure by the analysis. 313 | ?PURE. 314 | g1() -> 315 | fold(fun erlang:'*'/2, 1, [2, 3, 7]). 316 | %% An impure closure is passed to a higher order function 317 | %% so function g2/0 is classified as impure. 318 | ?PURE. 319 | g2() -> 320 | fold(fun erlang:put/2, computer, [ok, error]). 321 | 322 | %% One level of indirection: it is not apparent this is a higher 323 | %% order function since no direct call to its argument is made. 324 | fold1(Fun, Acc, Lst) -> 325 | fold(Fun, Acc, Lst). 326 | %% Two levels of indirection. The function argument has also 327 | %% changed position. 328 | fold2(Lst, Fun) -> 329 | fold1(Fun, 1, Lst). 330 | 331 | ?PURE. 332 | g3() -> 333 | fold1(fun erlang:put/2, ok, [computer, error]). 334 | 335 | ?PURE. 336 | g4() -> 337 | fold2([2, 3, 7], fun erlang:'*'/2). 338 | 339 | % Sample of failing predicate 340 | % ?EXPECTED_TIME(fun() -> length(?P(1)) * 50 end). 341 | % Sample of correct predicate 342 | ?EXPECTED_TIME(fun() -> 20 + (length(?P(1)) * 100) end). 343 | % Sample of predicate timeouting 344 | ?TIMEOUT(fun() -> length(?P(1)) * 50 end). 345 | % Sample of predicate no timeouting 346 | % ?TIMEOUT(fun() -> 20 + (length(?P(1)) * 100) end). 347 | % -spec f_time(list(any())) -> list(any()). 348 | % -spec f_time(integer()) -> integer(). 349 | % Sample call 350 | % ej_paper:f_time(lists:seq(1,10)). 351 | f_time(L) -> 352 | [timer:sleep(100) || _ <- L]. 353 | 354 | 355 | % This constract is forgetting the odd tasks. 356 | % ?EXPECTED_TIME(fun() -> 20 + (length(?P(1)) * 100) end). 357 | % This constract is the good one. 358 | ?EXPECTED_TIME(fun() -> 20 + ((length(?P(1)) * 300) / 2) end). 359 | 360 | % ej_paper:f_time2(lists:seq(1, 10)). 361 | 362 | f_time2(L) -> 363 | [f_time2_run(E) || E <- L]. 364 | 365 | f_time2_run(N) when (N rem 2) == 0 -> 366 | timer:sleep(100); 367 | f_time2_run(N) when (N rem 2) /= 0 -> 368 | timer:sleep(200). 369 | 370 | % Quick sort 371 | % http://erlangexamples.com/tag/quicksort/ 372 | 373 | % ?EXPECTED_TIME(fun() -> length(?P(1)) * math:log2(length(?P(1))) * 10 end). 374 | ?EXPECTED_TIME(fun() -> length(?P(1)) * 10 end). 375 | % ?TIMEOUT(fun() -> (length(?P(1)) * 1) end). 376 | 377 | qsort(L) -> 378 | qsort_aux(L). 379 | 380 | qsort_aux([]) -> 381 | timer:sleep(5), 382 | []; 383 | qsort_aux([Pivot|T]) -> 384 | timer:sleep(5), 385 | qsort_aux([X || X <- T, begin timer:sleep(5), true end, X < Pivot]) 386 | ++ [Pivot] ++ 387 | qsort_aux([X || X <- T, begin timer:sleep(5), true end, X >= Pivot]). 388 | 389 | %% Quick Sort (tail recursive version) 390 | %% Think thru, you'll see it very easy to understand :p 391 | % http://erlangexamples.com/tag/quicksort/ 392 | 393 | 394 | % ?EXPECTED_TIME(fun() -> length(?P(1)) * length(?P(1)) * 0.0000075 end). 395 | ?EXPECTED_TIME(fun() -> length(?P(1)) * math:log2(length(?P(1))) * 0.0000075 end). 396 | 397 | qsort_tr(L) -> 398 | qsort_aux_tr(L). 399 | 400 | qsort_aux_tr([]) -> []; 401 | qsort_aux_tr([Single]) -> [Single]; 402 | qsort_aux_tr([Pivot|Rest]) -> 403 | {Smallers, Greaters} = qsort(Pivot, Rest), 404 | SortedSmallers = qsort_aux_tr(Smallers), 405 | SortedGreaters = qsort_aux_tr(Greaters), 406 | SortedSmallers ++ [Pivot] ++ SortedGreaters. 407 | 408 | qsort(Pivot, List) -> qsort(Pivot, [], [], List). 409 | 410 | qsort(_Pivot, Smallers, Greaters, []) -> {Smallers, Greaters}; 411 | qsort(Pivot, Smallers, Greaters, [First|Rest]) when First < Pivot -> 412 | qsort(Pivot, [First|Smallers], Greaters, Rest); 413 | qsort(Pivot, Smallers, Greaters, [First|Rest]) when First >= Pivot -> 414 | qsort(Pivot, Smallers, [First|Greaters], Rest). 415 | 416 | 417 | ?EXPECTED_TIME(fun() -> length(?P(1)) * 10 end). 418 | 419 | isort(L) -> 420 | lists:foldl(fun insert/2, [], L). 421 | 422 | insert(X,[]) -> 423 | timer:sleep(10), 424 | [X]; 425 | insert(X,L=[H|_]) when X =< H -> 426 | timer:sleep(10), 427 | [X|L]; 428 | insert(X,[H|T]) -> 429 | timer:sleep(10), 430 | [H|insert(X, T)]. 431 | 432 | -define(TIME, 10). 433 | 434 | ?EXPECTED_TIME(fun() -> 10 + length(?P(1)) * length(?P(1)) * (?TIME + 1) end). 435 | % ?EXPECTED_TIME(fun() -> length(?P(1)) * (?TIME + 1) end). 436 | 437 | % Sample call (Expected time 10 * 10 * ?TIME) 438 | % ej_paper:sum_lol([lists:seq(1,10) || _ <- lists:seq(1,10)]). 439 | 440 | sum_lol(L) -> 441 | lists:foldl( 442 | fun(EL, AccOut) -> 443 | lists:foldl( 444 | fun(E, AccIn) -> 445 | timer:sleep(?TIME), 446 | E + AccIn 447 | end, 448 | AccOut, 449 | EL) 450 | end, 451 | 0, 452 | L). 453 | 454 | 455 | ?EXPECTED_TIME(fun() -> length(?P(1)) * length(?P(1)) * (?TIME + 1) end). 456 | % ?EXPECTED_TIME(fun() -> length(?P(1)) * ?TIME end). 457 | 458 | % Sample call (Expected time 10 * 10 * ?TIME) 459 | % ej_paper:di(lists:seq(1,10)). 460 | 461 | di(L) -> 462 | lists:map( 463 | fun(_) -> 464 | lists:map( 465 | fun(_) -> 466 | timer:sleep(?TIME) 467 | end, 468 | L) 469 | end, 470 | L). 471 | 472 | 473 | 474 | 475 | -------------------------------------------------------------------------------- /examples/other/src/library.erl: -------------------------------------------------------------------------------- 1 | -module(library). 2 | -author('Jesse E.I. Farmer '). 3 | % The file includes some modifications. Please see the original file here: http://20bits.com/article/erlang-a-generic-server-tutorial 4 | -behaviour(gen_server). 5 | 6 | -include_lib("edbc.hrl"). 7 | 8 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). 9 | 10 | -export([start/0, checkout/2, lookup/1, return/1, stop/0]). 11 | 12 | % These are all wrappers for calls to the server 13 | start() -> gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). 14 | checkout(Who, Book) -> gen_server:call(?MODULE, {checkout, Who, Book}). 15 | lookup(Book) -> gen_server:call(?MODULE, {lookup, Book}). 16 | return(Book) -> gen_server:call(?MODULE, {return, Book}). 17 | stop() -> gen_server:stop(?MODULE). 18 | 19 | % This is called when a connection is made to the server 20 | init([]) -> 21 | Library = dict:new(), 22 | {ok, Library}. 23 | % {ok, []}. 24 | 25 | 26 | % handle_call is invoked in response to gen_server:call 27 | handle_call({checkout, Who, Book}, _From, Library) -> 28 | Response = case dict:is_key(Book, Library) of 29 | true -> 30 | NewLibrary = Library, 31 | {already_checked_out, Book}; 32 | false -> 33 | NewLibrary = dict:append(Book, Who, Library), 34 | ok 35 | end, 36 | {reply, Response, NewLibrary}; 37 | 38 | handle_call({lookup, Book}, _From, Library) -> 39 | Response = case dict:is_key(Book, Library) of 40 | true -> 41 | {who, lists:nth(1, dict:fetch(Book, Library))}; 42 | false -> 43 | {not_checked_out, Book} 44 | end, 45 | {reply, Response, Library}; 46 | % {reply, Response, []}; 47 | 48 | handle_call({return, Book}, _From, Library) -> 49 | NewLibrary = dict:erase(Book, Library), 50 | {reply, ok, NewLibrary}; 51 | 52 | handle_call(_Message, _From, Library) -> 53 | {reply, error, Library}. 54 | % ?POST(fun post_handle_call/0). 55 | 56 | % We get compile warnings from gen_server unless we define these 57 | handle_cast(_Message, Library) -> 58 | {noreply, Library}. 59 | handle_info(_Message, Library) -> 60 | {noreply, Library}. 61 | terminate(_Reason, _Library) -> 62 | ok. 63 | code_change(_OldVersion, Library, _Extra) -> 64 | {ok, Library}. 65 | 66 | 67 | % Added functions 68 | 69 | is_dict(DictCand) -> 70 | is_tuple(DictCand) andalso element(1, DictCand) =:= dict. 71 | 72 | % post_handle_call() -> 73 | % is_dict(element(3, ?R)). 74 | 75 | ?INVARIANT(fun invariant/1). 76 | 77 | invariant(State) -> 78 | is_dict(State). 79 | -------------------------------------------------------------------------------- /examples/other/src/library_test.erl: -------------------------------------------------------------------------------- 1 | -module(library_test). 2 | 3 | -export([test1/0]). 4 | 5 | test1() -> 6 | library:start(), 7 | library:checkout(a, l1), 8 | library:checkout(b, l2), 9 | library:checkout(a, l1), 10 | library:lookup(l1), 11 | library:lookup(l2), 12 | library:lookup(l3), 13 | library:return(l1), 14 | library:return(l2), 15 | library:return(l1), 16 | library:return(l3), 17 | library:stop(). -------------------------------------------------------------------------------- /examples/other/src/merge.erl: -------------------------------------------------------------------------------- 1 | -module(merge). 2 | -export([mergesort/2, comp/2]). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | % Calls to the declarative debugger: 7 | % > edd:dd("merge:mergesort([b,a], fun merge:comp/2)"). 8 | % > edd:dd("merge:mergesort([o,h,i,o], fun merge:comp/2)"). 9 | 10 | ?DECREASES(?P(1)). 11 | mergesort([], _Comp) -> []; 12 | mergesort([X], _Comp) -> [X]; 13 | mergesort(L, Comp) -> 14 | Half = length(L) div 2, 15 | L1 = take(Half, L), 16 | L2 = last(length(L) - Half, L), 17 | LOrd1 = mergesort(L1, Comp), 18 | LOrd2 = mergesort(L2, Comp), 19 | merge(LOrd1, LOrd2, Comp). 20 | 21 | merge([], [], _Comp) -> 22 | []; 23 | merge([], S2, _Comp) -> 24 | S2; 25 | merge(S1, [], _Comp) -> 26 | S1; 27 | merge([H1 | T1], [H2 | T2], Comp) -> 28 | case Comp(H1,H2) of 29 | false -> [H2 | merge([H1 | T1], T2, Comp)]; % Correct 30 | true -> [H1 | merge(T1, [H2 | T2], Comp)] 31 | end. 32 | 33 | 34 | comp(X,Y) when is_atom(X) and is_atom(Y) -> X < Y. 35 | 36 | 37 | take(0,_) -> []; 38 | take(1,[H|_])->[H]; 39 | take(_,[])->[]; 40 | take(N,[H|T])->[H | take(N-1, T)]. % Correct 41 | 42 | last(N, List) -> 43 | lists:reverse(take(N, lists:reverse(List))). 44 | -------------------------------------------------------------------------------- /examples/readers_writers/fair/src/readers_writers.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers). 2 | -behaviour(gen_server_cpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 7 | 8 | -export([start/0, request_read/0, finish_read/0, request_write/0, finish_write/0, stop/0]). 9 | 10 | -record(state, 11 | { 12 | readers = 0, 13 | writer = false, 14 | first_waiting = none, 15 | prev_state = none 16 | }). 17 | 18 | % These are all wrappers for calls to the server 19 | start() -> 20 | gen_server_cpre:start_link({local, ?MODULE}, ?MODULE, [], []). 21 | request_read() -> 22 | gen_server_cpre:call(?MODULE, request_read, infinity). 23 | finish_read() -> 24 | gen_server_cpre:cast(?MODULE, finish_read). 25 | request_write() -> 26 | gen_server_cpre:call(?MODULE, request_write, infinity). 27 | finish_write() -> 28 | gen_server_cpre:cast(?MODULE, finish_write). 29 | stop() -> 30 | gen_server_cpre:stop(?MODULE). 31 | 32 | ?INVARIANT(fun invariant/1). 33 | 34 | invariant( 35 | State = 36 | #state{ 37 | readers = Readers, 38 | writer = Writer, 39 | first_waiting = FirstWaiting, 40 | prev_state = PrevState} 41 | ) -> 42 | % io:format("State: ~p\n" ,[State]), 43 | is_integer(Readers) 44 | andalso 45 | Readers >= 0 46 | andalso 47 | is_boolean(Writer) 48 | andalso 49 | ((FirstWaiting == none) orelse is_tuple(FirstWaiting)) 50 | andalso 51 | case PrevState of 52 | #state{} -> 53 | true; 54 | none -> 55 | true; 56 | _ -> 57 | {false, "The state term is not the expected."} 58 | end 59 | andalso 60 | % Common invariant in readers-writers problem 61 | ((not Writer) orelse Readers == 0) 62 | . 63 | 64 | % This is called when a connection is made to the server 65 | init([]) -> 66 | {ok, #state{}}. 67 | 68 | cpre(request_read, _, State = #state{writer = false, first_waiting = none}) -> 69 | { 70 | true, 71 | State 72 | }; 73 | cpre(request_read, From, State = #state{writer = false, first_waiting = From}) -> 74 | { 75 | true, 76 | State 77 | }; 78 | cpre(request_read, From, State = #state{first_waiting = none}) -> 79 | { 80 | false, 81 | State#state{first_waiting = From} 82 | }; 83 | cpre(request_read, From, State) -> 84 | { 85 | false, 86 | State 87 | }; 88 | cpre(request_write, _, State = #state{writer = false, readers = 0, first_waiting = none}) -> 89 | { 90 | true, 91 | State 92 | }; 93 | cpre(request_write, From, State = #state{writer = false, readers = 0, first_waiting = From}) -> 94 | { 95 | true, 96 | State 97 | }; 98 | cpre(request_write, From, State = #state{first_waiting = none}) -> 99 | { 100 | false, 101 | State#state{first_waiting = From} 102 | }; 103 | cpre(request_write, From, State) -> 104 | { 105 | false, 106 | State 107 | }; 108 | cpre(_, _, State) -> 109 | { 110 | true, 111 | State 112 | }. 113 | 114 | 115 | % handle_call is invoked in response to gen_server:call 116 | handle_call(request_read, _, State) -> 117 | {Reply, NState} = 118 | { 119 | pass, 120 | State#state{ 121 | readers = State#state.readers + 1, 122 | first_waiting = none 123 | } 124 | }, 125 | {reply, Reply, update_prev_state(State, NState)}; 126 | handle_call(request_write, _, State) -> 127 | {Reply, NState} = 128 | { 129 | pass, 130 | State#state{ 131 | writer = true, 132 | first_waiting = none 133 | } 134 | }, 135 | {reply, Reply, update_prev_state(State, NState)}; 136 | handle_call(_Message, _From, State) -> 137 | % io:format("Error: ~p\n", [_Message]), 138 | {reply, error, State}. 139 | 140 | 141 | % We get compile warnings from gen_server unless we define these 142 | handle_cast(finish_read, State) -> 143 | NState = 144 | State#state{ 145 | readers = State#state.readers - 1 146 | }, 147 | {noreply, update_prev_state(State, NState)}; 148 | handle_cast(finish_write, State) -> 149 | NState = 150 | State#state{ 151 | writer = false 152 | }, 153 | {noreply, update_prev_state(State, NState)}. 154 | 155 | update_prev_state(State, NState) -> 156 | NState#state{ 157 | prev_state = State#state{prev_state = none} % To avoid create a useless big structure 158 | }. 159 | 160 | handle_info(_Message, Library) -> 161 | {noreply, Library}. 162 | terminate(_Reason, _Library) -> 163 | ok. 164 | code_change(_OldVersion, Library, _Extra) -> 165 | {ok, Library}. 166 | 167 | -------------------------------------------------------------------------------- /examples/readers_writers/fair/src/readers_writers_test.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | % compile:file(readers_writers, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | readers_writers:stop(), 11 | ok. 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | readers_writers:start(), 18 | Pids = create_readers_writers(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_readers_writers(N) -> 29 | PidsN = 30 | create_readers_writers(lists:seq(1, N div 2), r), 31 | PidsS = 32 | create_readers_writers(lists:seq((N div 2) + 1, N), w), 33 | rearrange_list(PidsN ++ PidsS). 34 | 35 | rearrange_list(L) -> 36 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 37 | 38 | create_readers_writers(Ids, Type) -> 39 | Self = self(), 40 | lists:map( 41 | fun(Id) -> 42 | spawn( 43 | fun() -> 44 | case Type of 45 | r -> 46 | reader(Id, Self); 47 | w -> 48 | writer(Id, Self) 49 | end 50 | end) 51 | end, 52 | Ids). 53 | 54 | reader(Id, Self) -> 55 | receive 56 | start -> 57 | timer:sleep(100), 58 | reader_loop(Id, Self) 59 | end. 60 | 61 | reader_loop(Id, Self) -> 62 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 63 | pass = 64 | readers_writers:request_read(), 65 | timer:sleep(100), 66 | readers_writers:finish_read(), 67 | io:format("Reader ~p finished reading\n", [Id]), 68 | Self!finished. 69 | 70 | writer(Id, Self) -> 71 | receive 72 | start -> 73 | timer:sleep(100), 74 | writer_loop(Id, Self) 75 | end. 76 | 77 | writer_loop(Id, Self) -> 78 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 79 | pass = 80 | readers_writers:request_write(), 81 | timer:sleep(100), 82 | readers_writers:finish_write(), 83 | io:format("Writer ~p finished writing\n", [Id]), 84 | Self!finished. 85 | 86 | -------------------------------------------------------------------------------- /examples/readers_writers/fair_queues/src/readers_writers.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers). 2 | -behaviour(gen_server_qcpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 7 | 8 | -export([start/0, request_read/0, finish_read/0, request_write/0, finish_write/0, stop/0]). 9 | 10 | -record(state, 11 | { 12 | readers = 0, 13 | writer = false, 14 | first_waiting = none, 15 | prev_state = none 16 | }). 17 | 18 | % These are all wrappers for calls to the server 19 | start() -> 20 | gen_server_qcpre:start_link({local, ?MODULE}, ?MODULE, [], []). 21 | request_read() -> 22 | gen_server_qcpre:call(?MODULE, request_read, infinity). 23 | finish_read() -> 24 | gen_server_qcpre:cast(?MODULE, finish_read). 25 | request_write() -> 26 | gen_server_qcpre:call(?MODULE, request_write, infinity). 27 | finish_write() -> 28 | gen_server_qcpre:cast(?MODULE, finish_write). 29 | stop() -> 30 | gen_server_qcpre:stop(?MODULE). 31 | 32 | ?INVARIANT(fun invariant/1). 33 | 34 | invariant( 35 | State = 36 | #state{ 37 | readers = Readers, 38 | writer = Writer 39 | } 40 | ) -> 41 | % io:format("State: ~p\n" ,[State]), 42 | is_integer(Readers) 43 | andalso 44 | Readers >= 0 45 | andalso 46 | is_boolean(Writer) 47 | andalso 48 | % Common invariant in readers-writers problem 49 | ((not Writer) orelse Readers == 0) 50 | . 51 | 52 | % This is called when a connection is made to the server 53 | init([]) -> 54 | {ok, #state{}}. 55 | 56 | cpre(request_read, _, State = #state{writer = false, first_waiting = none}) -> 57 | { 58 | true, 59 | State 60 | }; 61 | cpre(request_read, From, State = #state{writer = false, first_waiting = From}) -> 62 | { 63 | true, 64 | State 65 | }; 66 | cpre(request_read, From, State = #state{first_waiting = none}) -> 67 | { 68 | false, 69 | State#state{first_waiting = From} 70 | }; 71 | cpre(request_read, From, State) -> 72 | { 73 | false, 74 | State 75 | }; 76 | cpre(request_write, _, State = #state{writer = false, readers = 0, first_waiting = none}) -> 77 | { 78 | true, 79 | State 80 | }; 81 | cpre(request_write, From, State = #state{writer = false, readers = 0, first_waiting = From}) -> 82 | { 83 | true, 84 | State 85 | }; 86 | cpre(request_write, From, State = #state{first_waiting = none}) -> 87 | { 88 | false, 89 | State#state{first_waiting = From} 90 | }; 91 | cpre(request_write, From, State) -> 92 | { 93 | false, 94 | State 95 | }; 96 | cpre(_, _, State) -> 97 | { 98 | true, 99 | State 100 | }. 101 | 102 | 103 | % handle_call is invoked in response to gen_server:call 104 | handle_call(request_read, _, State) -> 105 | {Reply, NState} = 106 | { 107 | pass, 108 | State#state{ 109 | readers = State#state.readers + 1, 110 | first_waiting = none 111 | } 112 | }, 113 | {reply, Reply, update_prev_state(State, NState)}; 114 | handle_call(request_write, _, State) -> 115 | {Reply, NState} = 116 | { 117 | pass, 118 | State#state{ 119 | writer = true, 120 | first_waiting = none 121 | } 122 | }, 123 | {reply, Reply, update_prev_state(State, NState)}; 124 | handle_call(_Message, _From, State) -> 125 | % io:format("Error: ~p\n", [_Message]), 126 | {reply, error, State}. 127 | 128 | 129 | % We get compile warnings from gen_server unless we define these 130 | handle_cast(finish_read, State) -> 131 | NState = 132 | State#state{ 133 | readers = State#state.readers - 1 134 | }, 135 | {noreply, update_prev_state(State, NState)}; 136 | handle_cast(finish_write, State) -> 137 | NState = 138 | State#state{ 139 | writer = false 140 | }, 141 | {noreply, update_prev_state(State, NState)}. 142 | 143 | update_prev_state(State, NState) -> 144 | NState#state{ 145 | prev_state = State#state{prev_state = none} % To avoid create a useless big structure 146 | }. 147 | 148 | handle_info(_Message, Library) -> 149 | {noreply, Library}. 150 | terminate(_Reason, _Library) -> 151 | ok. 152 | code_change(_OldVersion, Library, _Extra) -> 153 | {ok, Library}. 154 | 155 | -------------------------------------------------------------------------------- /examples/readers_writers/fair_queues/src/readers_writers_test.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | % compile:file(readers_writers, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | readers_writers:stop(), 11 | ok. 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | readers_writers:start(), 18 | Pids = create_readers_writers(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_readers_writers(N) -> 29 | PidsN = 30 | create_readers_writers(lists:seq(1, N div 2), r), 31 | PidsS = 32 | create_readers_writers(lists:seq((N div 2) + 1, N), w), 33 | rearrange_list(PidsN ++ PidsS). 34 | 35 | rearrange_list(L) -> 36 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 37 | 38 | create_readers_writers(Ids, Type) -> 39 | Self = self(), 40 | lists:map( 41 | fun(Id) -> 42 | spawn( 43 | fun() -> 44 | case Type of 45 | r -> 46 | reader(Id, Self); 47 | w -> 48 | writer(Id, Self) 49 | end 50 | end) 51 | end, 52 | Ids). 53 | 54 | reader(Id, Self) -> 55 | receive 56 | start -> 57 | timer:sleep(100), 58 | reader_loop(Id, Self) 59 | end. 60 | 61 | reader_loop(Id, Self) -> 62 | % io:format("Reader ~p from ~p\n", [Id, Self]), 63 | pass = 64 | readers_writers:request_read(), 65 | timer:sleep(100), 66 | readers_writers:finish_read(), 67 | io:format("Reader ~p finished reading\n", [Id]), 68 | Self!finished. 69 | 70 | writer(Id, Self) -> 71 | receive 72 | start -> 73 | timer:sleep(100), 74 | writer_loop(Id, Self) 75 | end. 76 | 77 | writer_loop(Id, Self) -> 78 | % io:format("Writer ~p from ~p\n", [Id, Self]), 79 | pass = 80 | readers_writers:request_write(), 81 | timer:sleep(100), 82 | readers_writers:finish_write(), 83 | io:format("Writer ~p finished writing\n", [Id]), 84 | Self!finished. 85 | 86 | -------------------------------------------------------------------------------- /examples/readers_writers/unfair4readers/src/readers_writers.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers). 2 | -behaviour(gen_server_cpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 7 | 8 | -export([start/0, request_read/0, finish_read/0, request_write/0, finish_write/0, stop/0]). 9 | 10 | -record(state, 11 | { 12 | readers = 0, 13 | writer = false, 14 | writer_waiting = false, 15 | prev_state = none 16 | }). 17 | 18 | % These are all wrappers for calls to the server 19 | start() -> 20 | gen_server_cpre:start_link({local, ?MODULE}, ?MODULE, [], []). 21 | request_read() -> 22 | gen_server_cpre:call(?MODULE, request_read, infinity). 23 | finish_read() -> 24 | gen_server_cpre:cast(?MODULE, finish_read). 25 | request_write() -> 26 | gen_server_cpre:call(?MODULE, request_write, infinity). 27 | finish_write() -> 28 | gen_server_cpre:cast(?MODULE, finish_write). 29 | stop() -> 30 | gen_server_cpre:stop(?MODULE). 31 | 32 | ?INVARIANT(fun invariant/1). 33 | 34 | invariant( 35 | State = 36 | #state{ 37 | readers = Readers, 38 | writer = Writer, 39 | writer_waiting = WriterWaiting, 40 | prev_state = PrevState} 41 | ) -> 42 | % io:format("State: ~p\n" ,[State]), 43 | is_integer(Readers) 44 | andalso 45 | Readers >= 0 46 | andalso 47 | is_boolean(Writer) 48 | andalso 49 | is_boolean(WriterWaiting) 50 | andalso 51 | case PrevState of 52 | #state{} -> 53 | true; 54 | none -> 55 | true; 56 | _ -> 57 | {false, "The state term is not the expected."} 58 | end 59 | andalso 60 | % Common invariant in readers-writers problem 61 | ((not Writer) orelse Readers == 0) 62 | andalso 63 | case ((PrevState /= none) andalso (Readers > PrevState#state.readers)) of 64 | true -> 65 | case PrevState#state.writer_waiting of 66 | true -> 67 | {false, "A reader has entered while a writer was waiting"}; 68 | false -> 69 | true 70 | end; 71 | false -> 72 | true 73 | end 74 | . 75 | 76 | % This is called when a connection is made to the server 77 | init([]) -> 78 | {ok, #state{}}. 79 | 80 | cpre(request_read, _, State = #state{writer = false, writer_waiting = false}) -> 81 | { 82 | true, 83 | State 84 | }; 85 | cpre(request_read, _, State) -> 86 | { 87 | false, 88 | State 89 | }; 90 | cpre(request_write, _, State = #state{writer = false, readers = 0}) -> 91 | { 92 | true, 93 | State 94 | }; 95 | cpre(request_write, _, State) -> 96 | { 97 | false, 98 | State#state{writer_waiting = true} 99 | }; 100 | cpre(_, _, State) -> 101 | { 102 | true, 103 | State 104 | }. 105 | 106 | 107 | % handle_call is invoked in response to gen_server:call 108 | handle_call(request_read, _, State) -> 109 | {Reply, NState} = 110 | { 111 | pass, 112 | State#state{ 113 | readers = State#state.readers + 1 114 | } 115 | }, 116 | {reply, Reply, update_prev_state(State, NState)}; 117 | handle_call(request_write, _, State) -> 118 | {Reply, NState} = 119 | { 120 | pass, 121 | State#state{ 122 | writer = true, 123 | writer_waiting = false % This would remove the wating information for the rest of writers which were waiting. However, this information will be available again when the writting requests call CPRE again. 124 | } 125 | }, 126 | {reply, Reply, update_prev_state(State, NState)}; 127 | handle_call(_Message, _From, State) -> 128 | % io:format("Error: ~p\n", [_Message]), 129 | {reply, error, State}. 130 | 131 | 132 | % We get compile warnings from gen_server unless we define these 133 | handle_cast(finish_read, State) -> 134 | NState = 135 | State#state{ 136 | readers = State#state.readers - 1 137 | }, 138 | {noreply, update_prev_state(State, NState)}; 139 | handle_cast(finish_write, State) -> 140 | NState = 141 | State#state{ 142 | writer = false 143 | }, 144 | {noreply, update_prev_state(State, NState)}. 145 | 146 | update_prev_state(State, NState) -> 147 | NState#state{ 148 | prev_state = State#state{prev_state = none} % To avoid create a useless big structure 149 | }. 150 | 151 | handle_info(_Message, Library) -> 152 | {noreply, Library}. 153 | terminate(_Reason, _Library) -> 154 | ok. 155 | code_change(_OldVersion, Library, _Extra) -> 156 | {ok, Library}. 157 | 158 | -------------------------------------------------------------------------------- /examples/readers_writers/unfair4readers/src/readers_writers_test.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | % compile:file(readers_writers, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | readers_writers:stop(), 11 | ok. 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | readers_writers:start(), 18 | Pids = create_readers_writers(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_readers_writers(N) -> 29 | PidsN = 30 | create_readers_writers(lists:seq(1, N div 2), r), 31 | PidsS = 32 | create_readers_writers(lists:seq((N div 2) + 1, N), w), 33 | rearrange_list(PidsN ++ PidsS). 34 | 35 | rearrange_list(L) -> 36 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 37 | 38 | create_readers_writers(Ids, Type) -> 39 | Self = self(), 40 | lists:map( 41 | fun(Id) -> 42 | spawn( 43 | fun() -> 44 | case Type of 45 | r -> 46 | reader(Id, Self); 47 | w -> 48 | writer(Id, Self) 49 | end 50 | end) 51 | end, 52 | Ids). 53 | 54 | reader(Id, Self) -> 55 | receive 56 | start -> 57 | timer:sleep(100), 58 | reader_loop(Id, Self) 59 | end. 60 | 61 | reader_loop(Id, Self) -> 62 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 63 | pass = 64 | readers_writers:request_read(), 65 | timer:sleep(100), 66 | readers_writers:finish_read(), 67 | io:format("Reader ~p finished reading\n", [Id]), 68 | Self!finished. 69 | 70 | writer(Id, Self) -> 71 | receive 72 | start -> 73 | timer:sleep(100), 74 | writer_loop(Id, Self) 75 | end. 76 | 77 | writer_loop(Id, Self) -> 78 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 79 | pass = 80 | readers_writers:request_write(), 81 | timer:sleep(100), 82 | readers_writers:finish_write(), 83 | io:format("Writer ~p finished writing\n", [Id]), 84 | Self!finished. 85 | 86 | -------------------------------------------------------------------------------- /examples/readers_writers/unfair4readers_queues/src/readers_writers.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers). 2 | -behaviour(gen_server_qcpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 7 | 8 | -export([start/0, request_read/0, finish_read/0, request_write/0, finish_write/0, stop/0]). 9 | 10 | -record(state, 11 | { 12 | readers = 0, 13 | writer = false, 14 | writer_waiting = false, 15 | prev_state = none 16 | }). 17 | 18 | % These are all wrappers for calls to the server 19 | start() -> 20 | gen_server_qcpre:start_link({local, ?MODULE}, ?MODULE, [], []). 21 | request_read() -> 22 | gen_server_qcpre:call(?MODULE, request_read, infinity). 23 | finish_read() -> 24 | gen_server_qcpre:cast(?MODULE, finish_read). 25 | request_write() -> 26 | gen_server_qcpre:call(?MODULE, request_write, infinity). 27 | finish_write() -> 28 | gen_server_qcpre:cast(?MODULE, finish_write). 29 | stop() -> 30 | gen_server_qcpre:stop(?MODULE). 31 | 32 | ?INVARIANT(fun invariant/1). 33 | 34 | invariant( 35 | State = 36 | #state{ 37 | readers = Readers, 38 | writer = Writer, 39 | writer_waiting = WriterWaiting, 40 | prev_state = PrevState} 41 | ) -> 42 | % io:format("State: ~p\n" ,[State]), 43 | is_integer(Readers) 44 | andalso 45 | Readers >= 0 46 | andalso 47 | is_boolean(Writer) 48 | andalso 49 | is_boolean(WriterWaiting) 50 | andalso 51 | case PrevState of 52 | #state{} -> 53 | true; 54 | none -> 55 | true; 56 | _ -> 57 | {false, "The state term is not the expected."} 58 | end 59 | andalso 60 | % Common invariant in readers-writers problem 61 | ((not Writer) orelse Readers == 0) 62 | andalso 63 | case ((PrevState /= none) andalso (Readers > PrevState#state.readers)) of 64 | true -> 65 | case PrevState#state.writer_waiting of 66 | true -> 67 | {false, "A reader has entered while a writer was waiting"}; 68 | false -> 69 | true 70 | end; 71 | false -> 72 | true 73 | end 74 | . 75 | 76 | % This is called when a connection is made to the server 77 | init([]) -> 78 | {ok, #state{}}. 79 | 80 | cpre(request_read, _, State = #state{writer = false, writer_waiting = false}) -> 81 | { 82 | true, 83 | State 84 | }; 85 | cpre(request_read, _, State) -> 86 | { 87 | false, 88 | State 89 | }; 90 | cpre(request_write, _, State = #state{writer = false, readers = 0}) -> 91 | { 92 | true, 93 | State 94 | }; 95 | cpre(request_write, _, State) -> 96 | { 97 | false, 98 | State#state{writer_waiting = true} 99 | }; 100 | cpre(_, _, State) -> 101 | { 102 | true, 103 | State 104 | }. 105 | 106 | 107 | % handle_call is invoked in response to gen_server:call 108 | handle_call(request_read, _, State) -> 109 | {Reply, NState} = 110 | { 111 | pass, 112 | State#state{ 113 | readers = State#state.readers + 1 114 | } 115 | }, 116 | {reply, Reply, update_prev_state(State, NState)}; 117 | handle_call(request_write, _, State) -> 118 | {Reply, NState} = 119 | { 120 | pass, 121 | State#state{ 122 | writer = true, 123 | writer_waiting = false % This would remove the wating information for the rest of writers which were waiting. However, this information will be available again when the writting requests call CPRE again. 124 | } 125 | }, 126 | {reply, Reply, update_prev_state(State, NState)}; 127 | handle_call(_Message, _From, State) -> 128 | % io:format("Error: ~p\n", [_Message]), 129 | {reply, error, State}. 130 | 131 | 132 | % We get compile warnings from gen_server unless we define these 133 | handle_cast(finish_read, State) -> 134 | NState = 135 | State#state{ 136 | readers = State#state.readers - 1 137 | }, 138 | {noreply, update_prev_state(State, NState)}; 139 | handle_cast(finish_write, State) -> 140 | NState = 141 | State#state{ 142 | writer = false 143 | }, 144 | {noreply, update_prev_state(State, NState)}. 145 | 146 | update_prev_state(State, NState) -> 147 | NState#state{ 148 | prev_state = State#state{prev_state = none} % To avoid create a useless big structure 149 | }. 150 | 151 | handle_info(_Message, Library) -> 152 | {noreply, Library}. 153 | terminate(_Reason, _Library) -> 154 | ok. 155 | code_change(_OldVersion, Library, _Extra) -> 156 | {ok, Library}. 157 | 158 | -------------------------------------------------------------------------------- /examples/readers_writers/unfair4readers_queues/src/readers_writers_test.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | % compile:file(readers_writers, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | readers_writers:stop(), 11 | ok. 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | readers_writers:start(), 18 | Pids = create_readers_writers(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_readers_writers(N) -> 29 | PidsN = 30 | create_readers_writers(lists:seq(1, N div 2), r), 31 | PidsS = 32 | create_readers_writers(lists:seq((N div 2) + 1, N), w), 33 | rearrange_list(PidsN ++ PidsS). 34 | 35 | rearrange_list(L) -> 36 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 37 | 38 | create_readers_writers(Ids, Type) -> 39 | Self = self(), 40 | lists:map( 41 | fun(Id) -> 42 | spawn( 43 | fun() -> 44 | case Type of 45 | r -> 46 | reader(Id, Self); 47 | w -> 48 | writer(Id, Self) 49 | end 50 | end) 51 | end, 52 | Ids). 53 | 54 | reader(Id, Self) -> 55 | receive 56 | start -> 57 | timer:sleep(100), 58 | reader_loop(Id, Self) 59 | end. 60 | 61 | reader_loop(Id, Self) -> 62 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 63 | pass = 64 | readers_writers:request_read(), 65 | timer:sleep(100), 66 | readers_writers:finish_read(), 67 | io:format("Reader ~p finished reading\n", [Id]), 68 | Self!finished. 69 | 70 | writer(Id, Self) -> 71 | receive 72 | start -> 73 | timer:sleep(100), 74 | writer_loop(Id, Self) 75 | end. 76 | 77 | writer_loop(Id, Self) -> 78 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 79 | pass = 80 | readers_writers:request_write(), 81 | timer:sleep(100), 82 | readers_writers:finish_write(), 83 | io:format("Writer ~p finished writing\n", [Id]), 84 | Self!finished. 85 | 86 | -------------------------------------------------------------------------------- /examples/readers_writers/unfair4writers/src/readers_writers.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers). 2 | -behaviour(gen_server_cpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 7 | 8 | -export([start/0, request_read/0, finish_read/0, request_write/0, finish_write/0, stop/0]). 9 | 10 | -record(state, 11 | { 12 | readers = 0, 13 | writer = false 14 | }). 15 | 16 | % These are all wrappers for calls to the server 17 | start() -> 18 | gen_server_cpre:start_link({local, ?MODULE}, ?MODULE, [], []). 19 | request_read() -> 20 | gen_server_cpre:call(?MODULE, request_read, infinity). 21 | finish_read() -> 22 | gen_server_cpre:cast(?MODULE, finish_read). 23 | request_write() -> 24 | gen_server_cpre:call(?MODULE, request_write, infinity). 25 | finish_write() -> 26 | gen_server_cpre:cast(?MODULE, finish_write). 27 | stop() -> 28 | gen_server_cpre:stop(?MODULE). 29 | 30 | ?INVARIANT(fun invariant/1). 31 | 32 | invariant( 33 | State = 34 | #state{ 35 | readers = Readers, 36 | writer = Writer 37 | } 38 | ) -> 39 | % io:format("State: ~p\n" ,[State]), 40 | is_integer(Readers) 41 | andalso 42 | Readers >= 0 43 | % Readers < 0 44 | andalso 45 | is_boolean(Writer) 46 | andalso 47 | % Common invariant in readers-writers problem 48 | ((not Writer) orelse Readers == 0) 49 | . 50 | 51 | % This is called when a connection is made to the server 52 | init([]) -> 53 | {ok, #state{}}. 54 | 55 | cpre(request_read, _, State = #state{writer = false}) -> 56 | { 57 | true, 58 | State 59 | }; 60 | cpre(request_read, _, State) -> 61 | { 62 | false, 63 | State 64 | }; 65 | cpre(request_write, _, State = #state{writer = false, readers = 0}) -> 66 | { 67 | true, 68 | State 69 | }; 70 | cpre(request_write, _, State) -> 71 | { 72 | false, 73 | State 74 | }; 75 | cpre(_, _, State) -> 76 | { 77 | true, 78 | State 79 | }. 80 | 81 | 82 | % handle_call is invoked in response to gen_server:call 83 | handle_call(request_read, _, State) -> 84 | {Reply, NState} = 85 | { 86 | pass, 87 | State#state{ 88 | readers = State#state.readers + 1 89 | } 90 | }, 91 | {reply, Reply, NState}; 92 | handle_call(request_write, _, State) -> 93 | {Reply, NState} = 94 | { 95 | pass, 96 | State#state{ 97 | writer = true 98 | } 99 | }, 100 | {reply, Reply, NState}; 101 | handle_call(_Message, _From, State) -> 102 | % io:format("Error: ~p\n", [_Message]), 103 | {reply, error, State}. 104 | 105 | 106 | % We get compile warnings from gen_server unless we define these 107 | handle_cast(finish_read, State) -> 108 | NState = 109 | State#state{ 110 | readers = State#state.readers - 1 111 | }, 112 | {noreply, NState}; 113 | handle_cast(finish_write, State) -> 114 | NState = 115 | State#state{ 116 | writer = false 117 | }, 118 | {noreply, NState}. 119 | 120 | handle_info(_Message, Library) -> 121 | {noreply, Library}. 122 | terminate(_Reason, _Library) -> 123 | ok. 124 | code_change(_OldVersion, Library, _Extra) -> 125 | {ok, Library}. 126 | 127 | -------------------------------------------------------------------------------- /examples/readers_writers/unfair4writers/src/readers_writers_test.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | % compile:file(readers_writers, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | readers_writers:stop(), 11 | ok. 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | readers_writers:start(), 18 | Pids = create_readers_writers(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_readers_writers(N) -> 29 | PidsN = 30 | create_readers_writers(lists:seq(1, N div 2), r), 31 | PidsS = 32 | create_readers_writers(lists:seq((N div 2) + 1, N), w), 33 | rearrange_list(PidsN ++ PidsS). 34 | 35 | rearrange_list(L) -> 36 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 37 | 38 | create_readers_writers(Ids, Type) -> 39 | Self = self(), 40 | lists:map( 41 | fun(Id) -> 42 | spawn( 43 | fun() -> 44 | case Type of 45 | r -> 46 | reader(Id, Self); 47 | w -> 48 | writer(Id, Self) 49 | end 50 | end) 51 | end, 52 | Ids). 53 | 54 | reader(Id, Self) -> 55 | receive 56 | start -> 57 | timer:sleep(100), 58 | reader_loop(Id, Self) 59 | end. 60 | 61 | reader_loop(Id, Self) -> 62 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 63 | pass = 64 | readers_writers:request_read(), 65 | timer:sleep(100), 66 | readers_writers:finish_read(), 67 | io:format("Reader ~p finished reading\n", [Id]), 68 | Self!finished. 69 | 70 | writer(Id, Self) -> 71 | receive 72 | start -> 73 | timer:sleep(100), 74 | writer_loop(Id, Self) 75 | end. 76 | 77 | writer_loop(Id, Self) -> 78 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 79 | pass = 80 | readers_writers:request_write(), 81 | timer:sleep(100), 82 | readers_writers:finish_write(), 83 | io:format("Writer ~p finished writing\n", [Id]), 84 | Self!finished. 85 | 86 | -------------------------------------------------------------------------------- /examples/readers_writers/unfair4writers_queues/src/readers_writers.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers). 2 | -behaviour(gen_server_qcpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 7 | 8 | -export([start/0, request_read/0, finish_read/0, request_write/0, finish_write/0, stop/0]). 9 | 10 | -record(state, 11 | { 12 | readers = 0, 13 | writer = false 14 | }). 15 | 16 | % These are all wrappers for calls to the server 17 | start() -> 18 | gen_server_qcpre:start_link({local, ?MODULE}, ?MODULE, [], []). 19 | request_read() -> 20 | gen_server_qcpre:call(?MODULE, request_read, infinity). 21 | finish_read() -> 22 | gen_server_qcpre:cast(?MODULE, finish_read). 23 | request_write() -> 24 | gen_server_qcpre:call(?MODULE, request_write, infinity). 25 | finish_write() -> 26 | gen_server_qcpre:cast(?MODULE, finish_write). 27 | stop() -> 28 | gen_server_qcpre:stop(?MODULE). 29 | 30 | ?INVARIANT(fun invariant/1). 31 | 32 | invariant( 33 | State = 34 | #state{ 35 | readers = Readers, 36 | writer = Writer 37 | } 38 | ) -> 39 | % io:format("State: ~p\n" ,[State]), 40 | is_integer(Readers) 41 | andalso 42 | Readers >= 0 43 | % Readers < 0 44 | andalso 45 | is_boolean(Writer) 46 | andalso 47 | % Common invariant in readers-writers problem 48 | ((not Writer) orelse Readers == 0) 49 | . 50 | 51 | % This is called when a connection is made to the server 52 | init([]) -> 53 | {ok, #state{}}. 54 | 55 | cpre(request_read, _, State = #state{writer = false}) -> 56 | { 57 | true, 58 | State 59 | }; 60 | cpre(request_read, _, State) -> 61 | { 62 | false, 63 | State 64 | }; 65 | cpre(request_write, _, State = #state{writer = false, readers = 0}) -> 66 | { 67 | true, 68 | State 69 | }; 70 | cpre(request_write, _, State) -> 71 | { 72 | false, 73 | State 74 | }; 75 | cpre(_, _, State) -> 76 | { 77 | true, 78 | State 79 | }. 80 | 81 | 82 | % handle_call is invoked in response to gen_server:call 83 | handle_call(request_read, _, State) -> 84 | {Reply, NState} = 85 | { 86 | pass, 87 | State#state{ 88 | readers = State#state.readers + 1 89 | } 90 | }, 91 | {reply, Reply, NState}; 92 | handle_call(request_write, _, State) -> 93 | {Reply, NState} = 94 | { 95 | pass, 96 | State#state{ 97 | writer = true 98 | } 99 | }, 100 | {reply, Reply, NState}; 101 | handle_call(_Message, _From, State) -> 102 | % io:format("Error: ~p\n", [_Message]), 103 | {reply, error, State}. 104 | 105 | 106 | % We get compile warnings from gen_server unless we define these 107 | handle_cast(finish_read, State) -> 108 | NState = 109 | State#state{ 110 | readers = State#state.readers - 1 111 | }, 112 | {noreply, NState}; 113 | handle_cast(finish_write, State) -> 114 | NState = 115 | State#state{ 116 | writer = false 117 | }, 118 | {noreply, NState}. 119 | 120 | handle_info(_Message, Library) -> 121 | {noreply, Library}. 122 | terminate(_Reason, _Library) -> 123 | ok. 124 | code_change(_OldVersion, Library, _Extra) -> 125 | {ok, Library}. 126 | 127 | -------------------------------------------------------------------------------- /examples/readers_writers/unfair4writers_queues/src/readers_writers_test.erl: -------------------------------------------------------------------------------- 1 | -module(readers_writers_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | % OutputCompile = 7 | % compile:file(readers_writers, [{d,edbc}]), 8 | % io:format("OutputCompile: ~p\n", [OutputCompile]), 9 | start(), 10 | readers_writers:stop(), 11 | ok. 12 | 13 | 14 | start() -> 15 | Total = 16 | 100, 17 | readers_writers:start(), 18 | Pids = create_readers_writers(Total), 19 | [Pid!start || Pid <- Pids], 20 | [ 21 | receive 22 | finished -> 23 | ok 24 | end 25 | || _ <- Pids]. 26 | 27 | 28 | create_readers_writers(N) -> 29 | PidsN = 30 | create_readers_writers(lists:seq(1, N div 2), r), 31 | PidsS = 32 | create_readers_writers(lists:seq((N div 2) + 1, N), w), 33 | rearrange_list(PidsN ++ PidsS). 34 | 35 | rearrange_list(L) -> 36 | [X || {_,X} <- lists:sort([ {rand:uniform(), N} || N <- L])]. 37 | 38 | create_readers_writers(Ids, Type) -> 39 | Self = self(), 40 | lists:map( 41 | fun(Id) -> 42 | spawn( 43 | fun() -> 44 | case Type of 45 | r -> 46 | reader(Id, Self); 47 | w -> 48 | writer(Id, Self) 49 | end 50 | end) 51 | end, 52 | Ids). 53 | 54 | reader(Id, Self) -> 55 | receive 56 | start -> 57 | timer:sleep(100), 58 | reader_loop(Id, Self) 59 | end. 60 | 61 | reader_loop(Id, Self) -> 62 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 63 | pass = 64 | readers_writers:request_read(), 65 | timer:sleep(100), 66 | readers_writers:finish_read(), 67 | io:format("Reader ~p finished reading\n", [Id]), 68 | Self!finished. 69 | 70 | writer(Id, Self) -> 71 | receive 72 | start -> 73 | timer:sleep(100), 74 | writer_loop(Id, Self) 75 | end. 76 | 77 | writer_loop(Id, Self) -> 78 | % io:format("Car ~p entering from ~p\n", [Id, EntryPoint]), 79 | pass = 80 | readers_writers:request_write(), 81 | timer:sleep(100), 82 | readers_writers:finish_write(), 83 | io:format("Writer ~p finished writing\n", [Id]), 84 | Self!finished. 85 | 86 | -------------------------------------------------------------------------------- /examples/sel_recv/gen_server/src/sel_recv.erl: -------------------------------------------------------------------------------- 1 | -module(sel_recv). 2 | -behaviour(gen_server). 3 | 4 | -export([start_link/0, stop/0]). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, 7 | terminate/2, code_change/3]). 8 | 9 | -export([test/0]). 10 | 11 | start_link() -> 12 | gen_server:start_link({global, ?MODULE}, ?MODULE, [], []). 13 | 14 | stop() -> 15 | gen_server:stop({global, ?MODULE}). 16 | 17 | test() -> 18 | gen_server:cast({global, ?MODULE}, test). 19 | 20 | init([]) -> 21 | {ok, 0}. 22 | 23 | handle_call(_Request, _From, State) -> 24 | Reply = ok, 25 | {reply, Reply, State}. 26 | 27 | handle_cast(test, _State) -> 28 | io:format("Building test...\n"), 29 | List = 30 | [1,2,3,4,5,6,7,8,9], 31 | lists:map(fun(N) -> 32 | gen_server:cast({global, ?MODULE}, {result, N}) 33 | end, lists:reverse(List)), 34 | % end, List), 35 | {noreply, List}; 36 | handle_cast({result, N}, [N|R]) -> 37 | io:format("result: " ++ integer_to_list(N) ++ "~n"), 38 | {noreply, R}. 39 | 40 | handle_info(_Info, State) -> 41 | {noreply, State}. 42 | 43 | terminate(_Reason, _State) -> 44 | ok. 45 | 46 | code_change(_OldVsn, State, _Extra) -> 47 | {ok, State}. -------------------------------------------------------------------------------- /examples/sel_recv/gen_server/src/sel_recv_test.erl: -------------------------------------------------------------------------------- 1 | -module(sel_recv_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | sel_recv:start_link(), 7 | sel_recv:test(), 8 | sel_recv:stop(), 9 | ok. 10 | 11 | -------------------------------------------------------------------------------- /examples/sel_recv/gen_server_qcpre/src/sel_recv.erl: -------------------------------------------------------------------------------- 1 | -module(sel_recv). 2 | -behaviour(gen_server_cpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([start_link/0, stop/0]). 7 | 8 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, 9 | cpre/3, 10 | terminate/2, code_change/3]). 11 | 12 | -export([test/0]). 13 | 14 | start_link() -> 15 | gen_server_cpre:start_link({local, ?MODULE}, ?MODULE, [], []). 16 | 17 | stop() -> 18 | gen_server_cpre:stop(?MODULE). 19 | 20 | test() -> 21 | gen_server_cpre:call(?MODULE, test). 22 | 23 | init([]) -> 24 | {ok, 0}. 25 | 26 | cpre({result, N}, _, State = [N|R]) -> 27 | {true, State}; 28 | cpre({result, N}, _, State) -> 29 | {false, State}; 30 | cpre(test, _, State) -> 31 | {true, State}. 32 | 33 | % cpre(_, _, State) -> 34 | % {true, State}. 35 | 36 | 37 | % handle_call(_Request, _From, State) -> 38 | % Reply = ok, 39 | % {reply, Reply, State}. 40 | 41 | handle_call(test, _From, _State) -> 42 | % io:format("Building test...\n"), 43 | List = 44 | [1,2,3,4,5,6,7,8,9], 45 | lists:map(fun(N) -> 46 | spawn( 47 | fun() -> 48 | gen_server_cpre:call(?MODULE, {result, N}) 49 | end) 50 | end, lists:reverse(List)), 51 | {reply, ok, List}; 52 | handle_call({result, N}, _From, [N|R]) -> 53 | io:format("result: " ++ integer_to_list(N) ++ "~n"), 54 | {reply, ok, R}. 55 | 56 | handle_cast(_Request, State) -> 57 | {noreply, State}. 58 | 59 | 60 | handle_info(_Info, State) -> 61 | {noreply, State}. 62 | 63 | terminate(_Reason, _State) -> 64 | ok. 65 | 66 | code_change(_OldVsn, State, _Extra) -> 67 | {ok, State}. -------------------------------------------------------------------------------- /examples/sel_recv/gen_server_qcpre/src/sel_recv_test.erl: -------------------------------------------------------------------------------- 1 | -module(sel_recv_test). 2 | 3 | -export([test/0]). 4 | 5 | test() -> 6 | sel_recv:start_link(), 7 | sel_recv:test(), 8 | sel_recv:stop(), 9 | ok. 10 | 11 | -------------------------------------------------------------------------------- /examples/semaphore/no_queues/src/semaphore.erl: -------------------------------------------------------------------------------- 1 | -module(semaphore). 2 | -behaviour(gen_server_cpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 7 | 8 | -export([start/0, initialize/1, acquire/0, release/0, stop/0]). 9 | 10 | 11 | -record(state, 12 | { 13 | counter = 0, 14 | top = 0, 15 | ready = false 16 | }). 17 | 18 | 19 | % These are all wrappers for calls to the server 20 | % All the services provided by this server could be perfectly be implemented with casts instead of calls 21 | start() -> 22 | gen_server_cpre:start_link({local, ?MODULE}, ?MODULE, [], []). 23 | initialize(N) -> 24 | gen_server_cpre:call(?MODULE, {initialize, N}, infinity). 25 | acquire() -> 26 | gen_server_cpre:call(?MODULE, acquire, infinity). 27 | release() -> 28 | gen_server_cpre:call(?MODULE, release, infinity). 29 | stop() -> 30 | gen_server_cpre:stop(?MODULE). 31 | 32 | ?INVARIANT(fun invariant/1). 33 | 34 | invariant( 35 | State = 36 | #state{ 37 | counter = Counter, 38 | top = Top, 39 | ready = Ready 40 | }) -> 41 | and_reason( 42 | [ 43 | { 44 | is_integer(Counter), 45 | "The state's attribute counter should be an integer." 46 | }, 47 | { 48 | is_boolean(Ready), 49 | "The state's attribute ready should be a boolean." 50 | }, 51 | { 52 | is_integer(Top), 53 | "The state's attribute top should be an integer." 54 | }, 55 | { 56 | Top >= 0, 57 | "The top cannnot be negative." 58 | }, 59 | { 60 | Counter >= 0, 61 | "The counter cannot be negative." 62 | }, 63 | { 64 | Top >= Counter, 65 | "The counter cannot be greater than the top." 66 | }, 67 | % (Counter > 0) => (Ready == true). 68 | { 69 | (Counter == 0 orelse Ready), 70 | "The semaphore should be ready when counter is greater than 0." 71 | } 72 | ]). 73 | 74 | and_reason(List) -> 75 | lists:foldl( 76 | fun 77 | (_, {false, Reason}) -> 78 | {false, Reason}; 79 | (_, false) -> 80 | false; 81 | ({true, _}, true) -> 82 | true; 83 | ({false, Reason}, true) -> 84 | {false, Reason}; 85 | (B, true) -> 86 | B 87 | end, 88 | true, 89 | List). 90 | 91 | % This is called when a connection is made to the server 92 | init([]) -> 93 | {ok, #state{}}. 94 | 95 | ?PRE(fun() -> 96 | #state{counter = Counter, top = Top, ready = Ready} = ?P(3), 97 | case ?P(1) of 98 | {initialize, N} -> 99 | {not(Ready), "Semaphore already initialized."}; 100 | acquire -> 101 | {Ready, "Semaphore not initialized yet."}; 102 | release -> 103 | case Ready of 104 | true -> 105 | {Counter < Top, "This signal exceeds the semaphore limit."}; 106 | false -> 107 | {false, "Semaphore not initialized yet."} 108 | end 109 | end 110 | end). 111 | cpre(acquire, _, State = #state{counter = Counter}) when Counter =< 0 -> 112 | { 113 | false, 114 | State 115 | }; 116 | cpre(_, _, State) -> 117 | { 118 | true, 119 | State 120 | }. 121 | 122 | 123 | % handle_call is invoked in response to gen_server:call 124 | handle_call({initialize, N}, _, State) -> 125 | {reply, ok, State#state{top = N, counter = N, ready = true}}; 126 | handle_call(acquire, _, State = #state{counter = N}) -> 127 | {reply, ok, State#state{counter = N - 1}}; 128 | handle_call(release, _, State = #state{counter = N}) -> 129 | {reply, ok, State#state{counter = N + 1}}; 130 | handle_call(_Message, _From, State) -> 131 | % io:format("Error: ~p\n", [_Message]), 132 | {reply, error, State}. 133 | 134 | 135 | handle_cast(_Other, State) -> 136 | {noreply, State}. 137 | 138 | handle_info(_Message, State) -> 139 | {noreply, State}. 140 | 141 | terminate(_Reason, _State) -> 142 | ok. 143 | 144 | code_change(_OldVersion, State, _Extra) -> 145 | {ok, State}. 146 | -------------------------------------------------------------------------------- /examples/semaphore/no_queues/src/semaphore_tests.erl: -------------------------------------------------------------------------------- 1 | -module(semaphore_tests). 2 | 3 | -compile(export_all). 4 | 5 | test() -> 6 | [ 7 | begin 8 | io:format( 9 | "\n~s\nTest with ~p\n~s\n", 10 | [sep(), T, sep()]), 11 | (fun ?MODULE:T/0)(), 12 | io:format("\n") 13 | end 14 | || 15 | T <- all_tests() 16 | ]. 17 | 18 | sep() -> 19 | "******************************". 20 | 21 | all_tests() -> 22 | [ 23 | ini, 24 | double_ini, 25 | acquire_before_ini, 26 | release_before_ini, 27 | extra_release, 28 | should_wait, 29 | scenario 30 | ]. 31 | 32 | ok() -> 33 | io:format("OK"). 34 | 35 | fail() -> 36 | fail(""). 37 | 38 | fail(Reason) -> 39 | io:format("FAIL " ++ Reason). 40 | 41 | ini() -> 42 | semaphore:start(), 43 | case semaphore:initialize(3) of 44 | ok -> 45 | ok(); 46 | _ -> 47 | fail() 48 | end, 49 | semaphore:stop(). 50 | 51 | double_ini() -> 52 | semaphore:start(), 53 | try 54 | semaphore:initialize(3), 55 | semaphore:initialize(3), 56 | fail(), 57 | semaphore:stop() 58 | catch 59 | _:_ -> 60 | ok() 61 | end. 62 | 63 | acquire_before_ini() -> 64 | semaphore:start(), 65 | try 66 | semaphore:acquire(), 67 | fail(), 68 | semaphore:stop() 69 | catch 70 | _:_ -> 71 | ok() 72 | end. 73 | 74 | release_before_ini() -> 75 | semaphore:start(), 76 | try 77 | semaphore:release(), 78 | fail(), 79 | semaphore:stop() 80 | catch 81 | _:_ -> 82 | ok() 83 | end. 84 | 85 | extra_release() -> 86 | semaphore:start(), 87 | try 88 | semaphore:initialize(3), 89 | semaphore:release(), 90 | fail(), 91 | semaphore:stop() 92 | catch 93 | _:_ -> 94 | ok() 95 | end. 96 | 97 | should_wait() -> 98 | semaphore:start(), 99 | semaphore:initialize(3), 100 | Self = self(), 101 | FunTest = 102 | fun() -> 103 | semaphore:acquire(), 104 | semaphore:acquire(), 105 | semaphore:acquire(), 106 | Self!semaphore:acquire() 107 | end, 108 | spawn(FunTest), 109 | receive 110 | ok -> 111 | fail() 112 | after 113 | 100 -> 114 | ok() 115 | end, 116 | semaphore:stop(). 117 | 118 | scenario() -> 119 | semaphore:start(), 120 | N = 3, 121 | Instances = 6, 122 | semaphore:initialize(N), 123 | Self = self(), 124 | Counter = 125 | spawn(fun () -> counter(0, N, Self) end), 126 | FunTest = 127 | fun() -> 128 | semaphore:acquire(), 129 | Counter!enter, 130 | timer:sleep(100), 131 | Counter!exit, 132 | semaphore:release(), 133 | Self!finish 134 | end, 135 | [spawn(FunTest) || _ <- lists:seq(1, Instances)], 136 | Res = 137 | receive_data(Instances, Counter), 138 | case Res of 139 | error -> 140 | fail("There were more processes inside the critical section than expected"); 141 | 0 -> 142 | ok(); 143 | _ -> 144 | fail("There are some process that remain inside the critical section.") 145 | end, 146 | semaphore:stop(). 147 | 148 | counter(N, Top, Parent) when N > Top -> 149 | Parent!error; 150 | counter(N, Top, Parent) when N =< Top -> 151 | receive 152 | enter -> 153 | counter(N + 1, Top, Parent); 154 | exit -> 155 | counter(N - 1, Top, Parent); 156 | finish -> 157 | Parent!{current, N} 158 | end. 159 | 160 | receive_data(0, Counter) -> 161 | Counter!finish, 162 | receive 163 | {current, N} -> 164 | N 165 | end; 166 | receive_data(Pending, Counter) -> 167 | receive 168 | error -> 169 | error; 170 | finish -> 171 | receive_data(Pending - 1, Counter) 172 | end. 173 | 174 | 175 | 176 | -------------------------------------------------------------------------------- /examples/semaphore/queues/src/semaphore.erl: -------------------------------------------------------------------------------- 1 | -module(semaphore). 2 | -behaviour(gen_server_qcpre). 3 | 4 | -include_lib("edbc.hrl"). 5 | 6 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, cpre/3]). 7 | 8 | -export([start/0, initialize/1, acquire/0, release/0, stop/0]). 9 | 10 | 11 | -record(state, 12 | { 13 | counter = 0, 14 | top = 0, 15 | ready = false 16 | }). 17 | 18 | 19 | % These are all wrappers for calls to the server 20 | % All the services provided by this server could be perfectly be implemented with casts instead of calls 21 | start() -> 22 | gen_server_qcpre:start_link({local, ?MODULE}, ?MODULE, [], []). 23 | initialize(N) -> 24 | gen_server_qcpre:call(?MODULE, {initialize, N}, infinity). 25 | acquire() -> 26 | gen_server_qcpre:call(?MODULE, acquire, infinity). 27 | release() -> 28 | gen_server_qcpre:call(?MODULE, release, infinity). 29 | stop() -> 30 | gen_server_qcpre:stop(?MODULE). 31 | 32 | ?INVARIANT(fun invariant/1). 33 | 34 | invariant( 35 | State = 36 | #state{ 37 | counter = Counter, 38 | top = Top, 39 | ready = Ready 40 | }) -> 41 | and_reason( 42 | [ 43 | { 44 | is_integer(Counter), 45 | "The state's attribute counter should be an integer." 46 | }, 47 | { 48 | is_boolean(Ready), 49 | "The state's attribute ready should be a boolean." 50 | }, 51 | { 52 | is_integer(Top), 53 | "The state's attribute top should be an integer." 54 | }, 55 | { 56 | Top >= 0, 57 | "The top cannnot be negative." 58 | }, 59 | { 60 | Counter >= 0, 61 | "The counter cannot be negative." 62 | }, 63 | { 64 | Top >= Counter, 65 | "The counter cannot be greater than the top." 66 | }, 67 | % (Counter > 0) => (Ready == true). 68 | { 69 | (Counter == 0 orelse Ready), 70 | "The semaphore should be ready when counter is greater than 0." 71 | } 72 | ]). 73 | 74 | and_reason(List) -> 75 | lists:foldl( 76 | fun 77 | (_, {false, Reason}) -> 78 | {false, Reason}; 79 | (_, false) -> 80 | false; 81 | ({true, _}, true) -> 82 | true; 83 | ({false, Reason}, true) -> 84 | {false, Reason}; 85 | (B, true) -> 86 | B 87 | end, 88 | true, 89 | List). 90 | 91 | % This is called when a connection is made to the server 92 | init([]) -> 93 | {ok, #state{}}. 94 | 95 | ?PRE(fun() -> 96 | #state{counter = Counter, top = Top, ready = Ready} = ?P(3), 97 | case ?P(1) of 98 | {initialize, N} -> 99 | {not(Ready), "Semaphore already initialized."}; 100 | acquire -> 101 | {Ready, "Semaphore not initialized yet."}; 102 | release -> 103 | case Ready of 104 | true -> 105 | {Counter < Top, "This signal exceeds the semaphore limit."}; 106 | false -> 107 | {false, "Semaphore not initialized yet."} 108 | end 109 | end 110 | end). 111 | cpre(acquire, _, State = #state{counter = Counter}) when Counter =< 0 -> 112 | { 113 | false, 114 | State 115 | }; 116 | cpre(_, _, State) -> 117 | { 118 | true, 119 | State 120 | }. 121 | 122 | 123 | % handle_call is invoked in response to gen_server:call 124 | handle_call({initialize, N}, _, State) -> 125 | {reply, ok, State#state{top = N, counter = N, ready = true}}; 126 | handle_call(acquire, _, State = #state{counter = N}) -> 127 | {reply, ok, State#state{counter = N - 1}}; 128 | handle_call(release, _, State = #state{counter = N}) -> 129 | {reply, ok, State#state{counter = N + 1}}; 130 | handle_call(_Message, _From, State) -> 131 | % io:format("Error: ~p\n", [_Message]), 132 | {reply, error, State}. 133 | 134 | 135 | handle_cast(_Other, State) -> 136 | {noreply, State}. 137 | 138 | handle_info(_Message, State) -> 139 | {noreply, State}. 140 | 141 | terminate(_Reason, _State) -> 142 | ok. 143 | 144 | code_change(_OldVersion, State, _Extra) -> 145 | {ok, State}. 146 | -------------------------------------------------------------------------------- /examples/semaphore/queues/src/semaphore_tests.erl: -------------------------------------------------------------------------------- 1 | -module(semaphore_tests). 2 | 3 | -compile(export_all). 4 | 5 | test() -> 6 | [ 7 | begin 8 | io:format( 9 | "\n~s\nTest with ~p\n~s\n", 10 | [sep(), T, sep()]), 11 | (fun ?MODULE:T/0)(), 12 | io:format("\n") 13 | end 14 | || 15 | T <- all_tests() 16 | ]. 17 | 18 | sep() -> 19 | "******************************". 20 | 21 | all_tests() -> 22 | [ 23 | ini, 24 | double_ini, 25 | acquire_before_ini, 26 | release_before_ini, 27 | extra_release, 28 | should_wait, 29 | scenario 30 | ]. 31 | 32 | ok() -> 33 | io:format("OK"). 34 | 35 | fail() -> 36 | fail(""). 37 | 38 | fail(Reason) -> 39 | io:format("FAIL " ++ Reason). 40 | 41 | ini() -> 42 | semaphore:start(), 43 | case semaphore:initialize(3) of 44 | ok -> 45 | ok(); 46 | _ -> 47 | fail() 48 | end, 49 | semaphore:stop(). 50 | 51 | double_ini() -> 52 | semaphore:start(), 53 | try 54 | semaphore:initialize(3), 55 | semaphore:initialize(3), 56 | fail(), 57 | semaphore:stop() 58 | catch 59 | _:_ -> 60 | ok() 61 | end. 62 | 63 | acquire_before_ini() -> 64 | semaphore:start(), 65 | try 66 | semaphore:acquire(), 67 | fail(), 68 | semaphore:stop() 69 | catch 70 | _:_ -> 71 | ok() 72 | end. 73 | 74 | release_before_ini() -> 75 | semaphore:start(), 76 | try 77 | semaphore:release(), 78 | fail(), 79 | semaphore:stop() 80 | catch 81 | _:_ -> 82 | ok() 83 | end. 84 | 85 | extra_release() -> 86 | semaphore:start(), 87 | try 88 | semaphore:initialize(3), 89 | semaphore:release(), 90 | fail(), 91 | semaphore:stop() 92 | catch 93 | _:_ -> 94 | ok() 95 | end. 96 | 97 | should_wait() -> 98 | semaphore:start(), 99 | semaphore:initialize(3), 100 | Self = self(), 101 | FunTest = 102 | fun() -> 103 | semaphore:acquire(), 104 | semaphore:acquire(), 105 | semaphore:acquire(), 106 | Self!semaphore:acquire() 107 | end, 108 | spawn(FunTest), 109 | receive 110 | ok -> 111 | fail() 112 | after 113 | 100 -> 114 | ok() 115 | end, 116 | semaphore:stop(). 117 | 118 | scenario() -> 119 | semaphore:start(), 120 | N = 3, 121 | Instances = 6, 122 | semaphore:initialize(N), 123 | Self = self(), 124 | Counter = 125 | spawn(fun () -> counter(0, N, Self) end), 126 | FunTest = 127 | fun() -> 128 | semaphore:acquire(), 129 | Counter!enter, 130 | timer:sleep(100), 131 | Counter!exit, 132 | semaphore:release(), 133 | Self!finish 134 | end, 135 | [spawn(FunTest) || _ <- lists:seq(1, Instances)], 136 | Res = 137 | receive_data(Instances, Counter), 138 | case Res of 139 | error -> 140 | fail("There were more processes inside the critical section than expected"); 141 | 0 -> 142 | ok(); 143 | _ -> 144 | fail("There are some process that remain inside the critical section.") 145 | end, 146 | semaphore:stop(). 147 | 148 | counter(N, Top, Parent) when N > Top -> 149 | Parent!error; 150 | counter(N, Top, Parent) when N =< Top -> 151 | receive 152 | enter -> 153 | counter(N + 1, Top, Parent); 154 | exit -> 155 | counter(N - 1, Top, Parent); 156 | finish -> 157 | Parent!{current, N} 158 | end. 159 | 160 | receive_data(0, Counter) -> 161 | Counter!finish, 162 | receive 163 | {current, N} -> 164 | N 165 | end; 166 | receive_data(Pending, Counter) -> 167 | receive 168 | error -> 169 | error; 170 | finish -> 171 | receive_data(Pending - 1, Counter) 172 | end. 173 | 174 | 175 | 176 | -------------------------------------------------------------------------------- /include/edbc.hrl: -------------------------------------------------------------------------------- 1 | -compile( [{parse_transform, edbc_parse_transform}]). 2 | -include_lib("stdlib/include/assert.hrl"). 3 | 4 | % A condition to be held BEFORE performing a call. 5 | -define(PRE(FUN), edbc_pre() -> FUN). 6 | 7 | % A condition to be held AFTER performing a call. 8 | -define(POST(FUN), edbc_post() -> FUN). 9 | 10 | % Checks whether the state satisfies some conditions. 11 | % It can be only used in gen_server or other behaviours with a internal state. 12 | -define(INVARIANT(FUN), edbc_invariant() -> FUN). 13 | 14 | % Checks that a parameter (or a list of parameters) is decreased in recursive calls (only working for self-recursive function now) 15 | -define(DECREASES(PAR), edbc_decreases() -> PAR). 16 | 17 | % Checks that a parameter (or a list of parameters) is decreased in recursive calls (only working for self-recursive function now) 18 | -define(SDECREASES(PAR), edbc_sdecreases() -> PAR). 19 | 20 | % Checks that the execution time is less or equal than FUN(). Function FUN can include parameters, i.e. it can use the macro ?P/1. 21 | -define(EXPECTED_TIME(FUN), edbc_expected_time() -> FUN). 22 | 23 | % Cut the execution of a function when its exectution time is longer than FUN(). Function FUN can include parameters, i.e. it can use the macro ?P/1. 24 | -define(TIMEOUT(FUN), edbc_timeout() -> FUN). 25 | 26 | % An error is raised if the function perform unsafe operations. This is not compatible with EXPECTED_TIME and TIMEOUT because they perform unsafe operations. 27 | -define(PURE, edbc_pure() -> ok). 28 | 29 | % Macro for parameters, e.g. P(1) states for the first parameter. 30 | -define(P(N), edbc_p(N)). 31 | 32 | % Macro for the result of a function. 33 | -define(R, edbc_r()). 34 | -------------------------------------------------------------------------------- /other/TODO.md: -------------------------------------------------------------------------------- 1 | # TODO 2 | 3 | PRE, POST, ... 4 | ============== 5 | 6 | - Produce default values instead of an error, i.e. ?PRE(fun.., DefaultValue). An alternative to a different macro is to return {false, {default_value, Value}} in the PRE function. 7 | - Produce a personalized error message for PREs y POSTs, i.e. ?PRE(fun.., ErrorMsg). An alternative to a specific macro is to return {false, Msg}. 8 | - Last two extensions are mutually exclusive. If there is a default value, then there is not sense for an error message, and viceversa. This is automatically done by an specific message error. 9 | 10 | - Plantear la posibilidad de que falle más de una PRE o una POST. 11 | 12 | - decreases for a recursions a -> b -> a -> b 13 | - One option to do this is by using tracing. Each time a call to the function is detected the check is performed. 14 | 15 | - The top of the stack has not postion info. This is unsalvable even by copying attributes from the original form. 16 | 17 | - Add a comparsion function to the decrease function so the decision of whether a parameter is decreasing or not is not only done by < or =<. 18 | 19 | - Add exception to the contracts 20 | 21 | 22 | GEN_SERVER_CPRE 23 | =============== 24 | 25 | - Add to a gen_server_cpre a dictionary as an internal attribute that for each request stores a sorted list of waiting processes. This could ease the starvation checking. 26 | - Add the previous state to the gen_server_cpre, and make the implementation so return an additional element (a flag) in the returned tuples indicaating whether the previous state should be updated. 27 | - solve starvation problems using invariants 28 | - Is it needed the old state in the invariant function 29 | - The PRE/POST conditions in the gen_server maybe should make the client fail instead of the server. 30 | - Extend the same approach to other behaviours using state 31 | - It is important to note that the client should perform the call using an infinite timeout. Otherwise, 5000 ms is applied by default and it could result in clients which are already dead when the service is provided. 32 | 33 | 34 | 35 | Other 36 | ===== 37 | 38 | 39 | - It is important that the reported error give an informative information to detect the source of the error. 40 | - Generate eunit tests from contracts. 41 | - Generate property tests from contracts. 42 | - Invariants when spawning a new process, such as its number of queued messages cannot be greater than 1, etc. 43 | - Introduce locks 44 | - pre in property testing to check that the inputs of a function have always some properties 45 | ``` 46 | prop_calls_to_f() -> 47 | ?FORALL({A,B}, {integer(),list(integer())}, 48 | ?PRE_CALLSTO( 49 | fun m:f/3, 50 | [m:g(A,B), m:h(A), m:i(B,A)], 51 | ?P(1) > 3 andalso is_integer(?P(1)) andalso ?P(1) + ?P(2) > ?P(3) 52 | ) 53 | ). 54 | ``` 55 | - liquid types 56 | - liquid session types 57 | - Add behaviour info as in https://github.com/uwiger/plain_fsm/blob/master/src/plain_fsm.erl 58 | - Formally propose extension of Erlang 59 | - use rebar or something to ease compilation and load of the environment 60 | 61 | 62 | To see 63 | ====== 64 | 65 | 66 | - https://www.python.org/dev/peps/pep-0316/ 67 | - "Starvation and Critical Race Analyzers for Ada" 68 | - http://www.rise4fun.com/Dafny/ 69 | - https://www.youtube.com/watch?v=OcbE6nL1QEk 70 | - https://vimeo.com/148089863 71 | - https://github.com/hyperthunk/annotations 72 | -------------------------------------------------------------------------------- /scripts/edbc_edoc: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | edbc_path0=$(dirname "$0") 4 | edbc_path="$edbc_path0/.." 5 | current_path=$(pwd) 6 | 7 | if [ $# -lt 1 ] || [ $# -gt 2 ] 8 | then 9 | echo -e "Usage:\n\tedbc_edoc FILE EDOC_DIR" 10 | else 11 | filename=$(basename $1) 12 | if [ "${1:0:1}" = "/" ] 13 | then 14 | file_path=$1 15 | else 16 | file_path="$current_path/$1" 17 | fi 18 | if [ "${2:0:1}" = "/" ] 19 | then 20 | doc_dir=$2 21 | else 22 | doc_dir="$current_path/$2" 23 | fi 24 | mkdir "$edbc_path/temp" 25 | erl -pa "$edbc_path/ebin" "$edbc_path/deps/sheriff/ebin" "$edbc_path/deps/parse_trans/ebin" -eval 'edbc_parse_transform:print_clean_code("'${file_path}'", ["'$edbc_path'/include"], "'$edbc_path'/temp/'${filename}'")' -noshell -eval -s erlang halt 26 | erl -run edoc_run files '["'$edbc_path'/temp/'$filename'"]' '[{dir, "'$doc_dir'"}]' -noshell -eval -s erlang halt 27 | rm -rf "$edbc_path/temp" 28 | fi 29 | 30 | 31 | -------------------------------------------------------------------------------- /scripts/edbc_erl: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | edbc_path0=$(dirname "$0") 4 | edbc_path="$edbc_path0/.." 5 | current_path=$(pwd) 6 | 7 | if [ $# -lt 1 ] 8 | then 9 | echo -e "Usage:\n\tedbc_erl EBIN_DIR [CALL]" 10 | else 11 | if [ "${1:0:1}" = "/" ] 12 | then 13 | file_path=$1 14 | else 15 | file_path="$current_path/$1" 16 | fi 17 | if [ $# -eq 2 ] 18 | then 19 | erl -pa $file_path "$edbc_path/ebin" "$edbc_path/deps/sheriff/ebin" "$edbc_path/deps/parse_trans/ebin" -noshell -eval $2 -eval -s erlang halt 20 | else 21 | erl -pa $file_path "$edbc_path/ebin" "$edbc_path/deps/sheriff/ebin" "$edbc_path/deps/parse_trans/ebin" 22 | fi 23 | fi 24 | -------------------------------------------------------------------------------- /scripts/edbc_erlc: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | edbc_path0=$(dirname "$0") 4 | edbc_path="$edbc_path0/.." 5 | current_path=$(pwd) 6 | 7 | if [ $# -lt 1 ] || [ $# -gt 2 ] 8 | then 9 | echo -e "Usage:\n\tedbc_erlc FILE [OUTPUT_DIR]" 10 | else 11 | if [ "${1:0:1}" = "/" ] 12 | then 13 | file_path=$1 14 | else 15 | file_path="$current_path/$1" 16 | fi 17 | if [ $# -eq 2 ] 18 | then 19 | if [ "${DIR:0:1}" = "/" ] 20 | then 21 | ebin_path=$2 22 | else 23 | ebin_path="$current_path/$2" 24 | fi 25 | erlc -pa "$edbc_path/ebin" -pa "$edbc_path/deps/sheriff/ebin" -pa "$edbc_path/deps/parse_trans/ebin" -I "$edbc_path/include" -W0 -o $ebin_path -Dedbc $file_path 26 | else 27 | erlc -pa "$edbc_path/ebin" -pa "$edbc_path/deps/sheriff/ebin" -pa "$edbc_path/deps/parse_trans/ebin" -I "$edbc_path/include" -W0 -Dedbc $file_path 28 | fi 29 | fi 30 | -------------------------------------------------------------------------------- /scripts/edbc_erlcp: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | edbc_path0=$(dirname "$0") 4 | edbc_path="$edbc_path0/.." 5 | current_path=$(pwd) 6 | 7 | if [ $# -lt 1 ] || [ $# -gt 2 ] 8 | then 9 | echo -e "Usage:\n\tedbc_erlc FILE [OUTPUT_DIR]" 10 | else 11 | if [ "${1:0:1}" = "/" ] 12 | then 13 | file_path=$1 14 | else 15 | file_path="$current_path/$1" 16 | fi 17 | if [ $# -eq 2 ] 18 | then 19 | if [ "${DIR:0:1}" = "/" ] 20 | then 21 | ebin_path=$2 22 | else 23 | ebin_path="$current_path/$2" 24 | fi 25 | erlc -pa "$edbc_path/ebin" -pa "$edbc_path/deps/sheriff/ebin" -pa "$edbc_path/deps/parse_trans/ebin" -I "$edbc_path/include" -W0 -o $ebin_path $file_path 26 | else 27 | erlc -pa "$edbc_path/ebin" -pa "$edbc_path/deps/sheriff/ebin" -pa "$edbc_path/deps/parse_trans/ebin" -I "$edbc_path/include" -W0 $file_path 28 | fi 29 | fi 30 | -------------------------------------------------------------------------------- /src/edbc_free_vars_server.erl: -------------------------------------------------------------------------------- 1 | -module(edbc_free_vars_server). 2 | 3 | -export([init/0]). 4 | 5 | -record( 6 | state, 7 | { 8 | variables = sets:new(), 9 | max_length_variable = "", 10 | current_id = 0 11 | }). 12 | 13 | init() -> 14 | loop(#state{}). 15 | 16 | loop(State) -> 17 | receive 18 | exit -> 19 | ok; 20 | {add_variable, Variable} -> 21 | NewState = 22 | State#state 23 | { 24 | variables = 25 | sets:add_element( 26 | Variable, 27 | State#state.variables) 28 | }, 29 | loop(NewState); 30 | all_variables_added -> 31 | NewState = 32 | State#state 33 | { 34 | variables = 35 | sets:new(), 36 | max_length_variable = 37 | sets:fold( 38 | fun get_max_length_variable/2, 39 | "", 40 | State#state.variables) 41 | }, 42 | loop(NewState); 43 | {get_free_variable, Pid} -> 44 | CurrentId = 45 | State#state.current_id, 46 | NewState = 47 | State#state{ 48 | current_id = 49 | CurrentId + 1 50 | }, 51 | FreeVariable = 52 | State#state.max_length_variable 53 | ++ integer_to_list(CurrentId), 54 | Pid ! erl_syntax:variable(FreeVariable), 55 | loop(NewState); 56 | {get_free_id, Atom, Pid} -> 57 | CurrentId = 58 | State#state.current_id, 59 | NewState = 60 | State#state{ 61 | current_id = 62 | CurrentId + 1 63 | }, 64 | FreeID = 65 | atom_to_list(Atom) 66 | ++ integer_to_list(CurrentId), 67 | Pid ! erl_syntax:atom(FreeID), 68 | loop(NewState); 69 | _Other -> 70 | loop(State) 71 | end. 72 | 73 | get_max_length_variable(Variable, Max) 74 | when length(Variable) > length(Max) -> 75 | Variable; 76 | get_max_length_variable(_, Max) -> 77 | Max. 78 | -------------------------------------------------------------------------------- /src/edbc_lib.erl: -------------------------------------------------------------------------------- 1 | -module(edbc_lib). 2 | -export([ 3 | post_invariant/2, 4 | decreasing_check/3, 5 | sdecreasing_check/3, 6 | pre/2, 7 | post/2, 8 | expected_time/2, 9 | timeout/2, 10 | is_pure/2, 11 | spec_check_pre/2, 12 | spec_check_post/2, 13 | put_st/0, 14 | put_call/1, 15 | put_already_tracing/1 16 | % sheriff_check/2 17 | ]). 18 | 19 | 20 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 21 | % post_invariant/2 22 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 23 | 24 | post_invariant(F, {ok, State}) -> 25 | correct_message_invariant(F, State); 26 | post_invariant(F, {ok, State, _}) -> 27 | correct_message_invariant(F, State); 28 | post_invariant(F, {noreply, State}) -> 29 | correct_message_invariant(F, State); 30 | post_invariant(F, {noreply, State, _}) -> 31 | correct_message_invariant(F, State); 32 | post_invariant(F, {stop, _, State}) -> 33 | correct_message_invariant(F, State); 34 | post_invariant(F, {reply, _, State}) -> 35 | correct_message_invariant(F, State); 36 | post_invariant(F, {reply, _, State, _}) -> 37 | correct_message_invariant(F, State); 38 | post_invariant(F, {stop, _, _, State}) -> 39 | correct_message_invariant(F, State); 40 | post_invariant(F, {true, State}) -> 41 | correct_message_invariant(F, State); 42 | post_invariant(F, {false, State}) -> 43 | correct_message_invariant(F, State); 44 | post_invariant(_, {error, _}) -> 45 | true; 46 | post_invariant(_, ignore) -> 47 | true. 48 | 49 | correct_message_invariant(F, State) -> 50 | case F(State) of 51 | true -> 52 | true; 53 | {true, _} -> 54 | true; 55 | Other -> 56 | {Other, invariant} 57 | end. 58 | 59 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 60 | % decreasing_check/3 61 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 62 | 63 | decreasing_check(NewValues, OldValues, F) -> 64 | decreasing_check_gen(NewValues, OldValues, F, fun(A, B) -> A =< B end). 65 | 66 | sdecreasing_check(NewValues, OldValues, F) -> 67 | decreasing_check_gen(NewValues, OldValues, F, fun(A, B) -> A < B end). 68 | 69 | decreasing_check_gen(NewValues, OldValues, F, CompFun) -> 70 | case lists:all( 71 | fun(B) -> B end, 72 | [CompFun(NewValue, OldValue) 73 | || {NewValue, OldValue} <- lists:zip(NewValues, OldValues)]) 74 | of 75 | true -> 76 | F(); 77 | false -> 78 | [FN | _] = 79 | get(edbc_cc), 80 | ErrorMsg = 81 | format( 82 | "Decreasing condition does not hold." 83 | " Previous call: ~s." 84 | " Current call: ~s.", 85 | [build_call_str([FN | OldValues]), build_call_str([FN | NewValues])]), 86 | error({ErrorMsg, get(edbc_st)}); 87 | {false, Msg} -> 88 | [FN | _] = 89 | get(edbc_cc), 90 | ErrorMsg = 91 | format( 92 | "Decreasing condition does not hold." 93 | " Previous call: ~s." 94 | " Current call: ~s." 95 | " ~s", 96 | [build_call_str([FN | OldValues]), build_call_str([FN | NewValues]), Msg]), 97 | error({ErrorMsg, get(edbc_st)}) 98 | end. 99 | 100 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 101 | % pre/2 102 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 103 | 104 | pre(Pre, Call) -> 105 | case Pre() of 106 | true -> 107 | Call(); 108 | {true, _} -> 109 | Call(); 110 | false -> 111 | ErrorMsg = 112 | format( 113 | "The precondition does not hold. ~s.", 114 | [last_call_str()]), 115 | error({ErrorMsg, get(edbc_st)}); 116 | {false, Msg} -> 117 | ErrorMsg = 118 | format( 119 | "The precondition does not hold. ~s. ~s", 120 | [last_call_str(), Msg]), 121 | error({ErrorMsg, get(edbc_st)}) 122 | end. 123 | 124 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 125 | % post/2 126 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 127 | 128 | post(Post, Call) -> 129 | Res = Call(), 130 | case Post(Res) of 131 | true -> 132 | Res; 133 | {true, _} -> 134 | Res; 135 | {Rep, invariant} -> 136 | show_post_report(Rep, Res, "invariant"); 137 | Rep -> 138 | show_post_report(Rep, Res, "postcondition") 139 | end. 140 | 141 | show_post_report(Rep, Res, StrPost) -> 142 | case Rep of 143 | false -> 144 | ErrorMsg = 145 | format( 146 | "The ~s does not hold. ~s. Result: ~p", 147 | [StrPost, last_call_str(), Res]), 148 | error({ErrorMsg, get(edbc_st)}); 149 | {false, Msg} -> 150 | ErrorMsg = 151 | format( 152 | "The ~s does not hold. ~s. Result: ~p. ~s", 153 | [StrPost, last_call_str(), Res, Msg]), 154 | error({ErrorMsg, get(edbc_st)}) 155 | end. 156 | 157 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 158 | % expected_time/2 159 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 160 | 161 | expected_time(Time, Call) -> 162 | Expected = 163 | Time(), 164 | StartTime = 165 | os:timestamp(), 166 | Res = Call(), 167 | ExeTime = 168 | timer:now_diff(os:timestamp(), StartTime)/1000, 169 | % 1000 because now_diff returns microseconds and we wants miliseconds 170 | % io:format("ExeTime: ~p\nExpected: ~p\n", [ExeTime, Expected]), 171 | case ExeTime < Expected of 172 | true -> 173 | Res; 174 | false -> 175 | ErrorMsg = 176 | format( 177 | "The execution of ~s" 178 | " took too much time." 179 | "Real: ~p ms. Expected: ~p ms. Difference: ~p ms).", 180 | [simple_last_call_str(), ExeTime, Expected, ExeTime - Expected]), 181 | error({ErrorMsg, get_stacktrace()}) 182 | end. 183 | 184 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 185 | % timeout/2 186 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 187 | 188 | timeout(Time, Call) -> 189 | Timeout = 190 | Time(), 191 | Self = 192 | self(), 193 | MsgRef = 194 | make_ref(), 195 | spawn(fun() -> Self!{Call(), MsgRef} end), 196 | receive 197 | {Res, MsgRef} -> 198 | Res 199 | after 200 | Timeout -> 201 | ErrorMsg = 202 | format( 203 | "The execution of ~s" 204 | " has been stopped" 205 | " because it took more time than the expected, i.e. ~p ms.", 206 | [simple_last_call_str(), Timeout]), 207 | error({ErrorMsg, get_stacktrace()}) 208 | end. 209 | 210 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 211 | % spec_check_pre/2 212 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 213 | 214 | spec_check_pre(Pre, Call) -> 215 | case Pre() of 216 | true -> 217 | Call(); 218 | false -> 219 | ErrorMsg = 220 | format( 221 | "The spec precondition does not hold. ~s.", 222 | [last_call_str()]), 223 | error({ErrorMsg, get(edbc_st)}); 224 | {false, Msg} -> 225 | ErrorMsg = 226 | format( 227 | "The spec precondition does not hold. ~s. ~s", 228 | [last_call_str(), Msg]), 229 | error({ErrorMsg, get(edbc_st)}) 230 | end. 231 | 232 | 233 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 234 | % spec_check_post/2 235 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 236 | 237 | spec_check_post(Post, Call) -> 238 | Res = Call(), 239 | case Post(Res) of 240 | true -> 241 | Res; 242 | false -> 243 | ErrorMsg = 244 | format( 245 | "The spec postcondition does not hold. ~s.", 246 | [last_call_str()]), 247 | error({ErrorMsg, get(edbc_st)}); 248 | {false, Msg} -> 249 | ErrorMsg = 250 | format( 251 | "The spec postcondition does not hold. ~s. ~s", 252 | [last_call_str(), Msg]), 253 | error({ErrorMsg, get(edbc_st)}) 254 | end. 255 | 256 | 257 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 258 | % is_pure/2 259 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 260 | 261 | -record(pt_state, 262 | { 263 | pid, 264 | start_ref, 265 | end_ref, 266 | result = none, 267 | impure_calls_exp = 0, 268 | last_call 269 | }). 270 | 271 | % This useless clause is defined to unify the interface of all the pre/post functions 272 | is_pure(_, Call) -> 273 | is_pure(Call). 274 | 275 | is_pure(Call) -> 276 | case get(already_tracing) of 277 | true -> 278 | % TODO: THink a way of trace functions when a tracing process is already running. 279 | % A solution could be to create a new process an do the tracing there. 280 | Call(); 281 | _ -> 282 | Self = 283 | self(), 284 | StartRef = 285 | make_ref(), 286 | EndRef = 287 | make_ref(), 288 | Pid = 289 | spawn( 290 | fun() -> 291 | edbc_lib:put_already_tracing(true), 292 | % edbc_lib:receive_start(), 293 | receive 294 | {start, StartRef} -> 295 | ok 296 | end, 297 | Res = 298 | try Call() of 299 | Res0 -> 300 | Res0 301 | catch 302 | E1:E2 -> 303 | {edbc_error_call, {E1, E2}} 304 | end, 305 | % edbc_lib:send_result(Self, Res, EndRef), 306 | Self ! {trace, self(), result, Res, EndRef}, 307 | edbc_lib:put_already_tracing(false) 308 | end), 309 | erlang:trace(Pid, true, [call, return_to, set_on_spawn, procs, ports, send, 'receive']), 310 | erlang:trace_pattern({'_','_','_'}, true, []), 311 | Pid!{start, StartRef}, 312 | Result = 313 | is_pure_tracer( 314 | #pt_state{ 315 | pid = Pid, 316 | start_ref = StartRef, 317 | end_ref = EndRef, 318 | last_call = get(edbc_cc) 319 | }), 320 | case Result of 321 | edbc_error -> 322 | ErrorMsg = 323 | format( 324 | "The function is not pure. ~s.", 325 | [last_call_str()]), 326 | error({ErrorMsg, get(edbc_st)}); 327 | {edbc_error, Msg} -> 328 | ErrorMsg = 329 | format( 330 | "The function is not pure. ~s. ~s", 331 | [last_call_str(), Msg]), 332 | error({ErrorMsg, get(edbc_st)}); 333 | {edbc_error_call, {error, Reason}} -> 334 | error({Reason, get(edbc_st)}); 335 | {edbc_error_call, {throw, Reason}} -> 336 | throw({Reason, get(edbc_st)}); 337 | {edbc_error_call, {exit, Reason}} -> 338 | exit({Reason, get(edbc_st)}); 339 | Res -> 340 | Res 341 | end 342 | end. 343 | 344 | % -record(pt_state, 345 | % { 346 | % pid, 347 | % start_ref, 348 | % end_ref, 349 | % result = none, 350 | % impure_calls_exp = 0, 351 | % last_call 352 | % }). 353 | 354 | is_pure_tracer( 355 | State = 356 | #pt_state{ 357 | pid = Pid, 358 | start_ref = StartRef, 359 | end_ref = EndRef, 360 | result = Res, 361 | impure_calls_exp = ImpureFuncExpected, 362 | last_call = LastCall 363 | } 364 | ) -> 365 | Msg = 366 | receive 367 | Msg0 -> 368 | io:format("Msg0: ~p\n", [Msg0]), 369 | io:format("Pid: ~p\n", [Pid]), 370 | Msg0 371 | end, 372 | case Res of 373 | none -> 374 | case Msg of 375 | {trace, Pid, exit, _} -> 376 | io:format("RECEIVED EXIT\n"), 377 | Res; 378 | % Controls that the start receive is not considered as impure 379 | {trace, Pid, 'receive', {start, StartRef}} -> 380 | is_pure_tracer(State); 381 | % Controls that the result send is not considered as impure 382 | {trace, Pid, send, {trace, Pid, result, _, EndRef}, _} -> 383 | is_pure_tracer(State); 384 | {trace, Pid, result, FRes, EndRef} -> 385 | case Res of 386 | none -> 387 | is_pure_tracer(State#pt_state{result = FRes}); 388 | _ -> 389 | case FRes of 390 | {edbc_error_call, _} -> 391 | is_pure_tracer(State#pt_state{result = FRes}); 392 | _ -> 393 | is_pure_tracer(State) 394 | end 395 | end; 396 | {trace, Pid, call, {M, F, Args}} -> 397 | Arity = length(Args), 398 | case erlang:is_builtin(M, F, Arity) of 399 | true -> 400 | PureBuiltIns = 401 | [{erlang, make_fun, 3}], 402 | case erl_bifs:is_pure(M, F, Arity) of 403 | false -> 404 | % io:format("Is not pure: ~p. Tolerance: ~p\n", [{M, F, Arity}, ImpureFuncExpected]), 405 | case lists:member({M, F, Arity}, PureBuiltIns) of 406 | false -> 407 | case ImpureFuncExpected of 408 | 0 -> 409 | InfoMsg = 410 | format( 411 | "It has call the impure BIF ~p:~p/~p" 412 | " when evaluating ~s.", 413 | [M, F, Arity, build_call_str(LastCall)]), 414 | is_pure_tracer(State#pt_state{result = {edbc_error, InfoMsg}}); 415 | _ -> 416 | is_pure_tracer(State#pt_state{impure_calls_exp = ImpureFuncExpected - 1}) 417 | end; 418 | true -> 419 | is_pure_tracer(State) 420 | end; 421 | true -> 422 | is_pure_tracer(#pt_state{last_call = [{M, F} | Args]}) 423 | end; 424 | false -> 425 | InteralImpureFuns = 426 | [ 427 | % {MFA, ExpectedImpureOperations} 428 | {{edbc_lib, put_st, 0}, 3}, 429 | {{edbc_lib, put_call, 1}, 1}, 430 | {{edbc_lib, put_already_tracing, 1}, 1} 431 | ], 432 | case [Expected || {ICall, Expected} <- InteralImpureFuns, {M, F, Arity} == ICall] of 433 | [] -> 434 | is_pure_tracer(#pt_state{last_call = [{M, F} | Args]}); 435 | [Exp] -> 436 | % io:format("MODIFY EXP: ~p\n", [Exp]), 437 | is_pure_tracer(State#pt_state{impure_calls_exp = Exp}) 438 | end 439 | end; 440 | {trace, Pid, return_to, _} -> 441 | is_pure_tracer(State); 442 | {trace, Pid, return_from, _, _} -> 443 | is_pure_tracer(State); 444 | Msg -> 445 | % io:format("Other: ~p\n", [Msg]), 446 | InfoMsg = 447 | format( 448 | "It has produced the impure action ~p when evaluating ~s.", 449 | [Msg, build_call_str(LastCall)]), 450 | is_pure_tracer(State#pt_state{result = {edbc_error, InfoMsg}}) 451 | end; 452 | _ -> 453 | % This makes the tracer to ignore further errors when the fisrt one is raised, i.e. only the first error is reported 454 | case Msg of 455 | {trace, Pid, exit, _} -> 456 | io:format("RECEIVED EXIT\n"), 457 | Res; 458 | _ -> 459 | io:format("Res: ~p\n", [Res]), 460 | io:format("Pid: ~p\n", [Pid]), 461 | is_pure_tracer(State) 462 | end 463 | end. 464 | 465 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 466 | % Put Info Functions 467 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 468 | 469 | put_st() -> 470 | put(edbc_st, get_stacktrace()). 471 | 472 | put_call(Args) -> 473 | put(edbc_cc, Args). 474 | 475 | put_already_tracing(Bool) -> 476 | put(already_tracing, Bool). 477 | 478 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 479 | % Printer functions 480 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 481 | 482 | get_stacktrace() -> 483 | tl(tl(try throw(42) catch 42 -> erlang:get_stacktrace() end)). 484 | 485 | build_call_str([{M, F} | Args]) -> 486 | format( 487 | "~p:~p(~s)", 488 | [M, F, string:join(convert_lst_str(Args), ", ")]); 489 | build_call_str([Fun | Args]) -> 490 | format( 491 | "~p(~s)", 492 | [Fun, string:join(convert_lst_str(Args), ", ")]). 493 | 494 | convert_lst_str(L) -> 495 | lists:map(fun convert_str/1,L). 496 | 497 | convert_str(E) -> 498 | format("~p",[E]). 499 | 500 | last_call_str() -> 501 | "Last call: " ++ simple_last_call_str(). 502 | 503 | simple_last_call_str() -> 504 | ModCall = 505 | case {get(edbc_st), get(edbc_cc)} of 506 | {[{Mod,_,_,[]} | _], [F | Args]} -> 507 | [{Mod, F} | Args]; 508 | {_, Call} -> 509 | Call 510 | end, 511 | build_call_str(ModCall). 512 | 513 | format(Str, Args) -> 514 | lists:flatten(io_lib:format(Str, Args)). 515 | 516 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 517 | % sheriff_call/2 518 | %%%%%%%%%%%%%%%%%%%%%%%%%%%% 519 | % This needs to be inlined 520 | % sheriff_check(Value, Type) -> 521 | % case sheriff:check(Value, Type) of 522 | % true -> 523 | % true; 524 | % false -> 525 | % InfoMsg = 526 | % lists:flatten( 527 | % io_lib:format( 528 | % "The value ~p is not of type ~p\n", 529 | % [Value, Type])), 530 | % {false, InfoMsg} 531 | % end. 532 | 533 | -------------------------------------------------------------------------------- /src/error_logger_mod.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% %CopyrightBegin% 3 | %% 4 | %% Copyright Ericsson AB 1996-2017. All Rights Reserved. 5 | %% 6 | %% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %% you may not use this file except in compliance with the License. 8 | %% You may obtain a copy of the License at 9 | %% 10 | %% http://www.apache.org/licenses/LICENSE-2.0 11 | %% 12 | %% Unless required by applicable law or agreed to in writing, software 13 | %% distributed under the License is distributed on an "AS IS" BASIS, 14 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %% See the License for the specific language governing permissions and 16 | %% limitations under the License. 17 | %% 18 | %% %CopyrightEnd% 19 | %% 20 | -module(error_logger_mod). 21 | 22 | -export([start/0,start_link/0,format/2,error_msg/1,error_msg/2,error_report/1, 23 | error_report/2,info_report/1,info_report/2,warning_report/1, 24 | warning_report/2,error_info/1, 25 | info_msg/1,info_msg/2,warning_msg/1,warning_msg/2, 26 | logfile/1,tty/1,swap_handler/1, 27 | add_report_handler/1,add_report_handler/2, 28 | delete_report_handler/1]). 29 | 30 | -export([init/1, 31 | handle_event/2, handle_call/2, handle_info/2, 32 | terminate/2]). 33 | 34 | -export([get_format_depth/0, limit_term/1]). 35 | 36 | -define(buffer_size, 10). 37 | 38 | %%----------------------------------------------------------------- 39 | %% Types used in this file 40 | %%----------------------------------------------------------------- 41 | 42 | -type msg_tag() :: 'error' | 'error_report' 43 | | 'info' | 'info_msg' | 'info_report' 44 | | 'warning_msg' | 'warning_report'. 45 | 46 | -type state() :: {non_neg_integer(), non_neg_integer(), [term()]}. 47 | 48 | %%% BIF 49 | 50 | -export([warning_map/0]). 51 | 52 | -spec warning_map() -> Tag when 53 | Tag :: error | warning | info. 54 | 55 | warning_map() -> 56 | erlang:nif_error(undef). 57 | 58 | %%% End of BIF 59 | 60 | %%----------------------------------------------------------------- 61 | 62 | -spec start() -> {'ok', pid()} | {'error', any()}. 63 | 64 | start() -> 65 | case gen_event:start({local, error_logger}) of 66 | {ok, Pid} -> 67 | simple_logger(?buffer_size), 68 | {ok, Pid}; 69 | Error -> Error 70 | end. 71 | 72 | -spec start_link() -> {'ok', pid()} | {'error', any()}. 73 | 74 | start_link() -> 75 | case gen_event:start_link({local, error_logger}) of 76 | {ok, Pid} -> 77 | simple_logger(?buffer_size), 78 | {ok, Pid}; 79 | Error -> Error 80 | end. 81 | 82 | %%----------------------------------------------------------------- 83 | %% These two simple old functions generate events tagged 'error' 84 | %% Used for simple messages; error or information. 85 | %%----------------------------------------------------------------- 86 | 87 | -spec error_msg(Format) -> 'ok' when 88 | Format :: string(). 89 | 90 | error_msg(Format) -> 91 | error_msg(Format,[]). 92 | 93 | -spec error_msg(Format, Data) -> 'ok' when 94 | Format :: string(), 95 | Data :: list(). 96 | 97 | error_msg(Format, Args) -> 98 | notify({error, group_leader(), {self(), Format, Args}}). 99 | 100 | -spec format(Format, Data) -> 'ok' when 101 | Format :: string(), 102 | Data :: list(). 103 | 104 | format(Format, Args) -> 105 | notify({error, group_leader(), {self(), Format, Args}}). 106 | 107 | %%----------------------------------------------------------------- 108 | %% This functions should be used for error reports. Events 109 | %% are tagged 'error_report'. 110 | %% The 'std_error' error_report type can always be used. 111 | %%----------------------------------------------------------------- 112 | 113 | -type report() :: 114 | [{Tag :: term(), Data :: term()} | term()] | string() | term(). 115 | 116 | -spec error_report(Report) -> 'ok' when 117 | Report :: report(). 118 | 119 | error_report(Report) -> 120 | error_report(std_error, Report). 121 | 122 | -spec error_report(Type, Report) -> 'ok' when 123 | Type :: term(), 124 | Report :: report(). 125 | 126 | error_report(Type, Report) -> 127 | notify({error_report, group_leader(), {self(), Type, Report}}). 128 | 129 | %%----------------------------------------------------------------- 130 | %% This function should be used for warning reports. 131 | %% These might be mapped to error reports or info reports, 132 | %% depending on emulator flags. Events that ore not mapped 133 | %% are tagged 'info_report'. 134 | %% The 'std_warning' info_report type can always be used and is 135 | %% mapped to std_info or std_error accordingly. 136 | %%----------------------------------------------------------------- 137 | 138 | -spec warning_report(Report) -> 'ok' when 139 | Report :: report(). 140 | 141 | warning_report(Report) -> 142 | warning_report(std_warning, Report). 143 | 144 | -spec warning_report(Type, Report) -> 'ok' when 145 | Type :: any(), 146 | Report :: report(). 147 | 148 | warning_report(Type, Report) -> 149 | {Tag, NType} = case error_logger:warning_map() of 150 | info -> 151 | if 152 | Type =:= std_warning -> 153 | {info_report, std_info}; 154 | true -> 155 | {info_report, Type} 156 | end; 157 | warning -> 158 | {warning_report, Type}; 159 | error -> 160 | if 161 | Type =:= std_warning -> 162 | {error_report, std_error}; 163 | true -> 164 | {error_report, Type} 165 | end 166 | end, 167 | notify({Tag, group_leader(), {self(), NType, Report}}). 168 | 169 | %%----------------------------------------------------------------- 170 | %% This function provides similar functions as error_msg for 171 | %% warning messages, like warning report it might get mapped to 172 | %% other types of reports. 173 | %%----------------------------------------------------------------- 174 | 175 | -spec warning_msg(Format) -> 'ok' when 176 | Format :: string(). 177 | 178 | warning_msg(Format) -> 179 | warning_msg(Format,[]). 180 | 181 | -spec warning_msg(Format, Data) -> 'ok' when 182 | Format :: string(), 183 | Data :: list(). 184 | 185 | warning_msg(Format, Args) -> 186 | Tag = case error_logger:warning_map() of 187 | warning -> 188 | warning_msg; 189 | info -> 190 | info_msg; 191 | error -> 192 | error 193 | end, 194 | notify({Tag, group_leader(), {self(), Format, Args}}). 195 | 196 | %%----------------------------------------------------------------- 197 | %% This function should be used for information reports. Events 198 | %% are tagged 'info_report'. 199 | %% The 'std_info' info_report type can always be used. 200 | %%----------------------------------------------------------------- 201 | 202 | -spec info_report(Report) -> 'ok' when 203 | Report :: report(). 204 | 205 | info_report(Report) -> 206 | info_report(std_info, Report). 207 | 208 | -spec info_report(Type, Report) -> 'ok' when 209 | Type :: any(), 210 | Report :: report(). 211 | 212 | info_report(Type, Report) -> 213 | notify({info_report, group_leader(), {self(), Type, Report}}). 214 | 215 | %%----------------------------------------------------------------- 216 | %% This function provides similar functions as error_msg for 217 | %% information messages. 218 | %%----------------------------------------------------------------- 219 | 220 | -spec info_msg(Format) -> 'ok' when 221 | Format :: string(). 222 | 223 | info_msg(Format) -> 224 | info_msg(Format,[]). 225 | 226 | -spec info_msg(Format, Data) -> 'ok' when 227 | Format :: string(), 228 | Data :: list(). 229 | 230 | info_msg(Format, Args) -> 231 | notify({info_msg, group_leader(), {self(), Format, Args}}). 232 | 233 | %%----------------------------------------------------------------- 234 | %% Used by the init process. Events are tagged 'info'. 235 | %%----------------------------------------------------------------- 236 | 237 | -spec error_info(Error :: any()) -> 'ok'. 238 | 239 | error_info(Error) -> 240 | notify({info, group_leader(), {self(), Error, []}}). 241 | 242 | -spec notify({msg_tag(), pid(), {pid(), any(), any()}}) -> 'ok'. 243 | 244 | notify(Msg) -> 245 | gen_event:notify(error_logger, Msg). 246 | 247 | -type swap_handler_type() :: 'false' | 'silent' | 'tty' | {'logfile', string()}. 248 | -spec swap_handler(Type :: swap_handler_type()) -> any(). 249 | 250 | swap_handler(tty) -> 251 | R = gen_event:swap_handler(error_logger, {error_logger, swap}, 252 | {error_logger_tty_h, []}), 253 | ok = simple_logger(), 254 | R; 255 | swap_handler({logfile, File}) -> 256 | R = gen_event:swap_handler(error_logger, {error_logger, swap}, 257 | {error_logger_file_h, File}), 258 | ok = simple_logger(), 259 | R; 260 | swap_handler(silent) -> 261 | _ = gen_event:delete_handler(error_logger, error_logger, delete), 262 | ok = simple_logger(); 263 | swap_handler(false) -> 264 | ok. % keep primitive event handler as-is 265 | 266 | -spec add_report_handler(Handler) -> any() when 267 | Handler :: module(). 268 | 269 | add_report_handler(Module) when is_atom(Module) -> 270 | gen_event:add_handler(error_logger, Module, []). 271 | 272 | -spec add_report_handler(Handler, Args) -> Result when 273 | Handler :: module(), 274 | Args :: gen_event:handler_args(), 275 | Result :: gen_event:add_handler_ret(). 276 | 277 | add_report_handler(Module, Args) when is_atom(Module) -> 278 | gen_event:add_handler(error_logger, Module, Args). 279 | 280 | -spec delete_report_handler(Handler) -> Result when 281 | Handler :: module(), 282 | Result :: gen_event:del_handler_ret(). 283 | 284 | delete_report_handler(Module) when is_atom(Module) -> 285 | gen_event:delete_handler(error_logger, Module, []). 286 | 287 | %% Start the lowest level error_logger handler with Buffer. 288 | 289 | simple_logger(Buffer_size) when is_integer(Buffer_size) -> 290 | gen_event:add_handler(error_logger, error_logger, Buffer_size). 291 | 292 | %% Start the lowest level error_logger handler without Buffer. 293 | 294 | simple_logger() -> 295 | gen_event:add_handler(error_logger, error_logger, []). 296 | 297 | %% Log all errors to File for all eternity 298 | 299 | -type open_error() :: file:posix() | badarg | system_limit. 300 | 301 | -spec logfile(Request :: {open, Filename}) -> ok | {error, OpenReason} when 302 | Filename ::file:name(), 303 | OpenReason :: allready_have_logfile | open_error() 304 | ; (Request :: close) -> ok | {error, CloseReason} when 305 | CloseReason :: module_not_found 306 | ; (Request :: filename) -> Filename | {error, FilenameReason} when 307 | Filename :: file:name(), 308 | FilenameReason :: no_log_file. 309 | 310 | logfile({open, File}) -> 311 | case lists:member(error_logger_file_h, 312 | gen_event:which_handlers(error_logger)) of 313 | true -> 314 | {error, allready_have_logfile}; 315 | _ -> 316 | gen_event:add_handler(error_logger, error_logger_file_h, File) 317 | end; 318 | logfile(close) -> 319 | case gen_event:delete_handler(error_logger, error_logger_file_h, normal) of 320 | {error,Reason} -> 321 | {error,Reason}; 322 | _ -> 323 | ok 324 | end; 325 | logfile(filename) -> 326 | case gen_event:call(error_logger, error_logger_file_h, filename) of 327 | {error,_} -> 328 | {error, no_log_file}; 329 | Val -> 330 | Val 331 | end. 332 | 333 | %% Possibly turn off all tty printouts, maybe we only want the errors 334 | %% to go to a file 335 | 336 | -spec tty(Flag) -> 'ok' when 337 | Flag :: boolean(). 338 | 339 | tty(true) -> 340 | Hs = gen_event:which_handlers(error_logger), 341 | case lists:member(error_logger_tty_h, Hs) of 342 | false -> 343 | gen_event:add_handler(error_logger, error_logger_tty_h, []); 344 | true -> 345 | ignore 346 | end, 347 | ok; 348 | tty(false) -> 349 | gen_event:delete_handler(error_logger, error_logger_tty_h, []), 350 | ok. 351 | 352 | 353 | %%% --------------------------------------------------- 354 | %%% This is the default error_logger handler. 355 | %%% --------------------------------------------------- 356 | 357 | -spec init(term()) -> {'ok', state() | []}. 358 | 359 | init(Max) when is_integer(Max) -> 360 | {ok, {Max, 0, []}}; 361 | %% This one is called if someone took over from us, and now wants to 362 | %% go back. 363 | init({go_back, _PostState}) -> 364 | {ok, {?buffer_size, 0, []}}; 365 | init(_) -> 366 | %% The error logger process may receive a huge amount of 367 | %% messages. Make sure that they are stored off heap to 368 | %% avoid exessive GCs. 369 | process_flag(message_queue_data, off_heap), 370 | {ok, []}. 371 | 372 | -spec handle_event(term(), state()) -> {'ok', state()}. 373 | 374 | handle_event({Type, GL, Msg}, State) when node(GL) =/= node() -> 375 | gen_event:notify({error_logger, node(GL)},{Type, GL, Msg}), 376 | %% handle_event2({Type, GL, Msg}, State); %% Shall we do something 377 | {ok, State}; %% at this node too ??? 378 | handle_event({info_report, _, {_, Type, _}}, State) when Type =/= std_info -> 379 | {ok, State}; %% Ignore other info reports here 380 | handle_event(Event, State) -> 381 | handle_event2(Event, State). 382 | 383 | -spec handle_info(term(), state()) -> {'ok', state()}. 384 | 385 | handle_info({emulator, GL, Chars}, State) when node(GL) =/= node() -> 386 | {error_logger, node(GL)} ! {emulator, GL, add_node(Chars,self())}, 387 | {ok, State}; 388 | handle_info({emulator, GL, Chars}, State) -> 389 | handle_event2({emulator, GL, Chars}, State); 390 | handle_info(_, State) -> 391 | {ok, State}. 392 | 393 | -spec handle_call(term(), state()) -> {'ok', {'error', 'bad_query'}, state()}. 394 | 395 | handle_call(_Query, State) -> {ok, {error, bad_query}, State}. 396 | 397 | -spec terminate(term(), state()) -> {'error_logger', [term()]}. 398 | 399 | terminate(swap, {_, 0, Buff}) -> 400 | {error_logger, Buff}; 401 | terminate(swap, {_, Lost, Buff}) -> 402 | Myevent = {info, group_leader(), {self(), {lost_messages, Lost}, []}}, 403 | {error_logger, [tag_event(Myevent)|Buff]}; 404 | terminate(_, _) -> 405 | {error_logger, []}. 406 | 407 | handle_event2(Event, {1, Lost, Buff}) -> 408 | display(tag_event(Event)), 409 | {ok, {1, Lost+1, Buff}}; 410 | handle_event2(Event, {N, Lost, Buff}) -> 411 | Tagged = tag_event(Event), 412 | display(Tagged), 413 | {ok, {N-1, Lost, [Tagged|Buff]}}; 414 | handle_event2(_, State) -> 415 | {ok, State}. 416 | 417 | tag_event(Event) -> 418 | {erlang:localtime(), Event}. 419 | 420 | display({Tag,{error,_,{_,Format,Args}}}) -> 421 | display2(Tag,Format,Args); 422 | display({Tag,{error_report,_,{_,Type,Report}}}) -> 423 | display2(Tag,Type,Report); 424 | display({Tag,{info_report,_,{_,Type,Report}}}) -> 425 | display2(Tag,Type,Report); 426 | display({Tag,{info,_,{_,Error,_}}}) -> 427 | display2(Tag,Error,[]); 428 | display({Tag,{info_msg,_,{_,Format,Args}}}) -> 429 | display2(Tag,Format,Args); 430 | display({Tag,{warning_report,_,{_,Type,Report}}}) -> 431 | display2(Tag,Type,Report); 432 | display({Tag,{warning_msg,_,{_,Format,Args}}}) -> 433 | display2(Tag,Format,Args); 434 | display({Tag,{emulator,_,Chars}}) -> 435 | display2(Tag,Chars,[]). 436 | 437 | add_node(X, Pid) when is_atom(X) -> 438 | add_node(atom_to_list(X), Pid); 439 | add_node(X, Pid) -> 440 | lists:concat([X,"** at node ",node(Pid)," **~n"]). 441 | 442 | %% Can't do io_lib:format 443 | 444 | display2({{_Y,_Mo,_D},{_H,_Mi,_S}} = Date, F, A) -> 445 | display_date(Date), 446 | display3(string_p(F), F, A). 447 | 448 | display_date({{Y,Mo,D},{H,Mi,S}}) -> 449 | erlang:display_string( 450 | integer_to_list(Y) ++ "-" ++ 451 | two_digits(Mo) ++ "-" ++ 452 | two_digits(D) ++ " " ++ 453 | two_digits(H) ++ ":" ++ 454 | two_digits(Mi) ++ ":" ++ 455 | two_digits(S) ++ " "). 456 | 457 | two_digits(N) when 0 =< N, N =< 9 -> 458 | [$0, $0 + N]; 459 | two_digits(N) -> 460 | integer_to_list(N). 461 | 462 | display3(true, F, A) -> 463 | %% Format string with arguments 464 | erlang:display_string(F ++ "\n"), 465 | [begin 466 | erlang:display_string("\t"), 467 | erlang:display(Arg) 468 | end || Arg <- A], 469 | ok; 470 | display3(false, Atom, A) when is_atom(Atom) -> 471 | %% The widest atom seems to be 'supervisor_report' at 17. 472 | ColumnWidth = 20, 473 | AtomString = atom_to_list(Atom), 474 | AtomLength = length(AtomString), 475 | Padding = lists:duplicate(ColumnWidth - AtomLength, $\s), 476 | erlang:display_string(AtomString ++ Padding), 477 | display4(A); 478 | display3(_, F, A) -> 479 | erlang:display({F, A}). 480 | 481 | display4([A, []]) -> 482 | %% Not sure why crash reports look like this. 483 | display4(A); 484 | display4(A = [_|_]) -> 485 | case lists:all(fun({Key,_Value}) -> is_atom(Key); (_) -> false end, A) of 486 | true -> 487 | erlang:display_string("\n"), 488 | lists:foreach( 489 | fun({Key, Value}) -> 490 | erlang:display_string( 491 | " " ++ 492 | atom_to_list(Key) ++ 493 | ": "), 494 | erlang:display(Value) 495 | end, A); 496 | false -> 497 | erlang:display(A) 498 | end; 499 | display4(A) -> 500 | erlang:display(A). 501 | 502 | string_p([]) -> 503 | false; 504 | string_p(Term) -> 505 | string_p1(Term). 506 | 507 | string_p1([H|T]) when is_integer(H), H >= $\s, H < 255 -> 508 | string_p1(T); 509 | string_p1([$\n|T]) -> string_p1(T); 510 | string_p1([$\r|T]) -> string_p1(T); 511 | string_p1([$\t|T]) -> string_p1(T); 512 | string_p1([$\v|T]) -> string_p1(T); 513 | string_p1([$\b|T]) -> string_p1(T); 514 | string_p1([$\f|T]) -> string_p1(T); 515 | string_p1([$\e|T]) -> string_p1(T); 516 | string_p1([H|T]) when is_list(H) -> 517 | case string_p1(H) of 518 | true -> string_p1(T); 519 | _ -> false 520 | end; 521 | string_p1([]) -> true; 522 | string_p1(_) -> false. 523 | 524 | -spec limit_term(term()) -> term(). 525 | 526 | limit_term(Term) -> 527 | case get_format_depth() of 528 | unlimited -> Term; 529 | D -> io_lib:limit_term(Term, D) 530 | end. 531 | 532 | -spec get_format_depth() -> 'unlimited' | pos_integer(). 533 | 534 | get_format_depth() -> 535 | case application:get_env(kernel, error_logger_format_depth) of 536 | {ok, Depth} when is_integer(Depth) -> 537 | max(10, Depth); 538 | undefined -> 539 | unlimited 540 | end. -------------------------------------------------------------------------------- /src/gen_mod.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% %CopyrightBegin% 3 | %% 4 | %% Copyright Ericsson AB 1996-2016. All Rights Reserved. 5 | %% 6 | %% Licensed under the Apache License, Version 2.0 (the "License"); 7 | %% you may not use this file except in compliance with the License. 8 | %% You may obtain a copy of the License at 9 | %% 10 | %% http://www.apache.org/licenses/LICENSE-2.0 11 | %% 12 | %% Unless required by applicable law or agreed to in writing, software 13 | %% distributed under the License is distributed on an "AS IS" BASIS, 14 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | %% See the License for the specific language governing permissions and 16 | %% limitations under the License. 17 | %% 18 | %% %CopyrightEnd% 19 | %% 20 | -module(gen_mod). 21 | -compile({inline,[get_node/1]}). 22 | 23 | %%%----------------------------------------------------------------- 24 | %%% This module implements the really generic stuff of the generic 25 | %%% standard behaviours (e.g. gen_server, gen_fsm). 26 | %%% 27 | %%% The standard behaviour should export init_it/6. 28 | %%%----------------------------------------------------------------- 29 | -export([start/5, start/6, debug_options/2, hibernate_after/1, 30 | name/1, unregister_name/1, get_proc_name/1, get_parent/0, 31 | call/3, call/4, reply/2, stop/1, stop/3]). 32 | 33 | -export([init_it/6, init_it/7]). 34 | 35 | -export([format_status_header/2]). 36 | 37 | -define(default_timeout, 5000). 38 | 39 | %%----------------------------------------------------------------- 40 | 41 | -type linkage() :: 'link' | 'nolink'. 42 | -type emgr_name() :: {'local', atom()} 43 | | {'global', term()} 44 | | {'via', Module :: module(), Name :: term()}. 45 | 46 | -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. 47 | 48 | -type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug' 49 | | {'logfile', string()}. 50 | -type option() :: {'timeout', timeout()} 51 | | {'debug', [debug_flag()]} 52 | | {'spawn_opt', [proc_lib_mod:spawn_option()]}. 53 | -type options() :: [option()]. 54 | 55 | %%----------------------------------------------------------------- 56 | %% Starts a generic process. 57 | %% start(GenMod, LinkP, Mod, Args, Options) 58 | %% start(GenMod, LinkP, Name, Mod, Args, Options) 59 | %% GenMod = atom(), callback module implementing the 'real' fsm 60 | %% LinkP = link | nolink 61 | %% Name = {local, atom()} | {global, term()} | {via, atom(), term()} 62 | %% Args = term(), init arguments (to Mod:init/1) 63 | %% Options = [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt, OptionList}] 64 | %% Flag = trace | log | {logfile, File} | statistics | debug 65 | %% (debug == log && statistics) 66 | %% Returns: {ok, Pid} | ignore |{error, Reason} | 67 | %% {error, {already_started, Pid}} | 68 | %% The 'already_started' is returned only if Name is given 69 | %%----------------------------------------------------------------- 70 | 71 | -spec start(module(), linkage(), emgr_name(), module(), term(), options()) -> 72 | start_ret(). 73 | 74 | start(GenMod, LinkP, Name, Mod, Args, Options) -> 75 | case where(Name) of 76 | undefined -> 77 | do_spawn(GenMod, LinkP, Name, Mod, Args, Options); 78 | Pid -> 79 | {error, {already_started, Pid}} 80 | end. 81 | 82 | -spec start(module(), linkage(), module(), term(), options()) -> start_ret(). 83 | 84 | start(GenMod, LinkP, Mod, Args, Options) -> 85 | do_spawn(GenMod, LinkP, Mod, Args, Options). 86 | 87 | %%----------------------------------------------------------------- 88 | %% Spawn the process (and link) maybe at another node. 89 | %% If spawn without link, set parent to ourselves 'self'!!! 90 | %%----------------------------------------------------------------- 91 | do_spawn(GenMod, link, Mod, Args, Options) -> 92 | Time = timeout(Options), 93 | proc_lib_mod:start_link(?MODULE, init_it, 94 | [GenMod, self(), self(), Mod, Args, Options], 95 | Time, 96 | spawn_opts(Options)); 97 | do_spawn(GenMod, _, Mod, Args, Options) -> 98 | Time = timeout(Options), 99 | proc_lib_mod:start(?MODULE, init_it, 100 | [GenMod, self(), self, Mod, Args, Options], 101 | Time, 102 | spawn_opts(Options)). 103 | 104 | do_spawn(GenMod, link, Name, Mod, Args, Options) -> 105 | Time = timeout(Options), 106 | proc_lib_mod:start_link(?MODULE, init_it, 107 | [GenMod, self(), self(), Name, Mod, Args, Options], 108 | Time, 109 | spawn_opts(Options)); 110 | do_spawn(GenMod, _, Name, Mod, Args, Options) -> 111 | Time = timeout(Options), 112 | proc_lib_mod:start(?MODULE, init_it, 113 | [GenMod, self(), self, Name, Mod, Args, Options], 114 | Time, 115 | spawn_opts(Options)). 116 | 117 | %%----------------------------------------------------------------- 118 | %% Initiate the new process. 119 | %% Register the name using the Rfunc function 120 | %% Calls the Mod:init/Args function. 121 | %% Finally an acknowledge is sent to Parent and the main 122 | %% loop is entered. 123 | %%----------------------------------------------------------------- 124 | init_it(GenMod, Starter, Parent, Mod, Args, Options) -> 125 | init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options). 126 | 127 | init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) -> 128 | case register_name(Name) of 129 | true -> 130 | init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options); 131 | {false, Pid} -> 132 | proc_lib_mod:init_ack(Starter, {error, {already_started, Pid}}) 133 | end. 134 | 135 | init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) -> 136 | GenMod:init_it(Starter, Parent, Name, Mod, Args, Options). 137 | 138 | %%----------------------------------------------------------------- 139 | %% Makes a synchronous call to a generic process. 140 | %% Request is sent to the Pid, and the response must be 141 | %% {Tag, _, Reply}. 142 | %%----------------------------------------------------------------- 143 | 144 | %%% New call function which uses the new monitor BIF 145 | %%% call(ServerId, Label, Request) 146 | 147 | call(Process, Label, Request) -> 148 | call(Process, Label, Request, ?default_timeout). 149 | 150 | call(Process, Label, Request, Timeout) 151 | when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 -> 152 | Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end, 153 | do_for_proc(Process, Fun). 154 | 155 | do_call(Process, Label, Request, Timeout) -> 156 | try erlang:monitor(process, Process) of 157 | Mref -> 158 | %% If the monitor/2 call failed to set up a connection to a 159 | %% remote node, we don't want the '!' operator to attempt 160 | %% to set up the connection again. (If the monitor/2 call 161 | %% failed due to an expired timeout, '!' too would probably 162 | %% have to wait for the timeout to expire.) Therefore, 163 | %% use erlang:send/3 with the 'noconnect' option so that it 164 | %% will fail immediately if there is no connection to the 165 | %% remote node. 166 | 167 | catch erlang:send(Process, {Label, {self(), Mref}, Request}, 168 | [noconnect]), 169 | receive 170 | {Mref, Reply} -> 171 | erlang:demonitor(Mref, [flush]), 172 | {ok, Reply}; 173 | {'DOWN', Mref, _, _, noconnection} -> 174 | Node = get_node(Process), 175 | exit({nodedown, Node}); 176 | {'DOWN', Mref, _, _, Reason} -> 177 | exit(Reason) 178 | after Timeout -> 179 | erlang:demonitor(Mref, [flush]), 180 | exit(timeout) 181 | end 182 | catch 183 | error:_ -> 184 | %% Node (C/Java?) is not supporting the monitor. 185 | %% The other possible case -- this node is not distributed 186 | %% -- should have been handled earlier. 187 | %% Do the best possible with monitor_node/2. 188 | %% This code may hang indefinitely if the Process 189 | %% does not exist. It is only used for featureweak remote nodes. 190 | Node = get_node(Process), 191 | monitor_node(Node, true), 192 | receive 193 | {nodedown, Node} -> 194 | monitor_node(Node, false), 195 | exit({nodedown, Node}) 196 | after 0 -> 197 | Tag = make_ref(), 198 | Process ! {Label, {self(), Tag}, Request}, 199 | wait_resp(Node, Tag, Timeout) 200 | end 201 | end. 202 | 203 | get_node(Process) -> 204 | %% We trust the arguments to be correct, i.e 205 | %% Process is either a local or remote pid, 206 | %% or a {Name, Node} tuple (of atoms) and in this 207 | %% case this node (node()) _is_ distributed and Node =/= node(). 208 | case Process of 209 | {_S, N} when is_atom(N) -> 210 | N; 211 | _ when is_pid(Process) -> 212 | node(Process) 213 | end. 214 | 215 | wait_resp(Node, Tag, Timeout) -> 216 | receive 217 | {Tag, Reply} -> 218 | monitor_node(Node, false), 219 | {ok, Reply}; 220 | {nodedown, Node} -> 221 | monitor_node(Node, false), 222 | exit({nodedown, Node}) 223 | after Timeout -> 224 | monitor_node(Node, false), 225 | exit(timeout) 226 | end. 227 | 228 | %% 229 | %% Send a reply to the client. 230 | %% 231 | reply({To, Tag}, Reply) -> 232 | Msg = {Tag, Reply}, 233 | try To ! Msg catch _:_ -> Msg end. 234 | 235 | %%----------------------------------------------------------------- 236 | %% Syncronously stop a generic process 237 | %%----------------------------------------------------------------- 238 | stop(Process) -> 239 | stop(Process, normal, infinity). 240 | 241 | stop(Process, Reason, Timeout) 242 | when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 -> 243 | Fun = fun(Pid) -> proc_lib_mod:stop(Pid, Reason, Timeout) end, 244 | do_for_proc(Process, Fun). 245 | 246 | %%----------------------------------------------------------------- 247 | %% Map different specifications of a process to either Pid or 248 | %% {Name,Node}. Execute the given Fun with the process as only 249 | %% argument. 250 | %% ----------------------------------------------------------------- 251 | 252 | %% Local or remote by pid 253 | do_for_proc(Pid, Fun) when is_pid(Pid) -> 254 | Fun(Pid); 255 | %% Local by name 256 | do_for_proc(Name, Fun) when is_atom(Name) -> 257 | case whereis(Name) of 258 | Pid when is_pid(Pid) -> 259 | Fun(Pid); 260 | undefined -> 261 | exit(noproc) 262 | end; 263 | %% Global by name 264 | do_for_proc(Process, Fun) 265 | when ((tuple_size(Process) == 2 andalso element(1, Process) == global) 266 | orelse 267 | (tuple_size(Process) == 3 andalso element(1, Process) == via)) -> 268 | case where(Process) of 269 | Pid when is_pid(Pid) -> 270 | Node = node(Pid), 271 | try Fun(Pid) 272 | catch 273 | exit:{nodedown, Node} -> 274 | %% A nodedown not yet detected by global, 275 | %% pretend that it was. 276 | exit(noproc) 277 | end; 278 | undefined -> 279 | exit(noproc) 280 | end; 281 | %% Local by name in disguise 282 | do_for_proc({Name, Node}, Fun) when Node =:= node() -> 283 | do_for_proc(Name, Fun); 284 | %% Remote by name 285 | do_for_proc({_Name, Node} = Process, Fun) when is_atom(Node) -> 286 | if 287 | node() =:= nonode@nohost -> 288 | exit({nodedown, Node}); 289 | true -> 290 | Fun(Process) 291 | end. 292 | 293 | 294 | %%%----------------------------------------------------------------- 295 | %%% Misc. functions. 296 | %%%----------------------------------------------------------------- 297 | where({global, Name}) -> global:whereis_name(Name); 298 | where({via, Module, Name}) -> Module:whereis_name(Name); 299 | where({local, Name}) -> whereis(Name). 300 | 301 | register_name({local, Name} = LN) -> 302 | try register(Name, self()) of 303 | true -> true 304 | catch 305 | error:_ -> 306 | {false, where(LN)} 307 | end; 308 | register_name({global, Name} = GN) -> 309 | case global:register_name(Name, self()) of 310 | yes -> true; 311 | no -> {false, where(GN)} 312 | end; 313 | register_name({via, Module, Name} = GN) -> 314 | case Module:register_name(Name, self()) of 315 | yes -> 316 | true; 317 | no -> 318 | {false, where(GN)} 319 | end. 320 | 321 | name({local,Name}) -> Name; 322 | name({global,Name}) -> Name; 323 | name({via,_, Name}) -> Name; 324 | name(Pid) when is_pid(Pid) -> Pid. 325 | 326 | unregister_name({local,Name}) -> 327 | try unregister(Name) of 328 | _ -> ok 329 | catch 330 | _:_ -> ok 331 | end; 332 | unregister_name({global,Name}) -> 333 | _ = global:unregister_name(Name), 334 | ok; 335 | unregister_name({via, Mod, Name}) -> 336 | _ = Mod:unregister_name(Name), 337 | ok; 338 | unregister_name(Pid) when is_pid(Pid) -> 339 | ok. 340 | 341 | get_proc_name(Pid) when is_pid(Pid) -> 342 | Pid; 343 | get_proc_name({local, Name}) -> 344 | case process_info(self(), registered_name) of 345 | {registered_name, Name} -> 346 | Name; 347 | {registered_name, _Name} -> 348 | exit(process_not_registered); 349 | [] -> 350 | exit(process_not_registered) 351 | end; 352 | get_proc_name({global, Name}) -> 353 | case global:whereis_name(Name) of 354 | undefined -> 355 | exit(process_not_registered_globally); 356 | Pid when Pid =:= self() -> 357 | Name; 358 | _Pid -> 359 | exit(process_not_registered_globally) 360 | end; 361 | get_proc_name({via, Mod, Name}) -> 362 | case Mod:whereis_name(Name) of 363 | undefined -> 364 | exit({process_not_registered_via, Mod}); 365 | Pid when Pid =:= self() -> 366 | Name; 367 | _Pid -> 368 | exit({process_not_registered_via, Mod}) 369 | end. 370 | 371 | get_parent() -> 372 | case get('$ancestors') of 373 | [Parent | _] when is_pid(Parent) -> 374 | Parent; 375 | [Parent | _] when is_atom(Parent) -> 376 | name_to_pid(Parent); 377 | _ -> 378 | exit(process_was_not_started_by_proc_lib) 379 | end. 380 | 381 | name_to_pid(Name) -> 382 | case whereis(Name) of 383 | undefined -> 384 | case global:whereis_name(Name) of 385 | undefined -> 386 | exit(could_not_find_registered_name); 387 | Pid -> 388 | Pid 389 | end; 390 | Pid -> 391 | Pid 392 | end. 393 | 394 | 395 | timeout(Options) -> 396 | case lists:keyfind(timeout, 1, Options) of 397 | {_,Time} -> 398 | Time; 399 | false -> 400 | infinity 401 | end. 402 | 403 | spawn_opts(Options) -> 404 | case lists:keyfind(spawn_opt, 1, Options) of 405 | {_,Opts} -> 406 | Opts; 407 | false -> 408 | [] 409 | end. 410 | 411 | hibernate_after(Options) -> 412 | case lists:keyfind(hibernate_after, 1, Options) of 413 | {_,HibernateAfterTimeout} -> 414 | HibernateAfterTimeout; 415 | false -> 416 | infinity 417 | end. 418 | 419 | debug_options(Name, Opts) -> 420 | case lists:keyfind(debug, 1, Opts) of 421 | {_,Options} -> 422 | try sys:debug_options(Options) 423 | catch _:_ -> 424 | error_logger:format( 425 | "~p: ignoring erroneous debug options - ~p~n", 426 | [Name,Options]), 427 | [] 428 | end; 429 | false -> 430 | [] 431 | end. 432 | 433 | format_status_header(TagLine, Pid) when is_pid(Pid) -> 434 | lists:concat([TagLine, " ", pid_to_list(Pid)]); 435 | format_status_header(TagLine, RegName) when is_atom(RegName) -> 436 | lists:concat([TagLine, " ", RegName]); 437 | format_status_header(TagLine, Name) -> 438 | {TagLine, Name}. --------------------------------------------------------------------------------