diff options
Diffstat (limited to 'lib/stdlib/src')
30 files changed, 688 insertions, 398 deletions
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index fdfbb2e998..e9a5e6831e 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -224,7 +224,7 @@ version(File) -> MD5 :: binary(). md5(File) -> - case catch read_significant_chunks(File) of + case catch read_significant_chunks(File, md5_chunks()) of {ok, {Module, Chunks0}} -> Chunks = filter_funtab(Chunks0), {ok, {Module, erlang:md5([C || {_Id, C} <- Chunks])}}; @@ -395,7 +395,7 @@ strip_fils(Files) -> %% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) strip_file(File) -> - {ok, {Mod, Chunks}} = read_significant_chunks(File), + {ok, {Mod, Chunks}} = read_significant_chunks(File, significant_chunks()), {ok, Stripped0} = build_module(Chunks), Stripped = compress(Stripped0), case File of @@ -453,8 +453,8 @@ is_useless_chunk("CInf") -> true; is_useless_chunk(_) -> false. %% -> {ok, {Module, Chunks}} | throw(Error) -read_significant_chunks(File) -> - case read_chunk_data(File, significant_chunks(), [allow_missing_chunks]) of +read_significant_chunks(File, ChunkList) -> + case read_chunk_data(File, ChunkList, [allow_missing_chunks]) of {ok, {Module, Chunks0}} -> Mandatory = mandatory_chunks(), Chunks = filter_significant_chunks(Chunks0, Mandatory, File, Module), @@ -835,12 +835,15 @@ file_error(FileName, {error, Reason}) -> error(Reason) -> throw({error, ?MODULE, Reason}). - -%% The following chunks are significant when calculating the MD5 for a module, -%% and also the modules that must be retained when stripping a file. -%% They are listed in the order that they should be MD5:ed. +%% The following chunks must be kept when stripping a BEAM file. significant_chunks() -> + ["Line" | md5_chunks()]. + +%% The following chunks are significant when calculating the MD5 +%% for a module. They are listed in the order that they should be MD5:ed. + +md5_chunks() -> ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"]. %% The following chunks are mandatory in every Beam file. diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index febfdd6285..a920921a5e 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -797,7 +797,7 @@ appcall(App, M, F, Args) -> catch error:undef -> case erlang:get_stacktrace() of - [{M,F,Args}|_] -> + [{M,F,Args,_}|_] -> Arity = length(Args), io:format("Call to ~w:~w/~w in application ~w failed.\n", [M,F,Arity,App]); diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index fa0641ffd9..c0f9ce34b0 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1754,17 +1754,6 @@ system_code_change(State, _Module, _OldVsn, _Extra) -> %%% Internal functions %%%---------------------------------------------------------------------- -constants(FH, FileName) -> - Version = FH#fileheader.version, - if - Version =< 8 -> - dets_v8:constants(); - Version =:= 9 -> - dets_v9:constants(); - true -> - throw({error, {not_a_dets_file, FileName}}) - end. - %% -> {ok, Fd, fileheader()} | throw(Error) read_file_header(FileName, Access, RamFile) -> BF = if @@ -1842,7 +1831,11 @@ do_bchunk_init(Head, Tab) -> {H2, {error, old_version}}; Parms -> L = dets_utils:all_allocated(H2), - C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L}, + Bin = if + L =:= <<>> -> eof; + true -> <<>> + end, + C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L}, BinParms = term_to_binary(Parms), {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk}, [BinParms]}} @@ -2475,10 +2468,23 @@ fopen2(Fname, Tab) -> %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {error, not_closed} -> - io:format(user,"dets: file ~p not properly closed, " - "repairing ...~n", [Fname]), + Do = case Mod:check_file_header(FH, Fd) of + {ok, Head1, ExtraInfo} -> + Head2 = Head1#head{filename = Fname}, + try {ok, Mod:init_freelist(Head2, ExtraInfo)} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + {error, not_closed} -> + M = " not properly closed, repairing ...", + {repair, M}; + Else -> + Else + end, + case Do of + {repair, Mess} -> + io:format(user, "dets: file ~p~s~n", [Fname, Mess]), Version = default, case fsck(Fd, Tab, Fname, FH, default, default, Version) of ok -> @@ -2486,9 +2492,9 @@ fopen2(Fname, Tab) -> Error -> throw(Error) end; - {ok, Head, ExtraInfo} -> + {ok, Head} -> open_final(Head, Fname, Acc, Ram, ?DEFAULT_CACHE, - Tab, ExtraInfo, false); + Tab, false); {error, Reason} -> throw({error, {Reason, Fname}}) end; @@ -2520,12 +2526,13 @@ fopen_existing_file(Tab, OpenArgs) -> V9 = (Version =:= 9) or (Version =:= default), MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots), MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots), - Do = case (FH#fileheader.mod):check_file_header(FH, Fd) of + Mod = (FH#fileheader.mod), + Wh = case Mod:check_file_header(FH, Fd) of {ok, Head, true} when Rep =:= force, Acc =:= read_write, FH#fileheader.version =:= 9, FH#fileheader.no_colls =/= undefined, MinF, MaxF, V9 -> - {compact, Head}; + {compact, Head, true}; {ok, _Head, _Extra} when Rep =:= force, Acc =:= read -> throw({error, {access_mode, Fname}}); {ok, Head, need_compacting} when Acc =:= read -> @@ -2555,6 +2562,17 @@ fopen_existing_file(Tab, OpenArgs) -> {error, Reason} -> throw({error, {Reason, Fname}}) end, + Do = case Wh of + {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact -> + Hd1 = Hd#head{filename = Fname}, + try {Tag, Mod:init_freelist(Hd1, Extra)} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + Else -> + Else + end, case Do of _ when FH#fileheader.type =/= Type -> throw({error, {type_mismatch, Fname}}); @@ -2563,8 +2581,7 @@ fopen_existing_file(Tab, OpenArgs) -> {compact, SourceHead} -> io:format(user, "dets: file ~p is now compacted ...~n", [Fname]), {ok, NewSourceHead} = open_final(SourceHead, Fname, read, false, - ?DEFAULT_CACHE, Tab, true, - Debug), + ?DEFAULT_CACHE, Tab, Debug), case catch compact(NewSourceHead) of ok -> erlang:garbage_collect(), @@ -2584,9 +2601,9 @@ fopen_existing_file(Tab, OpenArgs) -> Version, OpenArgs); _ when FH#fileheader.version =/= Version, Version =/= default -> throw({error, {version_mismatch, Fname}}); - {final, H, EI} -> + {final, H} -> H1 = H#head{auto_save = Auto}, - open_final(H1, Fname, Acc, Ram, CacheSz, Tab, EI, Debug) + open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug) end. do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> @@ -2600,19 +2617,16 @@ do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> end. %% -> {ok, head()} | throw(Error) -open_final(Head, Fname, Acc, Ram, CacheSz, Tab, ExtraInfo, Debug) -> +open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) -> Head1 = Head#head{access = Acc, ram_file = Ram, filename = Fname, name = Tab, cache = dets_utils:new_cache(CacheSz)}, init_disk_map(Head1#head.version, Tab, Debug), - Mod = Head#head.mod, - Mod:cache_segps(Head1#head.fptr, Fname, Head1#head.next), - Ftab = Mod:init_freelist(Head1, ExtraInfo), + (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next), check_growth(Head1), - NewHead = Head1#head{freelists = Ftab}, - {ok, NewHead}. + {ok, Head1}. %% -> {ok, head()} | throw(Error) fopen_init_file(Tab, OpenArgs) -> @@ -3139,8 +3153,12 @@ init_scan(Head, NoObjs) -> check_safe_fixtable(Head), FreeLists = dets_utils:get_freelists(Head), Base = Head#head.base, - {From, To} = dets_utils:find_next_allocated(FreeLists, Base, Base), - #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From, To, <<>>}}. + case dets_utils:find_next_allocated(FreeLists, Base, Base) of + {From, To} -> + #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From,To,<<>>}}; + none -> + #dets_cont{no_objs = NoObjs, bin = eof, alloc = <<>>} + end. check_safe_fixtable(Head) -> case (Head#head.fixed =:= false) andalso @@ -3241,18 +3259,20 @@ view(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {ok, H0, ExtraInfo} -> - Ftab = Mod:init_freelist(H0, ExtraInfo), - {_Bump, Base} = constants(FH, FileName), - H = H0#head{freelists=Ftab, base = Base}, - v_free_list(H), - Mod:v_segments(H), - file:close(Fd); - X -> - file:close(Fd), - X - end; + try Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + Mod = FH#fileheader.mod, + case Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + H = Mod:init_freelist(H0, ExtraInfo), + v_free_list(H), + Mod:v_segments(H), + ok; + X -> + X + end + after file:close(Fd) + end; X -> X end. diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl index fbffc9d008..a3f99357a2 100644 --- a/lib/stdlib/src/dets.hrl +++ b/lib/stdlib/src/dets.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -92,6 +92,7 @@ %% Info extracted from the file header. -record(fileheader, { freelist, + fl_base, cookie, closed_properly, type, diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index cdd38d5604..3e962a1c8b 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles versions up to %% and including 8(c). To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, write_cache/1, may_grow/3, @@ -196,10 +196,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], @@ -308,8 +304,9 @@ init_freelist(Head, {convert_freelist,_Version}) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - FreeList = lists:reverse(Term), - dets_utils:init_slots_from_old_file(FreeList, Ftab); + FreeList1 = lists:reverse(Term), + FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab), + Head#head{freelists = FreeList, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end; @@ -318,7 +315,7 @@ init_freelist(Head, _) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - Term; + Head#head{freelists = Term, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end. @@ -331,6 +328,7 @@ read_file_header(Fd, FileName) -> {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), FH = #fileheader{freelist = Freelist, + fl_base = ?BASE, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -413,7 +411,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 132af01f79..f577b4410f 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles version 9. %% To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, prep_table_copy/9, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, bchunk_init/2, @@ -70,6 +70,17 @@ %% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. %% (FreelistsPointer, Cookie and ClosedProperly are not digested.) %% 128 Reserved for future versions. Initially zeros. +%% Version 9(d), introduced in R15A, has instead: +%% 112 28 counters for the buddy system sizes (as for 9(b)). +%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. +%% (FreelistsPointer, Cookie and ClosedProperly are not digested.) +%% 4 Base of the buddy system. +%% 0 (zero) if the base is equal to ?BASE. Compatible with R14B. +%% File size at the end of the file is RealFileSize - Base. +%% The reason for modifying file size is that when a file created +%% by R15 is read by R14 a repair takes place immediately, which +%% is acceptable when downgrading. +%% 124 Reserved for future versions. Initially zeros. %% --- %% ------------------ end of file header %% 4*256 SegmentArray Pointers. @@ -86,7 +97,7 @@ %% ----------------------------- %% ??? Free lists %% ----------------------------- -%% 4 File size, in bytes. +%% 4 File size, in bytes. See 9(d) obove. %% Before we can find an object we must find the slot where the %% object resides. Each slot is a (possibly empty) list (or chain) of @@ -177,14 +188,14 @@ %%% File header %%% --define(RESERVED, 128). % Reserved for future use. +-define(RESERVED, 124). % Reserved for future use. -define(COLL_CNTRS, (28*4)). % Counters for the buddy system. -define(MD5SZ, 16). +-define(FL_BASE, 4). --define(HEADSZ, - 56+?COLL_CNTRS+?MD5SZ). % The size of the file header, in bytes, - % not including the reserved part. +-define(HEADSZ, 56+?COLL_CNTRS % The size of the file header, in bytes, + +?MD5SZ+?FL_BASE). % not including the reserved part. -define(HEADEND, (?HEADSZ+?RESERVED)). % End of header and reserved area. -define(SEGSZ, 512). % Size of a segment, in words. SZOBJP*SEGSZP. @@ -270,10 +281,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], @@ -356,7 +363,7 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, cache = dets_utils:new_cache(CacheSz), version = ?FILE_FORMAT_VERSION, bump = ?BUMP, - base = ?BASE, + base = ?BASE, % to be overwritten mod = ?MODULE }, @@ -378,13 +385,20 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, {Head1, Ws1} = init_parts(Head0, 0, no_parts(Next), Zero, []), NoSegs = no_segs(Next), - {Head, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), + {Head2, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), Ws2 = if DoInitSegments -> WsP ++ WsI; true -> WsP end, dets_utils:pwrite(Fd, Fname, [W0 | lists:append(Ws1) ++ Ws2]), - true = hash_invars(Head), + true = hash_invars(Head2), + %% The allocations that have been made so far (parts, segments) + %% are permanent; the table will never shrink. Therefore the base + %% of the Buddy system can be set to the first free object. + %% This is used in allocate_all(), see below. + {_, Where, _} = dets_utils:alloc(Head2, ?BUMP), + NewFtab = dets_utils:init_alloc(Where), + Head = Head2#head{freelists = NewFtab, base = Where}, {ok, Head}. %% Returns a power of two not less than 256. @@ -451,8 +465,9 @@ read_file_header(Fd, FileName) -> Version:32, M:32, Next:32, Kp:32, NoObjects:32, NoKeys:32, MinNoSlots:32, MaxNoSlots:32, HashMethod:32, N:32, NoCollsB:?COLL_CNTRS/binary, - MD5:?MD5SZ/binary>> = Bin, - <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-12)/binary,_/binary>> = Bin, + MD5:?MD5SZ/binary, FlBase:32>> = Bin, + <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-?FL_BASE-12)/binary, + _/binary>> = Bin, {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), {CL, <<>>} = lists:foldl(fun(LSz, {Acc,<<NN:32,R/binary>>}) -> @@ -468,8 +483,12 @@ read_file_header(Fd, FileName) -> true -> lists:reverse(CL) end, - + Base = case FlBase of + 0 -> ?BASE; + _ -> FlBase + end, FH = #fileheader{freelist = FreeList, + fl_base = Base, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -486,7 +505,7 @@ read_file_header(Fd, FileName) -> read_md5 = MD5, has_md5 = <<0:?MD5SZ/unit:8>> =/= MD5, md5 = erlang:md5(MD5DigestedPart), - trailer = FileSize, + trailer = FileSize + FlBase, eof = EOF, n = N, mod = ?MODULE}, @@ -544,7 +563,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error @@ -1185,41 +1204,25 @@ write_loop(Head, BytesToWrite, Bin) -> write_loop(Head, BytesToWrite, SmallBin). %% By allocating bigger objects before smaller ones, holes in the -%% buddy system memory map are avoided. Unfortunately, the segments -%% are always allocated first, so if there are objects bigger than a -%% segment, there is a hole to handle. (Haven't considered placing the -%% segments among other objects of the same size.) +%% buddy system memory map are avoided. allocate_all_objects(Head, SizeT) -> DTL = lists:reverse(lists:keysort(1, ets:tab2list(SizeT))), MaxSz = element(1, hd(DTL)), - SegSize = ?ACTUAL_SEG_SIZE, - {Head1, HSz, HN, HA} = alloc_hole(MaxSz, Head, SegSize), - {Head2, NL} = allocate_all(Head1, DTL, []), + {Head1, NL} = allocate_all(Head, DTL, []), %% Find the position that will be the end of the file by allocating %% a minimal object. - {_Head, EndOfFile, _} = dets_utils:alloc(Head2, ?BUMP), - Head3 = free_hole(Head2, HSz, HN, HA), - NewHead = Head3#head{maxobjsize = max_objsize(Head3#head.no_collections)}, + {_Head, EndOfFile, _} = dets_utils:alloc(Head1, ?BUMP), + NewHead = Head1#head{maxobjsize = max_objsize(Head1#head.no_collections)}, {NewHead, NL, MaxSz, EndOfFile}. -alloc_hole(LSize, Head, SegSz) when ?POW(LSize-1) > SegSz -> - Size = ?POW(LSize-1), - {_, SegAddr, _} = dets_utils:alloc(Head, adjsz(SegSz)), - {_, Addr, _} = dets_utils:alloc(Head, adjsz(Size)), - N = (Addr - SegAddr) div SegSz, - Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr), - {Head1, SegSz, N, SegAddr}; -alloc_hole(_MaxSz, Head, _SegSz) -> - {Head, 0, 0, 0}. - -free_hole(Head, _Size, 0, _Addr) -> - Head; -free_hole(Head, Size, N, Addr) -> - {Head1, _} = dets_utils:free(Head, Addr, adjsz(Size)), - free_hole(Head1, Size, N-1, Addr+Size). - %% One (temporary) file for each buddy size, write all objects of that %% size to the file. +%% +%% Before R15 a "hole" was needed before the first bucket if the size +%% of the biggest bucket was greater than the size of a segment. The +%% hole proved to be a problem with almost full tables with huge +%% buckets. Since R15 the hole is no longer needed due to the fact +%% that the base of the Buddy system is flexible. allocate_all(Head, [{?FSCK_SEGMENT,_,Data,_}], L) -> %% And one file for the segments... %% Note that space for the array parts and the segments has @@ -1593,23 +1596,28 @@ do_perform_save(H) -> H1 = H#head{freelists_p = FreeListsPointer}, {FLW, FLSize} = free_lists_to_file(H1), FileSize = FreeListsPointer + FLSize + 4, - ok = dets_utils:write(H1, [FLW | <<FileSize:32>>]), + AdjustedFileSize = case H#head.base of + ?BASE -> FileSize; + Base -> FileSize - Base + end, + ok = dets_utils:write(H1, [FLW | <<AdjustedFileSize:32>>]), FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY), case dets_utils:debug_mode() of true -> - TmpHead = H1#head{freelists = init_freelist(H1, true), - fixed = false}, + TmpHead0 = init_freelist(H1#head{fixed = false}, true), + TmpHead = TmpHead0#head{base = H1#head.base}, case catch dets_utils:all_allocated_as_list(TmpHead) =:= dets_utils:all_allocated_as_list(H1) - of + of true -> dets_utils:pwrite(H1, [{0, FileHeader}]); _ -> + throw( dets_utils:corrupt_reason(H1, {failed_to_save_free_lists, FreeListsPointer, TmpHead#head.freelists, - H1#head.freelists}) + H1#head.freelists})) end; false -> dets_utils:pwrite(H1, [{0, FileHeader}]) @@ -1648,7 +1656,11 @@ file_header(Head, FreeListsPointer, ClosedProperly, NoColls) -> true -> erlang:md5(DigH); false -> <<0:?MD5SZ/unit:8>> end, - [H1, DigH, MD5 | <<0:?RESERVED/unit:8>>]. + Base = case Head#head.base of + ?BASE -> <<0:32>>; + FlBase -> <<FlBase:32>> + end, + [H1, DigH, MD5, Base | <<0:?RESERVED/unit:8>>]. %% Going through some trouble to avoid creating one single binary for %% the free lists. If the free lists are huge, binary_to_term and @@ -1695,8 +1707,8 @@ free_lists_from_file(H, Pos) -> case catch bin_to_tree([], H, start, FL, -1, []) of {'EXIT', _} -> throw({error, {bad_freelists, H#head.filename}}); - Reply -> - Reply + Ftab -> + H#head{freelists = Ftab, base = ?BASE} end. bin_to_tree(Bin, H, LastPos, Ftab, A0, L) -> diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d804c1dee5..ccc14610d7 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -267,8 +267,10 @@ init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) -> case user_predef(Pdm, Ms0) of {ok,Ms1} -> epp_reply(Pid, {ok,self()}), + %% ensure directory of current source file is first in path + Path1 = [filename:dirname(Name) | Path], St = #epp{file=File, location=AtLocation, delta=0, name=Name, - name2=Name, path=Path, macs=Ms1, pre_opened = Pre}, + name2=Name, path=Path1, macs=Ms1, pre_opened = Pre}, From = wait_request(St), enter_file_reply(From, Name, AtLocation, AtLocation), wait_req_scan(St); @@ -360,18 +362,18 @@ wait_req_skip(St, Sis) -> From = wait_request(St), skip_toks(From, St, Sis). -%% enter_file(Path, FileName, IncludeToken, From, EppState) +%% enter_file(FileName, IncludeToken, From, EppState) %% leave_file(From, EppState) %% Handle entering and leaving included files. Notify caller when the %% current file is changed. Note it is an error to exit a file if we are %% in a conditional. These functions never return. -enter_file(_Path, _NewName, Inc, From, St) +enter_file(_NewName, Inc, From, St) when length(St#epp.sstk) >= 8 -> epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include"}}}), wait_req_scan(St); -enter_file(Path, NewName, Inc, From, St) -> - case file:path_open(Path, NewName, [read]) of +enter_file(NewName, Inc, From, St) -> + case file:path_open(St#epp.path, NewName, [read]) of {ok,NewF,Pname} -> Loc = start_loc(St#epp.location), wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); @@ -384,13 +386,16 @@ enter_file(Path, NewName, Inc, From, St) -> %% Set epp to use this file and "enter" it. enter_file2(NewF, Pname, From, St, AtLocation) -> - enter_file2(NewF, Pname, From, St, AtLocation, []). - -enter_file2(NewF, Pname, From, St, AtLocation, ExtraPath) -> Loc = start_loc(AtLocation), enter_file_reply(From, Pname, Loc, AtLocation), Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St#epp.macs), - Path = St#epp.path ++ ExtraPath, + %% update the head of the include path to be the directory of the new + %% source file, so that an included file can always include other files + %% relative to its current location (this is also how C does it); note + %% that the directory of the parent source file (the previous head of + %% the path) must be dropped, otherwise the path used within the current + %% file will depend on the order of file inclusions in the parent files + Path = [filename:dirname(Pname) | tl(St#epp.path)], #epp{file=NewF,location=Loc,name=Pname,delta=0, sstk=[St|St#epp.sstk],path=Path,macs=Ms}. @@ -655,7 +660,7 @@ scan_undef(_Toks, Undef, From, St) -> scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) -> NewName = expand_var(NewName0), - enter_file(St#epp.path, NewName, Inc, From, St); + enter_file(NewName, Inc, From, St); scan_include(_Toks, Inc, From, St) -> epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include}}}), wait_req_scan(St). @@ -684,12 +689,11 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], {error,_E1} -> case catch find_lib_dir(NewName) of {LibDir, Rest} when is_list(LibDir) -> - LibName = filename:join([LibDir | Rest]), + LibName = fname_join([LibDir | Rest]), case file:open(LibName, [read]) of {ok,NewF} -> - ExtraPath = [filename:dirname(LibName)], wait_req_scan(enter_file2(NewF, LibName, From, - St, Loc, ExtraPath)); + St, Loc)); {error,_E2} -> epp_reply(From, {error,{abs_loc(Inc),epp, @@ -1154,7 +1158,12 @@ expand_var1(NewName) -> [[$$ | Var] | Rest] = filename:split(NewName), Value = os:getenv(Var), true = Value =/= false, - {ok, filename:join([Value | Rest])}. + {ok, fname_join([Value | Rest])}. + +fname_join(["." | [_|_]=Rest]) -> + fname_join(Rest); +fname_join(Components) -> + filename:join(Components). %% The line only. (Other tokens may have the column and text as well...) loc_attr(Line) when is_integer(Line) -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 515ea2ebb7..88a0094d57 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -256,7 +256,8 @@ expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) -> expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) -> {value,T,Bs} = expr(E, Bs0, Lf, Ef, none), receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs); -expr({'fun',_Line,{function,Mod,Name,Arity}}, Bs, _Lf, _Ef, RBs) -> +expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> + {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef), F = erlang:make_fun(Mod, Name, Arity), ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 @@ -621,7 +622,7 @@ eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> erlang:raise(error, {bad_generator,Term}, stacktrace()). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> - Mfun = fun(L, R, Bs) -> match1(L, R, Bs, Bs0) end, + Mfun = match_fun(Bs0), Efun = fun(Exp, Bs) -> expr(Exp, Bs, Lf, Ef, none) end, case eval_bits:bin_gen(P, Bin, new_bindings(), Bs0, Mfun, Efun) of {match, Rest, Bs1} -> @@ -1024,7 +1025,7 @@ match1({tuple,_,_}, _, _Bs, _BBs) -> throw(nomatch); match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) -> eval_bits:match_bits(Fs, B, Bs0, BBs, - fun(L, R, Bs) -> match1(L, R, Bs, BBs) end, + match_fun(BBs), fun(E, Bs) -> expr(E, Bs, none, none, none) end); match1({bin,_,_}, _, _Bs, _BBs) -> throw(nomatch); @@ -1053,6 +1054,12 @@ match1({op,Line,Op,L,R}, Term, Bs, BBs) -> match1(_, _, _Bs, _BBs) -> throw(invalid). +match_fun(BBs) -> + fun(match, {L,R,Bs}) -> match1(L, R, Bs, BBs); + (binding, {Name,Bs}) -> binding(Name, Bs); + (add_binding, {Name,Val,Bs}) -> add_binding(Name, Val, Bs) + end. + match_tuple([E|Es], Tuple, I, Bs0, BBs) -> {match,Bs} = match1(E, element(I, Tuple), Bs0, BBs), match_tuple(Es, Tuple, I+1, Bs, BBs); diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 3073fc0fb5..cd3b531d10 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -264,7 +264,6 @@ bif(bitstring_to_list, 1) -> true; bif(byte_size, 1) -> true; bif(check_old_code, 1) -> true; bif(check_process_code, 2) -> true; -bif(concat_binary, 1) -> true; bif(date, 0) -> true; bif(delete_module, 1) -> true; bif(demonitor, 1) -> true; @@ -406,7 +405,6 @@ old_bif(bit_size, 1) -> true; old_bif(bitstring_to_list, 1) -> true; old_bif(byte_size, 1) -> true; old_bif(check_process_code, 2) -> true; -old_bif(concat_binary, 1) -> true; old_bif(date, 0) -> true; old_bif(delete_module, 1) -> true; old_bif(disconnect_node, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index dd0b9bc2ab..5d45260fe9 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -123,6 +123,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, specs = dict:new() :: dict(), %Type specifications + callbacks = dict:new() :: dict(), %Callback types types = dict:new() :: dict(), %Type definitions exp_types=gb_sets:empty():: gb_set() %Exported types }). @@ -310,8 +311,6 @@ format_error({conflicting_behaviours,{Name,Arity},B,FirstL,FirstB}) -> format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}) -> io_lib:format("undefined callback function ~w/~w (behaviour '~w')", [Func,Arity,Behaviour]); -format_error({undefined_behaviour_func, {Func,Arity,_Spec}, Behaviour}) -> - format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}); format_error({undefined_behaviour,Behaviour}) -> io_lib:format("behaviour ~w undefined", [Behaviour]); format_error({undefined_behaviour_callbacks,Behaviour}) -> @@ -320,6 +319,9 @@ format_error({undefined_behaviour_callbacks,Behaviour}) -> format_error({ill_defined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions erroneously defined", [Behaviour]); +format_error({behaviour_info, {_M,F,A}}) -> + io_lib:format("cannot define callback attibute for ~w/~w when " + "behaviour_info is defined",[F,A]); %% --- types and specs --- format_error({singleton_typevar, Name}) -> io_lib:format("type variable ~w is only used once (is unbound)", [Name]); @@ -348,12 +350,16 @@ format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); +format_error({redefine_callback, {M, F, A}}) -> + io_lib:format("callback ~w:~w/~w already defined", [M, F, A]); format_error({spec_fun_undefined, {M, F, A}}) -> io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]); format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> "spec has the wrong arity"; +format_error(callback_wrong_arity) -> + "callback has the wrong arity"; format_error({imported_predefined_type, Name}) -> io_lib:format("referring to built-in type ~w as a remote type; " "please take out the module name", [Name]); @@ -747,6 +753,8 @@ attribute_state({attribute,L,opaque,{TypeName,TypeDef,Args}}, St) -> type_def(opaque, L, TypeName, TypeDef, Args, St); attribute_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); +attribute_state({attribute,L,callback,{Fun,Types}}, St) -> + callback_decl(L, Fun, Types, St); attribute_state({attribute,L,on_load,Val}, St) -> on_load(L, Val, St); attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others @@ -840,7 +848,8 @@ post_traversal_check(Forms, St0) -> StB = check_unused_types(Forms, StA), StC = check_untyped_records(Forms, StB), StD = check_on_load(StC), - check_unused_records(Forms, StD). + StE = check_unused_records(Forms, StD), + check_callback_information(StE). %% check_behaviour(State0) -> State %% Check that the behaviour attribute is valid. @@ -1139,6 +1148,23 @@ check_unused_records(Forms, St0) -> St0 end. +check_callback_information(#lint{callbacks = Callbacks, + defined = Defined} = State) -> + case gb_sets:is_member({behaviour_info,1}, Defined) of + false -> State; + true -> + case dict:size(Callbacks) of + 0 -> State; + _ -> + CallbacksList = dict:to_list(Callbacks), + FoldL = + fun({Fa,Line},St) -> + add_error(Line, {behaviour_info, Fa}, St) + end, + lists:foldl(FoldL, State, CallbacksList) + end + end. + %% For storing the import list we use the orddict module. %% We know an empty set is []. @@ -2101,8 +2127,13 @@ expr({'fun',Line,Body}, Vt, St) -> true -> {[],St}; false -> {[],call_function(Line, F, A, St)} end; - {function,_M,_F,_A} -> - {[],St} + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% Compatibility with pre-R15 abstract format. + {[],St}; + {function,M,F,A} -> + %% New in R15. + {Bvt, St1} = expr_list([M,F,A], Vt, St), + {vtupdate(Bvt, Vt),St1} end; expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), @@ -2770,6 +2801,20 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> false -> check_specs(TypeSpecs, Arity, St1) end. +%% callback_decl(Line, Fun, Types, State) -> State. + +callback_decl(Line, MFA0, TypeSpecs, + St0 = #lint{callbacks = Callbacks, module = Mod}) -> + MFA = case MFA0 of + {F, Arity} -> {Mod, F, Arity}; + {_M, _F, Arity} -> MFA0 + end, + St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, + case dict:is_key(MFA, Callbacks) of + true -> add_error(Line, {redefine_callback, MFA}, St1); + false -> check_specs(TypeSpecs, Arity, St1) + end. + check_specs([FunType|Left], Arity, St0) -> {FunType1, CTypes} = case FunType of @@ -3275,6 +3320,8 @@ modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> {attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}}; modify_line1({attribute,L,spec,{Fun,Types}}, Mf) -> {attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}}; +modify_line1({attribute,L,callback,{Fun,Types}}, Mf) -> + {attribute,Mf(L),callback,{Fun,modify_line1(Types, Mf)}}; modify_line1({attribute,L,type,{TypeName,TypeDef,Args}}, Mf) -> {attribute,Mf(L),type,{TypeName,modify_line1(TypeDef, Mf), modify_line1(Args, Mf)}}; diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index bd5d65a1e1..928c10f7f2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -35,7 +35,7 @@ tuple %struct record_expr record_tuple record_field record_fields if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr -fun_expr fun_clause fun_clauses +fun_expr fun_clause fun_clauses atom_or_var integer_or_var try_expr try_catch try_clause try_clauses query_expr function_call argument_list exprs guard @@ -62,7 +62,7 @@ char integer float atom string var '==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '<<' '>>' '!' '=' '::' '..' '...' -'spec' % helper +'spec' 'callback' % helper dot. Expect 2. @@ -77,6 +77,7 @@ attribute -> '-' atom attr_val : build_attribute('$2', '$3'). attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3'). attribute -> '-' atom '(' typed_attr_val ')' : build_typed_attribute('$2','$4'). attribute -> '-' 'spec' type_spec : build_type_spec('$2', '$3'). +attribute -> '-' 'callback' type_spec : build_type_spec('$2', '$3'). type_spec -> spec_fun type_sigs : {'$1', '$2'}. type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. @@ -394,11 +395,17 @@ receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : fun_expr -> 'fun' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. -fun_expr -> 'fun' atom ':' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4'),element(3,'$6')}}. +fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : + {'fun',?line('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : build_fun(?line('$1'), '$2'). +atom_or_var -> atom : '$1'. +atom_or_var -> var : '$1'. + +integer_or_var -> integer : '$1'. +integer_or_var -> var : '$1'. + fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. @@ -549,6 +556,8 @@ Erlang code. ErrorInfo :: error_info(). parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> parse([{'-',L1},{'spec',L2}|Tokens]); +parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> + parse([{'-',L1},{'callback',L2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -603,7 +612,8 @@ build_typed_attribute({atom,La,Attr},_) -> _ -> ret_err(La, "bad attribute") end. -build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> +build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) + when (Kind =:= spec) or (Kind =:= callback) -> NewSpecFun = case SpecFun of {atom, _, Fun} -> @@ -617,7 +627,7 @@ build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> %% Old style spec. Allow this for now. {Mod,Fun,Arity} end, - {attribute,La,spec,{NewSpecFun, TypeSpecs}}. + {attribute,La,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> %% Use the first spec to find the arity. If all are not the same, diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 7dc19f2e9b..6b5aa951cf 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -457,8 +457,16 @@ lexpr({'fun',_,{function,F,A}}, _Prec, _Hook) -> leaf(format("fun ~w/~w", [F,A])); lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Hook) -> {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))}; -lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) -> +lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) + when is_atom(M), is_atom(F), is_integer(A) -> + %% For backward compatibility with pre-R15 abstract format. leaf(format("fun ~w:~w/~w", [M,F,A])); +lexpr({'fun',_,{function,M,F,A}}, _Prec, Hook) -> + %% New format in R15. + NameItem = lexpr(M, Hook), + CallItem = lexpr(F, Hook), + ArityItem = lexpr(A, Hook), + ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Hook) -> {list,[{first,'fun',fun_clauses(Cs, Hook)},'end']}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Hook) -> diff --git a/lib/stdlib/src/error_logger_tty_h.erl b/lib/stdlib/src/error_logger_tty_h.erl index 435e57aa0e..fa13fbb2bd 100644 --- a/lib/stdlib/src/error_logger_tty_h.erl +++ b/lib/stdlib/src/error_logger_tty_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,10 +34,12 @@ handle_event/2, handle_call/2, handle_info/2, terminate/2, code_change/3]). +-export([write_event/2]). + %% This one is used when we takeover from the simple error_logger. init({[], {error_logger, Buf}}) -> User = set_group_leader(), - write_events(Buf), + write_events(Buf,io), {ok, {User, error_logger}}; %% This one is used if someone took over from us, and now wants to %% go back. @@ -52,7 +54,7 @@ init([]) -> handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; handle_event(Event, State) -> - write_event(tag_event(Event)), + write_event(tag_event(Event),io), {ok, State}. handle_info({'EXIT', User, _Reason}, {User, PrevHandler}) -> @@ -64,10 +66,10 @@ handle_info({'EXIT', User, _Reason}, {User, PrevHandler}) -> PrevHandler, go_back} end; handle_info({emulator, GL, Chars}, State) when node(GL) == node() -> - write_event(tag_event({emulator, GL, Chars})), + write_event(tag_event({emulator, GL, Chars}),io), {ok, State}; handle_info({emulator, noproc, Chars}, State) -> - write_event(tag_event({emulator, noproc, Chars})), + write_event(tag_event({emulator, noproc, Chars}),io), {ok, State}; handle_info(_, State) -> {ok, State}. @@ -97,65 +99,65 @@ set_group_leader() -> tag_event(Event) -> {erlang:localtime(), Event}. -write_events(Events) -> write_events1(lists:reverse(Events)). +write_events(Events,IOMod) -> write_events1(lists:reverse(Events),IOMod). -write_events1([Event|Es]) -> - write_event(Event), - write_events1(Es); -write_events1([]) -> +write_events1([Event|Es],IOMod) -> + write_event(Event,IOMod), + write_events1(Es,IOMod); +write_events1([],_IOMod) -> ok. -write_event({Time, {error, _GL, {Pid, Format, Args}}}) -> +write_event({Time, {error, _GL, {Pid, Format, Args}}},IOMod) -> T = write_time(maybe_utc(Time)), case catch io_lib:format(add_node(Format,Pid), Args) of S when is_list(S) -> - format(T ++ S); + format(IOMod, T ++ S); _ -> F = add_node("ERROR: ~p - ~p~n", Pid), - format(T ++ F, [Format,Args]) + format(IOMod, T ++ F, [Format,Args]) end; -write_event({Time, {emulator, _GL, Chars}}) -> +write_event({Time, {emulator, _GL, Chars}},IOMod) -> T = write_time(maybe_utc(Time)), case catch io_lib:format(Chars, []) of S when is_list(S) -> - format(T ++ S); + format(IOMod, T ++ S); _ -> - format(T ++ "ERROR: ~p ~n", [Chars]) + format(IOMod, T ++ "ERROR: ~p ~n", [Chars]) end; -write_event({Time, {info, _GL, {Pid, Info, _}}}) -> +write_event({Time, {info, _GL, {Pid, Info, _}}},IOMod) -> T = write_time(maybe_utc(Time)), - format(T ++ add_node("~p~n",Pid),[Info]); -write_event({Time, {error_report, _GL, {Pid, std_error, Rep}}}) -> + format(IOMod, T ++ add_node("~p~n",Pid),[Info]); +write_event({Time, {error_report, _GL, {Pid, std_error, Rep}}},IOMod) -> T = write_time(maybe_utc(Time)), S = format_report(Rep), - format(T ++ S ++ add_node("", Pid)); -write_event({Time, {info_report, _GL, {Pid, std_info, Rep}}}) -> + format(IOMod, T ++ S ++ add_node("", Pid)); +write_event({Time, {info_report, _GL, {Pid, std_info, Rep}}},IOMod) -> T = write_time(maybe_utc(Time), "INFO REPORT"), S = format_report(Rep), - format(T ++ S ++ add_node("", Pid)); -write_event({Time, {info_msg, _GL, {Pid, Format, Args}}}) -> + format(IOMod, T ++ S ++ add_node("", Pid)); +write_event({Time, {info_msg, _GL, {Pid, Format, Args}}},IOMod) -> T = write_time(maybe_utc(Time), "INFO REPORT"), case catch io_lib:format(add_node(Format,Pid), Args) of S when is_list(S) -> - format(T ++ S); + format(IOMod, T ++ S); _ -> F = add_node("ERROR: ~p - ~p~n", Pid), - format(T ++ F, [Format,Args]) + format(IOMod, T ++ F, [Format,Args]) end; -write_event({Time, {warning_report, _GL, {Pid, std_warning, Rep}}}) -> +write_event({Time, {warning_report, _GL, {Pid, std_warning, Rep}}},IOMod) -> T = write_time(maybe_utc(Time), "WARNING REPORT"), S = format_report(Rep), - format(T ++ S ++ add_node("", Pid)); -write_event({Time, {warning_msg, _GL, {Pid, Format, Args}}}) -> + format(IOMod, T ++ S ++ add_node("", Pid)); +write_event({Time, {warning_msg, _GL, {Pid, Format, Args}}},IOMod) -> T = write_time(maybe_utc(Time), "WARNING REPORT"), case catch io_lib:format(add_node(Format,Pid), Args) of S when is_list(S) -> - format(T ++ S); + format(IOMod, T ++ S); _ -> F = add_node("ERROR: ~p - ~p~n", Pid), - format(T ++ F, [Format,Args]) + format(IOMod, T ++ F, [Format,Args]) end; -write_event({_Time, _Error}) -> +write_event({_Time, _Error},_IOMod) -> ok. maybe_utc(Time) -> @@ -178,8 +180,9 @@ maybe_utc(Time) -> Time end. -format(String) -> io:format(user, String, []). -format(String, Args) -> io:format(user, String, Args). +format(IOMod, String) -> format(IOMod, String, []). +format(io_lib, String, Args) -> io_lib:format(String, Args); +format(io, String, Args) -> io:format(user, String, Args). format_report(Rep) when is_list(Rep) -> case string_p(Rep) of diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index cd1bacd2f5..ad49d89908 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -866,7 +866,7 @@ hidden_apply(App, M, F, Args) -> catch error:undef -> case erlang:get_stacktrace() of - [{M,F,Args} | _] -> + [{M,F,Args,_} | _] -> Arity = length(Args), Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n", [M, F, Arity, App]), diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index 1ffa6ea328..f40904df1c 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -31,8 +31,9 @@ %% @type evalfun(). A closure which evaluates an expression given an %% environment %% -%% @type matchfun(). A closure which performs a match given a value, a -%% pattern and an environment +%% @type matchfun(). A closure which depending on its first argument +%% can perform a match (given a value, a pattern and an environment), +%% lookup a variable in the bindings, or add a new binding %% %% @type field(). Represents a field in a "bin". @@ -144,7 +145,8 @@ eval_exp_field(Val, Size, Unit, binary, _, _) -> bin_gen({bin,_,Fs}, Bin, Bs0, BBs0, Mfun, Efun) -> bin_gen(Fs, Bin, Bs0, BBs0, Mfun, Efun, true). -bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) -> +bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) + when is_function(Mfun, 2), is_function(Efun, 2) -> case bin_gen_field(F, Bin, Bs0, BBs0, Mfun, Efun) of {match,Bs,BBs,Rest} -> bin_gen(Fs, Rest, Bs, BBs, Mfun, Efun, Flag); @@ -175,14 +177,14 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), - match_check_size(Size1, BBs0), + match_check_size(Mfun, Size1, BBs0), {value, Size, _BBs} = Efun(Size1, BBs0), case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of {Val,<<_/bitstring>>=Rest} -> NewV = coerce_to_float(V, Type), - case catch Mfun(NewV, Val, Bs0) of + case catch Mfun(match, {NewV,Val,Bs0}) of {match,Bs} -> - BBs = add_bin_binding(NewV, Bs, BBs0), + BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {match,Bs,BBs,Rest}; _ -> {nomatch,Rest} @@ -205,7 +207,8 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun, _) -> match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun). -match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) -> +match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) + when is_function(Mfun, 2), is_function(Efun, 2) -> case catch match_bits_1(Fs, Bin, Bs0, BBs, Mfun, Efun) of {match,Bs} -> {match,Bs}; invalid -> throw(invalid); @@ -230,12 +233,12 @@ match_field_1({bin_element,Line,VE,Size0,Options0}, make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), Size2 = erl_eval:partial_eval(Size1), - match_check_size(Size2, BBs0), + match_check_size(Mfun, Size2, BBs0), {value, Size, _BBs} = Efun(Size2, BBs0), {Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian), NewV = coerce_to_float(V, Type), - {match,Bs} = Mfun(NewV, Val, Bs0), - BBs = add_bin_binding(NewV, Bs, BBs0), + {match,Bs} = Mfun(match, {NewV,Val,Bs0}), + BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {Bs,BBs,Rest}. %% Almost identical to the one in sys_pre_expand. @@ -249,12 +252,12 @@ coerce_to_float({integer,L,I}=E, float) -> coerce_to_float(E, _Type) -> E. -add_bin_binding({var,_,'_'}, _Bs, BBs) -> +add_bin_binding(_, {var,_,'_'}, _Bs, BBs) -> BBs; -add_bin_binding({var,_,Name}, Bs, BBs) -> - {value,Value} = erl_eval:binding(Name, Bs), - erl_eval:add_binding(Name, Value, BBs); -add_bin_binding(_, _Bs, BBs) -> +add_bin_binding(Mfun, {var,_,Name}, Bs, BBs) -> + {value,Value} = Mfun(binding, {Name,Bs}), + Mfun(add_binding, {Name,Value,BBs}); +add_bin_binding(_, _, _Bs, BBs) -> BBs. get_value(Bin, integer, Size, Unit, Sign, Endian) -> @@ -327,20 +330,20 @@ make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' {error,Reason} -> error(Reason) end. -match_check_size({var,_,V}, Bs) -> - case erl_eval:binding(V, Bs) of +match_check_size(Mfun, {var,_,V}, Bs) -> + case Mfun(binding, {V,Bs}) of {value,_} -> ok; unbound -> throw(invalid) % or, rather, error({unbound,V}) end; -match_check_size({atom,_,all}, _Bs) -> +match_check_size(_, {atom,_,all}, _Bs) -> ok; -match_check_size({atom,_,undefined}, _Bs) -> +match_check_size(_, {atom,_,undefined}, _Bs) -> ok; -match_check_size({integer,_,_}, _Bs) -> +match_check_size(_, {integer,_,_}, _Bs) -> ok; -match_check_size({value,_,_}, _Bs) -> +match_check_size(_, {value,_,_}, _Bs) -> ok; %From the debugger. -match_check_size(_, _Bs) -> +match_check_size(_, _, _Bs) -> throw(invalid). %% error(Reason) -> exception thrown diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 1cb9e4a25e..2fc9128e4e 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -147,9 +147,10 @@ basename(Name) when is_binary(Name) -> end; basename(Name0) -> - Name = flatten(Name0), + Name1 = flatten(Name0), {DirSep2, DrvSep} = separators(), - basename1(skip_prefix(Name, DrvSep), [], DirSep2). + Name = skip_prefix(Name1, DrvSep), + basename1(Name, Name, DirSep2). win_basenameb(<<Letter,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter) -> basenameb(Rest,[<<"/">>,<<"\\">>]); @@ -167,16 +168,18 @@ basenameb(Bin,Sep) -> -basename1([$/|[]], Tail, DirSep2) -> - basename1([], Tail, DirSep2); +basename1([$/], Tail0, _DirSep2) -> + %% End of filename -- must get rid of trailing directory separator. + [_|Tail] = lists:reverse(Tail0), + lists:reverse(Tail); basename1([$/|Rest], _Tail, DirSep2) -> - basename1(Rest, [], DirSep2); + basename1(Rest, Rest, DirSep2); basename1([DirSep2|Rest], Tail, DirSep2) when is_integer(DirSep2) -> basename1([$/|Rest], Tail, DirSep2); basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) -> - basename1(Rest, [Char|Tail], DirSep2); + basename1(Rest, Tail, DirSep2); basename1([], Tail, _DirSep2) -> - lists:reverse(Tail). + Tail. skip_prefix(Name, false) -> Name; @@ -369,8 +372,8 @@ extension(Name0) -> Name = flatten(Name0), extension(Name, [], major_os_type()). -extension([$.|Rest], _Result, OsType) -> - extension(Rest, [$.], OsType); +extension([$.|Rest]=Result, _Result, OsType) -> + extension(Rest, Result, OsType); extension([Char|Rest], [], OsType) when is_integer(Char) -> extension(Rest, [], OsType); extension([$/|Rest], _Result, OsType) -> @@ -378,9 +381,9 @@ extension([$/|Rest], _Result, OsType) -> extension([$\\|Rest], _Result, win32) -> extension(Rest, [], win32); extension([Char|Rest], Result, OsType) when is_integer(Char) -> - extension(Rest, [Char|Result], OsType); + extension(Rest, Result, OsType); extension([], Result, _OsType) -> - lists:reverse(Result). + Result. %% Joins a list of filenames with directory separators. diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 1c4a73680b..9879b76391 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -36,8 +36,6 @@ add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). --export([behaviour_info/1]). - -export([init_it/6, system_continue/3, system_terminate/4, @@ -60,14 +58,6 @@ %%% API %%%========================================================================= --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_event,2},{handle_call,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. - %% gen_event:start(Handler) -> {ok, Pid} | {error, What} %% gen_event:add_handler(Handler, Mod, Args) -> ok | Other %% gen_event:notify(Handler, Event) -> ok @@ -78,41 +68,36 @@ behaviour_info(_Other) -> %% gen_event:which_handler(Handler) -> [Mod] %% gen_event:stop(Handler) -> ok - -%% handlers must export -%% Mod:init(Args) -> {ok, State} | Other -%% Mod:handle_event(Event, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_info(Info, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_call(Query, State) -> -%% {ok, Reply, State'} | {remove_handler, Reply} | -%% {swap_handler, Reply, Args1,State1,Mod2,Args2} -%% Mod:terminate(Args, State) -> Val - - -%% add_handler(H, Mod, Args) -> ok | Other -%% Mod:init(Args) -> {ok, State} | Other - -%% delete_handler(H, Mod, Args) -> Val -%% Mod:terminate(Args, State) -> Val - -%% notify(H, Event) -%% Mod:handle_event(Event, State) -> -%% {ok, State1} -%% remove_handler -%% Mod:terminate(remove_handler, State) is called -%% the return value is ignored -%% {swap_handler, Args1, State1, Mod2, Args2} -%% State2 = Mod:terminate(Args1, State1) is called -%% the return value is chained into the new module and -%% Mod2:init({Args2, State2}) is called -%% Other -%% Mod:terminate({error, Other}, State) is called -%% The return value is ignored -%% call(H, Mod, Query) -> Val -%% call(H, Mod, Query, Timeout) -> Val -%% Mod:handle_call(Query, State) -> as above +-callback init(InitArgs :: term()) -> + {ok, State :: term()} | + {ok, State :: term(), hibernate}. +-callback handle_event(Event :: term(), State :: term()) -> + {ok, NewState :: term()} | + {ok, NewState :: term(), hibernate} | + {swap_handler, Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler. +-callback handle_call(Request :: term(), State :: term()) -> + {ok, Reply :: term(), NewState :: term()} | + {ok, Reply :: term(), NewState :: term(), hibernate} | + {swap_handler, Reply :: term(), Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + {remove_handler, Reply :: term()}. +-callback handle_info(Info :: term(), State :: term()) -> + {ok, NewState :: term()} | + {ok, NewState :: term(), hibernate} | + {swap_handler, Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler. +-callback terminate(Args :: (term() | {stop, Reason :: term()} | + stop | remove_handler | + {error, {'EXIT', Reason :: term()}} | + {error, term()}), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), + State :: term(), Extra :: term()) -> + {ok, NewState :: term()}. %%--------------------------------------------------------------------------- @@ -667,16 +652,16 @@ report_error(_Handler, {swapped,_,_}, _, _, _) -> ok; report_error(Handler, Reason, State, LastIn, SName) -> Reason1 = case Reason of - {'EXIT',{undef,[{M,F,A}|MFAs]}} -> + {'EXIT',{undef,[{M,F,A,L}|MFAs]}} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> - {undef,[{M,F,A}|MFAs]}; + {undef,[{M,F,A,L}|MFAs]}; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; {'EXIT',Why} -> diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index f2f1365d3d..3db8c9f4f2 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -113,8 +113,6 @@ start_timer/2,send_event_after/2,cancel_timer/1, enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/6]). --export([behaviour_info/1]). - %% Internal exports -export([init_it/6, system_continue/3, @@ -128,13 +126,38 @@ %%% Interface functions. %%% --------------------------------------------------- --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_event,3},{handle_sync_event,4},{handle_info,3}, - {terminate,3},{code_change,4}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, StateName :: atom(), StateData :: term()} | + {ok, StateName :: atom(), StateData :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_event(Event :: term(), StateName :: atom(), + StateData :: term()) -> + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: term(), NewStateData :: term()}. +-callback handle_sync_event(Event :: term(), From :: {pid(), Tag :: term()}, + StateName :: atom(), StateData :: term()) -> + {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term()} | + {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewStateData :: term()} | + {stop, Reason :: term(), NewStateData :: term()}. +-callback handle_info(Info :: term(), StateName :: atom(), + StateData :: term()) -> + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: normal | term(), NewStateData :: term()}. +-callback terminate(Reason :: normal | shutdown | {shutdown, term()} + | term(), StateName :: atom(), StateData :: term()) -> + term(). +-callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(), + StateData :: term(), Extra :: term()) -> + {ok, NextStateName :: atom(), NewStateData :: term()}. %%% --------------------------------------------------- %%% Starts a generic state machine. @@ -561,16 +584,16 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> error_info(Reason, Name, Msg, StateName, StateData, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 09d94a9c40..dd0ef74f30 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -94,8 +94,6 @@ multi_call/2, multi_call/3, multi_call/4, enter_loop/3, enter_loop/4, enter_loop/5, wake_hib/5]). --export([behaviour_info/1]). - %% System exports -export([system_continue/3, system_terminate/4, @@ -111,13 +109,32 @@ %%% API %%%========================================================================= --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: term()) -> + {reply, Reply :: term(), NewState :: term()} | + {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: term()} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_cast(Request :: term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_info(Info :: timeout() | term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. +-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), + Extra :: term()) -> + {ok, NewState :: term()}. %%% ----------------------------------------------------------------- %%% Starts a generic server. @@ -729,16 +746,16 @@ error_info(_Reason, application_controller, _Msg, _State, _Debug) -> error_info(Reason, Name, Msg, State, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index c303ae60b5..314fd60903 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -173,12 +173,12 @@ format_fun(Fun) when is_function(Fun) -> analyze_exception(error, Term, Stack) -> case {is_stacktrace(Stack), Stack, Term} of - {true, [{_M,_F,As}=MFA|MFAs], function_clause} when is_list(As) -> - {Term,[MFA],MFAs}; - {true, [{shell,F,A}], function_clause} when is_integer(A) -> + {true, [{_,_,As,_}=MFAL|MFAs], function_clause} when is_list(As) -> + {Term,[MFAL],MFAs}; + {true, [{shell,F,A,_}], function_clause} when is_integer(A) -> {Term, [{F,A}], []}; - {true, [{_M,_F,_AorAs}=MFA|MFAs], undef} -> - {Term,[MFA],MFAs}; + {true, [{_,_,_,_}=MFAL|MFAs], undef} -> + {Term,[MFAL],MFAs}; {true, _, _} -> {Term,[],Stack}; {false, _, _} -> @@ -194,9 +194,11 @@ analyze_exception(_Class, Term, Stack) -> is_stacktrace([]) -> true; -is_stacktrace([{M,F,A}|Fs]) when is_atom(M), is_atom(F), is_integer(A) -> +is_stacktrace([{M,F,A,I}|Fs]) + when is_atom(M), is_atom(F), is_integer(A), is_list(I) -> is_stacktrace(Fs); -is_stacktrace([{M,F,As}|Fs]) when is_atom(M), is_atom(F), length(As) >= 0 -> +is_stacktrace([{M,F,As,I}|Fs]) + when is_atom(M), is_atom(F), length(As) >= 0, is_list(I) -> is_stacktrace(Fs); is_stacktrace(_) -> false. @@ -225,9 +227,9 @@ explain_reason(function_clause, error, [{F,A}], _PF, _S) -> %% Shell commands FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]), [<<"no function clause matching call to ">> | FAs]; -explain_reason(function_clause, error=Cl, [{M,F,As}], PF, S) -> +explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S) -> Str = <<"no function clause matching ">>, - format_errstr_call(Str, Cl, {M,F}, As, PF, S); + [format_errstr_call(Str, Cl, {M,F}, As, PF, S),$\s|location(Loc)]; explain_reason(if_clause, error, [], _PF, _S) -> <<"no true branch found when evaluating an if expression">>; explain_reason(noproc, error, [], _PF, _S) -> @@ -242,11 +244,11 @@ explain_reason({try_clause,V}, error=Cl, [], PF, S) -> %% "there is no try clause with a true guard sequence and a %% pattern matching..." format_value(V, <<"no try clause matching ">>, Cl, PF, S); -explain_reason(undef, error, [{M,F,A}], _PF, _S) -> +explain_reason(undef, error, [{M,F,A,_}], _PF, _S) -> %% Only the arity is displayed, not the arguments, if there are any. io_lib:fwrite(<<"undefined function ~s">>, [mfa_to_string(M, F, n_args(A))]); -explain_reason({shell_undef,F,A}, error, [], _PF, _S) -> +explain_reason({shell_undef,F,A,_}, error, [], _PF, _S) -> %% Give nicer reports for undefined shell functions %% (but not when the user actively calls shell_default:F(...)). io_lib:fwrite(<<"undefined shell command ~s/~w">>, [F, n_args(A)]); @@ -292,17 +294,19 @@ argss(I) -> io_lib:fwrite(<<"~w arguments">>, [I]). format_stacktrace1(S0, Stack0, PF, SF) -> - Stack1 = lists:dropwhile(fun({M,F,A}) -> SF(M, F, A) + Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A) end, lists:reverse(Stack0)), S = [" " | S0], Stack = lists:reverse(Stack1), format_stacktrace2(S, Stack, 1, PF). -format_stacktrace2(S, [{M,F,A}|Fs], N, PF) when is_integer(A) -> - [io_lib:fwrite(<<"~s~s ~s">>, - [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A)]) +format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF) when is_integer(A) -> + [io_lib:fwrite(<<"~s~s ~s ~s">>, + [sep(N, S), origin(N, M, F, A), + mfa_to_string(M, F, A), + location(L)]) | format_stacktrace2(S, Fs, N + 1, PF)]; -format_stacktrace2(S, [{M,F,As}|Fs], N, PF) when is_list(As) -> +format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF) when is_list(As) -> A = length(As), CalledAs = [S,<<" called as ">>], C = format_call("", CalledAs, {M,F}, As, PF), @@ -313,6 +317,16 @@ format_stacktrace2(S, [{M,F,As}|Fs], N, PF) when is_list(As) -> format_stacktrace2(_S, [], _N, _PF) -> "". +location(L) -> + File = proplists:get_value(file, L), + Line = proplists:get_value(line, L), + if + File =/= undefined, Line =/= undefined -> + io_lib:format("(~s, line ~w)", [File, Line]); + true -> + "" + end. + sep(1, S) -> S; sep(_, S) -> [$\n | S]. diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index bba46e4cb6..e73c087753 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -628,9 +628,10 @@ keydelete3(_, _, []) -> []. -spec keyreplace(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + NewTuple :: Tuple, + Tuple :: tuple(). keyreplace(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keyreplace3(K, N, L, New). @@ -660,9 +661,10 @@ keytake(_K, _N, [], _L) -> false. -spec keystore(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple(), ...], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple, ...], + NewTuple :: Tuple, + Tuple :: tuple(). keystore(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keystore2(K, N, L, New). @@ -740,8 +742,9 @@ keysort_1(_I, X, _EX, [], R) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). keymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> case L2 of @@ -842,8 +845,9 @@ ukeysort_1(_I, X, _EX, []) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 -> case L1 of @@ -873,8 +877,9 @@ rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> -spec keymap(Fun, N, TupleList1) -> TupleList2 when Fun :: fun((Term1 :: term()) -> Term2 :: term()), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()]. + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + Tuple :: tuple(). keymap(Fun, Index, [Tup|Tail]) -> [setelement(Index, Tup, Fun(element(Index, Tup)))|keymap(Fun, Index, Tail)]; diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 48e22e53fa..63b397f3a5 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -333,17 +333,18 @@ form({function,Line,Name0,Arity0,Clauses0}) -> form(AnyOther) -> AnyOther. function(Name, Arity, Clauses0) -> - {Clauses1,_} = clauses(Clauses0,gb_sets:new()), + Clauses1 = clauses(Clauses0), {Name,Arity,Clauses1}. -clauses([C0|Cs],Bound) -> - {C1,Bound1} = clause(C0,Bound), - {C2,Bound2} = clauses(Cs,Bound1), - {[C1|C2],Bound2}; -clauses([],Bound) -> {[],Bound}. +clauses([C0|Cs]) -> + C1 = clause(C0,gb_sets:new()), + C2 = clauses(Cs), + [C1|C2]; +clauses([]) -> []. + clause({clause,Line,H0,G0,B0},Bound) -> {H1,Bound1} = copy(H0,Bound), - {B1,Bound2} = copy(B0,Bound1), - {{clause,Line,H1,G0,B1},Bound2}. + {B1,_Bound2} = copy(B0,Bound1), + {clause,Line,H1,G0,B1}. copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}}, As0},Bound) -> diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 5129ba5074..c1285dab60 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -330,22 +330,22 @@ obsolete_1(erlang, fault, 2) -> obsolete_1(file, rawopen, 2) -> {removed, "deprecated (will be removed in R13B); use file:open/2 with the raw option"}; -obsolete_1(http, request, 1) -> {deprecated,{httpc,request,1},"R15B"}; -obsolete_1(http, request, 2) -> {deprecated,{httpc,request,2},"R15B"}; -obsolete_1(http, request, 4) -> {deprecated,{httpc,request,4},"R15B"}; -obsolete_1(http, request, 5) -> {deprecated,{httpc,request,5},"R15B"}; -obsolete_1(http, cancel_request, 1) -> {deprecated,{httpc,cancel_request,1},"R15B"}; -obsolete_1(http, cancel_request, 2) -> {deprecated,{httpc,cancel_request,2},"R15B"}; -obsolete_1(http, set_option, 2) -> {deprecated,{httpc,set_option,2},"R15B"}; -obsolete_1(http, set_option, 3) -> {deprecated,{httpc,set_option,3},"R15B"}; -obsolete_1(http, set_options, 1) -> {deprecated,{httpc,set_options,1},"R15B"}; -obsolete_1(http, set_options, 2) -> {deprecated,{httpc,set_options,2},"R15B"}; -obsolete_1(http, verify_cookies, 2) -> {deprecated,{httpc,verify_cookies,2},"R15B"}; -obsolete_1(http, verify_cookies, 3) -> {deprecated,{httpc,verify_cookies,3},"R15B"}; -obsolete_1(http, cookie_header, 1) -> {deprecated,{httpc,cookie_header,1},"R15B"}; -obsolete_1(http, cookie_header, 2) -> {deprecated,{httpc,cookie_header,2},"R15B"}; -obsolete_1(http, stream_next, 1) -> {deprecated,{httpc,stream_next,1},"R15B"}; -obsolete_1(http, default_profile, 0) -> {deprecated,{httpc,default_profile,0},"R15B"}; +obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"}; +obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"}; +obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"}; +obsolete_1(http, request, 5) -> {removed,{httpc,request,5},"R15B"}; +obsolete_1(http, cancel_request, 1) -> {removed,{httpc,cancel_request,1},"R15B"}; +obsolete_1(http, cancel_request, 2) -> {removed,{httpc,cancel_request,2},"R15B"}; +obsolete_1(http, set_option, 2) -> {removed,{httpc,set_option,2},"R15B"}; +obsolete_1(http, set_option, 3) -> {removed,{httpc,set_option,3},"R15B"}; +obsolete_1(http, set_options, 1) -> {removed,{httpc,set_options,1},"R15B"}; +obsolete_1(http, set_options, 2) -> {removed,{httpc,set_options,2},"R15B"}; +obsolete_1(http, verify_cookies, 2) -> {removed,{httpc,store_cookies,2},"R15B"}; +obsolete_1(http, verify_cookies, 3) -> {removed,{httpc,store_cookies,3},"R15B"}; +obsolete_1(http, cookie_header, 1) -> {removed,{httpc,cookie_header,1},"R15B"}; +obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B"}; +obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"}; +obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"}; obsolete_1(httpd, start, 0) -> {removed,{inets,start,[2,3]},"R14B"}; obsolete_1(httpd, start, 1) -> {removed,{inets,start,[2,3]},"R14B"}; @@ -449,7 +449,7 @@ obsolete_1(ssl_pkix, decode_cert, A) when A =:= 1; A =:= 2 -> %% Added in R13B04. obsolete_1(erlang, concat_binary, 1) -> - {deprecated,{erlang,list_to_binary,1},"R15B"}; + {removed,{erlang,list_to_binary,1},"R15B"}; %% Added in R14A. obsolete_1(ssl, peercert, 2) -> @@ -469,6 +469,10 @@ obsolete_1(docb_transform, _, _) -> obsolete_1(docb_xml_check, _, _) -> {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; +%% Added in R15B +obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> + {deprecated,"deprecated (will be removed in R16A); has no effect as drivers are no longer used."}; + obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 5ca04ff023..2b691e6abf 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -123,7 +123,7 @@ -record(setup, {parent}). --define(THROWN_ERROR, {?MODULE, throw_error, _}). +-define(THROWN_ERROR, {?MODULE, throw_error, _, _}). -export_type([query_handle/0]). @@ -1272,7 +1272,10 @@ abstr_term(Fun, Line) when is_function(Fun) -> case erlang:fun_info(Fun, type) of {type, external} -> {module, Module} = erlang:fun_info(Fun, module), - {'fun', Line, {function,Module,Name,Arity}}; + {'fun', Line, {function, + {atom,Line,Module}, + {atom,Line,Name}, + {integer,Line,Arity}}}; {type, local} -> {'fun', Line, {function,Name,Arity}} end @@ -3701,7 +3704,8 @@ lookup_join(F1, C1, LuF, C2, Rev) -> maybe_error_logger(allowed, _) -> ok; maybe_error_logger(Name, Why) -> - [_, _, {?MODULE,maybe_error_logger,_} | Stacktrace] = expand_stacktrace(), + [_, _, {?MODULE,maybe_error_logger,_,_} | Stacktrace] = + expand_stacktrace(), Trimmer = fun(M, _F, _A) -> M =:= erl_eval end, Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end, X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater), @@ -3720,7 +3724,7 @@ expand_stacktrace() -> expand_stacktrace(D) -> _ = erlang:system_flag(backtrace_depth, D), {'EXIT', {foo, Stacktrace}} = (catch erlang:error(foo)), - L = lists:takewhile(fun({M,_,_}) -> M =/= ?MODULE + L = lists:takewhile(fun({M,_,_,_}) -> M =/= ?MODULE end, lists:reverse(Stacktrace)), if length(L) < 3 andalso length(Stacktrace) =:= D -> diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index dbb524cc74..d7b51a151c 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -26,6 +26,10 @@ -export([seed/0, seed/1, seed/3, uniform/0, uniform/1, uniform_s/1, uniform_s/2, seed0/0]). +-define(PRIME1, 30269). +-define(PRIME2, 30307). +-define(PRIME3, 30323). + %%----------------------------------------------------------------------- %% The type of the state @@ -44,7 +48,11 @@ seed0() -> -spec seed() -> ran(). seed() -> - reseed(seed0()). + case seed_put(seed0()) of + undefined -> seed0(); + {_,_,_} = Tuple -> Tuple + end. + %% seed({A1, A2, A3}) %% Seed random number generation @@ -66,17 +74,15 @@ seed({A1, A2, A3}) -> A3 :: integer(). seed(A1, A2, A3) -> - put(random_seed, - {abs(A1) rem 30269, abs(A2) rem 30307, abs(A3) rem 30323}). + seed_put({(abs(A1) rem (?PRIME1-1)) + 1, % Avoid seed numbers that are + (abs(A2) rem (?PRIME2-1)) + 1, % even divisors of the + (abs(A3) rem (?PRIME3-1)) + 1}). % corresponding primes. --spec reseed(ran()) -> ran(). - -reseed({A1, A2, A3}) -> - case seed(A1, A2, A3) of - undefined -> seed0(); - {_,_,_} = Tuple -> Tuple - end. +-spec seed_put(ran()) -> 'undefined' | ran(). + +seed_put(Seed) -> + put(random_seed, Seed). %% uniform() %% Returns a random float between 0 and 1. @@ -88,11 +94,11 @@ uniform() -> undefined -> seed0(); Tuple -> Tuple end, - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, put(random_seed, {B1,B2,B3}), - R = A1/30269 + A2/30307 + A3/30323, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, R - trunc(R). %% uniform(N) -> I @@ -116,10 +122,10 @@ uniform(N) when is_integer(N), N >= 1 -> State1 :: ran(). uniform_s({A1, A2, A3}) -> - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, - R = A1/30269 + A2/30307 + A3/30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, {R - trunc(R), {B1,B2,B3}}. %% uniform_s(N, State) -> {I, NewState} diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index e08258a535..246d535943 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -48,7 +48,7 @@ split(Subject,RE) -> Subject :: iodata() | unicode:charlist(), RE :: mp() | iodata() | unicode:charlist(), Options :: [ Option ], - Option :: anchored | global | notbol | noteol | notempty + Option :: anchored | notbol | noteol | notempty | {offset, non_neg_integer()} | {newline, nl_spec()} | bsr_anycrlf | bsr_unicode | {return, ReturnType} | {parts, NumParts} | group | trim | CompileOpt, @@ -573,10 +573,10 @@ ucompile(RE,Options) -> re:compile(unicode:characters_to_binary(RE,unicode),Options) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [RE,Options])), - erlang:raise(error,AnyError,[{Mod,compile,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,compile,L,Loc}|Rest]) end. @@ -585,10 +585,10 @@ urun(Subject,RE,Options) -> urun2(Subject,RE,Options) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,RE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end. urun2(Subject0,RE0,Options0) -> @@ -625,20 +625,20 @@ grun(Subject,RE,{Options,NeedClean}) -> grun2(Subject,RE,{Options,NeedClean}) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,RE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end; grun(Subject,RE,{Options,NeedClean,OrigRE}) -> try grun2(Subject,RE,{Options,NeedClean}) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,OrigRE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end. grun2(Subject,RE,{Options,NeedClean}) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index e3e23e09bc..964697cae6 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1088,7 +1088,7 @@ shell_default(F,As,Bs) -> end. shell_undef(F,A) -> - erlang:error({shell_undef,F,A}). + erlang:error({shell_undef,F,A,[]}). local_func_handler(Shell, RT, Ef) -> H = fun(Lf) -> diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index dc31647eb5..2dd5ccce7a 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -27,8 +27,6 @@ which_children/1, count_children/1, check_childspecs/1]). --export([behaviour_info/1]). - %% Internal exports -export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]). -export([handle_cast/2]). @@ -90,14 +88,12 @@ -define(is_simple(State), State#state.strategy =:= simple_one_for_one). -%%-------------------------------------------------------------------------- - --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, {{RestartStrategy :: strategy(), + MaxR :: non_neg_integer(), + MaxT :: non_neg_integer()}, + [ChildSpec :: child_spec()]}} + | ignore. %%% --------------------------------------------------- %%% This is a general process supervisor built upon gen_server.erl. @@ -519,9 +515,12 @@ handle_info(Msg, State) -> %% -spec terminate(term(), state()) -> 'ok'. +terminate(_Reason, #state{children=[Child]} = State) when ?is_simple(State) -> + terminate_dynamic_children(Child, dynamics_db(Child#child.restart_type, + State#state.dynamics), + State#state.name); terminate(_Reason, State) -> - terminate_children(State#state.children, State#state.name), - ok. + terminate_children(State#state.children, State#state.name). %% %% Change code for the supervisor. @@ -661,6 +660,9 @@ do_restart(_, normal, Child, State) -> do_restart(_, shutdown, Child, State) -> NState = state_del_child(Child, State), {ok, NState}; +do_restart(_, {shutdown, _Term}, Child, State) -> + NState = state_del_child(Child, State), + {ok, NState}; do_restart(transient, Reason, Child, State) -> report_error(child_terminated, Reason, Child, State#state.name), restart(Child, State); @@ -831,8 +833,109 @@ monitor_child(Pid) -> %% that will be handled in shutdown/2. ok end. - - + + +%%----------------------------------------------------------------- +%% Func: terminate_dynamic_children/3 +%% Args: Child = child_rec() +%% Dynamics = ?DICT() | ?SET() +%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} +%% Returns: ok +%% +%% +%% Shutdown all dynamic children. This happens when the supervisor is +%% stopped. Because the supervisor can have millions of dynamic children, we +%% can have an significative overhead here. +%%----------------------------------------------------------------- +terminate_dynamic_children(Child, Dynamics, SupName) -> + {Pids, EStack0} = monitor_dynamic_children(Child, Dynamics), + Sz = ?SETS:size(Pids), + EStack = case Child#child.shutdown of + brutal_kill -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + infinity -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + Time -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + TRef = erlang:start_timer(Time, self(), kill), + wait_dynamic_children(Child, Pids, Sz, TRef, EStack0) + end, + %% Unrool stacked errors and report them + ?DICT:fold(fun(Reason, Ls, _) -> + report_error(shutdown_error, Reason, + Child#child{pid=Ls}, SupName) + end, ok, EStack). + + +monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) -> + ?SETS:fold(fun(P, {Pids, EStack}) -> + case monitor_child(P) of + ok -> + {?SETS:add_element(P, Pids), EStack}; + {error, normal} -> + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} + end + end, {?SETS:new(), ?DICT:new()}, Dynamics); +monitor_dynamic_children(#child{restart_type=RType}, Dynamics) -> + ?DICT:fold(fun(P, _, {Pids, EStack}) -> + case monitor_child(P) of + ok -> + {?SETS:add_element(P, Pids), EStack}; + {error, normal} when RType =/= permanent -> + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} + end + end, {?SETS:new(), ?DICT:new()}, Dynamics). + + +wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> + EStack; +wait_dynamic_children(_Child, _Pids, 0, TRef, EStack) -> + %% If the timer has expired before its cancellation, we must empty the + %% mail-box of the 'timeout'-message. + erlang:cancel_timer(TRef), + receive + {timeout, TRef, kill} -> + EStack + after 0 -> + EStack + end; +wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz, + TRef, EStack) -> + receive + {'DOWN', _MRef, process, Pid, killed} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, Reason} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)) + end; +wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, + TRef, EStack) -> + receive + {'DOWN', _MRef, process, Pid, shutdown} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, Reason} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)); + + {timeout, TRef, kill} -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz-1, undefined, EStack) + end. + %%----------------------------------------------------------------- %% Child/State manipulating functions. %%----------------------------------------------------------------- @@ -1054,7 +1157,7 @@ validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}). validShutdown(Shutdown, _) when is_integer(Shutdown), Shutdown > 0 -> true; -validShutdown(infinity, supervisor) -> true; +validShutdown(infinity, _) -> true; validShutdown(brutal_kill, _) -> true; validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}). @@ -1135,6 +1238,13 @@ report_error(Error, Reason, Child, SupName) -> error_logger:error_report(supervisor_report, ErrorMsg). +extract_child(Child) when is_list(Child#child.pid) -> + [{nb_children, length(Child#child.pid)}, + {name, Child#child.name}, + {mfargs, Child#child.mfargs}, + {restart_type, Child#child.restart_type}, + {shutdown, Child#child.shutdown}, + {child_type, Child#child.child_type}]; extract_child(Child) -> [{pid, Child#child.pid}, {name, Child#child.name}, diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl index 555cb5a66f..e8405ab9a4 100644 --- a/lib/stdlib/src/supervisor_bridge.erl +++ b/lib/stdlib/src/supervisor_bridge.erl @@ -22,15 +22,14 @@ %% External exports -export([start_link/2, start_link/3]). --export([behaviour_info/1]). %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). -export([code_change/3]). -behaviour_info(callbacks) -> - [{init,1},{terminate,2}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, Pid :: pid(), State :: term()} | ignore | {error, Error :: term()}. +-callback terminate(Reason :: (shutdown | term()), State :: term()) -> + Ignored :: term(). %%%----------------------------------------------------------------- %%% This is a rewrite of supervisor_bridge from BS.3. diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index a5d9965ca2..e9b90befe6 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -73,7 +73,7 @@ characters_to_list_int(ML, Encoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,Encoding])), erlang:raise(error,TheError,[{Mod,characters_to_list,L}|Rest]) @@ -109,7 +109,7 @@ characters_to_binary(ML) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) @@ -127,7 +127,7 @@ characters_to_binary_int(ML,InEncoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,InEncoding])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) @@ -159,7 +159,7 @@ characters_to_binary(ML, latin1, Uni) when is_binary(ML) and ((Uni =:= utf8) or _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,latin1,Uni])), erlang:raise(error,TheError, @@ -181,7 +181,7 @@ characters_to_binary(ML,Uni,latin1) when is_binary(ML) and ((Uni =:= utf8) or _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,Uni,latin1])), erlang:raise(error,TheError, @@ -200,7 +200,7 @@ characters_to_binary(ML, InEncoding, OutEncoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,InEncoding,OutEncoding])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) |