Merge remote branch 'upstream/maint' into maint

6 files changed, 304 insertions, 9 deletions

diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index 27e70ac4d4..498d850df3 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -22,7 +22,7 @@
 -export([script_name/0, create/2, extract/2]).
 
 %% Internal API.
--export([start/0, start/1]).
+-export([start/0, start/1, parse_file/1]).
 
 %%-----------------------------------------------------------------------
 
@@ -346,7 +346,8 @@ parse_and_run(File, Args, Options) ->
             case Source of
                 archive ->
 		    {ok, FileInfo} = file:read_file_info(File),
-                    case code:set_primary_archive(File, FormsOrBin, FileInfo) of
+                    case code:set_primary_archive(File, FormsOrBin, FileInfo,
+						  fun escript:parse_file/1) of
                         ok when CheckOnly ->
 			    case code:load_file(Module) of
 				{module, _} ->
@@ -396,6 +397,19 @@ parse_and_run(File, Args, Options) ->
 %% Parse script
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
+%% Only used as callback by erl_prim_loader
+parse_file(File) ->
+    try parse_file(File, false) of
+	{_Source, _Module, FormsOrBin, _HasRecs, _Mode}
+	  when is_binary(FormsOrBin) ->
+	    {ok, FormsOrBin};
+	_ ->
+	    {error, no_archive_bin}
+    catch
+	throw:Reason ->
+	    {error, Reason}
+    end.
+
 parse_file(File, CheckOnly) ->
     {HeaderSz, NextLineNo, Fd, Sections} =
 	parse_header(File, false),
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 59c6d240ba..04308a51b7 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -270,7 +270,7 @@ enter_loop(Mod, Options, State) ->
     enter_loop(Mod, Options, State, self(), infinity).
 
 enter_loop(Mod, Options, State, ServerName = {Scope, _})
-  when Scope == local; Scope == local ->
+  when Scope == local; Scope == global ->
     enter_loop(Mod, Options, State, ServerName, infinity);
 
 enter_loop(Mod, Options, State, ServerName = {via, _, _}) ->
diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl
index 7ed1ee742a..38c085616d 100644
--- a/lib/stdlib/test/escript_SUITE.erl
+++ b/lib/stdlib/test/escript_SUITE.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2012. 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
@@ -29,6 +29,7 @@
 	 module_script/1,
 	 beam_script/1,
 	 archive_script/1,
+	 archive_script_file_access/1,
 	 epp/1,
 	 create_and_extract/1,
 	 foldl/1,
@@ -44,7 +45,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
 all() -> 
     [basic, errors, strange_name, emulator_flags,
      module_script, beam_script, archive_script, epp,
-     create_and_extract, foldl, overflow].
+     create_and_extract, foldl, overflow,
+     archive_script_file_access].
 
 groups() -> 
     [].
@@ -356,7 +358,7 @@ beam_script(Config) when is_list(Config) ->
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% Create an archive file containing two entire applications plus two
 %% alternate main modules. Generate a new escript containing the archive
-%% (with .app and .beam files and ) and the escript header.
+%% (with .app and .beam files and) and the escript header.
 
 archive_script(Config) when is_list(Config) ->
     %% Copy the orig files to priv_dir
@@ -464,6 +466,147 @@ archive_script(Config) when is_list(Config) ->
 
     ok.
 
+%% Test the correction of OTP-10071
+%% The errors identified are
+%%
+%% a) If primary archive was named "xxx", then a file in the same
+%%    directory named "xxxyyy" would be interpreted as a file named yyy
+%%    inside the archive.
+%%
+%% b) erl_prim_loader did not correctly create and normalize absolute
+%%    paths for primary archive and files inside it, so unless given
+%%    with exact same path files inside the archive would not be
+%%    found. E.g. if escript was started as ./xxx then "xxx/file"
+%%    would not be found since erl_prim_loader would try to match
+%%    /full/path/to/xxx with /full/path/to/./xxx. Same problem with
+%%    ../. Also, the use of symlinks in the path to the archive would
+%%    cause problems.
+%%
+%% c) Depending on how the primary archive was built,
+%%    erl_prim_loader:list_dir/1 would sometimes return an empty string
+%%    inside the file list. This was a virtual element representing the
+%%    top directory of the archive. This shall not occur.
+%%
+archive_script_file_access(Config) when is_list(Config) ->
+    %% Copy the orig files to priv_dir
+    DataDir = ?config(data_dir, Config),
+    PrivDir = ?config(priv_dir, Config),
+
+    MainMod = "archive_script_file_access",
+    MainSrc = MainMod ++ ".erl",
+    MainBeam = MainMod ++ ".beam",
+
+    Archive = filename:join([PrivDir, "archive_script_file_access.zip"]),
+    ?line {ok, _} = zip:create(Archive, ["archive_script_file_access"],
+			       [{compress, []}, {cwd, DataDir}]),
+    ?line {ok, _} = zip:extract(Archive, [{cwd, PrivDir}]),
+    TopDir = filename:join([PrivDir, "archive_script_file_access"]),
+
+    %% Compile the code
+    ?line ok = compile_files([MainSrc], TopDir, TopDir),
+
+    %% First, create a file structure which will be included in the archive:
+    %%
+    %% dir1/
+    %% dir1/subdir1/
+    %% dir1/subdir1/file1
+    %%
+    {ok, OldDir} = file:get_cwd(),
+    ok = file:set_cwd(TopDir),
+    DummyDir = "dir1",
+    DummySubDir = filename:join(DummyDir, "subdir1"),
+    RelDummyFile = filename:join(DummySubDir, "file1"),
+    DummyFile = filename:join(TopDir,RelDummyFile),
+    ok = filelib:ensure_dir(DummyFile),
+    ok = file:write_file(DummyFile, ["foo\nbar\nbaz"]),
+
+    %% 1. Create zip archive by adding the dummy file and the beam
+    %%    file as binaries to zip.
+    %%
+    %% This used to provoke the following issues when the script was run as
+    %% "./<script_name>":
+    %% a. erl_prim_loader:read_file_info/1 returning 'error'
+    %% b. erl_prim_loader:list_dir/1 returning {ok, ["dir1", [], "file1"]}
+    %%    leading to an infinite loop in reltool_target:spec_dir/1
+    Files1 =
+	lists:map(fun(Filename) ->
+			  {ok, Bin} = file:read_file(Filename),
+			  {Filename,Bin}
+		  end,
+		  [RelDummyFile,MainBeam]),
+    {ok, {"mem", Bin1}} = zip:create("mem", Files1, [memory]),
+
+    %% Create the escript
+    ScriptName1 = "archive_script_file_access1",
+    Script1 = filename:join([PrivDir, ScriptName1]),
+    Flags = "-escript main " ++ MainMod,
+    ok = escript:create(Script1,[shebang,{emu_args,Flags},{archive,Bin1}]),
+    ok = file:change_mode(Script1,8#00744),
+
+    %% If supported, create a symlink to the script. This is used to
+    %% test error b) described above this test case.
+    SymlinkName1 = "symlink_to_"++ScriptName1,
+    Symlink1 = filename:join([PrivDir, SymlinkName1]),
+    file:make_symlink(ScriptName1,Symlink1), % will fail if not supported
+
+    %% Also add a dummy file in the same directory with the same name
+    %% as the script except is also has an extension. This used to
+    %% test error a) described above this test case.
+    ok = file:write_file(Script1 ++ ".extension",
+			 <<"same name as script, but with extension">>),
+
+    %% Change to script's directory and run it as "./<script_name>"
+    ok = file:set_cwd(PrivDir),
+    run(PrivDir, "./" ++ ScriptName1 ++ " " ++ ScriptName1,
+	[<<"ExitCode:0">>]),
+    ok = file:set_cwd(TopDir),
+
+
+    %% 2. Create zip archive by letting zip read the files from the file system
+    %%
+    %% The difference compared to the archive_script_file_access1 is
+    %% that this will have a file element for each directory in the
+    %% archive - while archive_script_file_access1 will only have a
+    %% file element per regular file.
+    Files2 = [DummyDir,MainBeam],
+    {ok, {"mem", Bin2}} = zip:create("mem", Files2, [memory]),
+
+    %% Create the escript
+    ScriptName2 = "archive_script_file_access2",
+    Script2 = filename:join([PrivDir, ScriptName2]),
+    ok = escript:create(Script2,[shebang,{emu_args,Flags},{archive,Bin2}]),
+    ok = file:change_mode(Script2,8#00744),
+
+    %% Also add a dummy file in the same directory with the same name
+    %% as the script except is also has an extension. This used to
+    %% test error a) described above this test case.
+    ok = file:write_file(Script2 ++ ".extension",
+			 <<"same name as script, but with extension">>),
+
+    %% If supported, create a symlink to the script. This is used to
+    %% test error b) described above this test case.
+    SymlinkName2 = "symlink_to_"++ScriptName2,
+    Symlink2 = filename:join([PrivDir, SymlinkName2]),
+    file:make_symlink(ScriptName2,Symlink2), % will fail if not supported
+
+    %% Change to script's directory and run it as "./<script_name>"
+    ok = file:set_cwd(PrivDir),
+    run(PrivDir, "./" ++ ScriptName2 ++ " " ++ ScriptName2,
+	[<<"ExitCode:0">>]),
+
+    %% 3. If symlinks are supported, run one of the scripts via a symlink.
+    %%
+    %% This is in order to test error b) described above this test case.
+    case file:read_link(Symlink2) of
+	{ok,_} ->
+	    run(PrivDir, "./" ++ SymlinkName2 ++ " " ++ ScriptName2,
+		[<<"ExitCode:0">>]);
+	_ -> % not supported
+	    ok
+    end,
+    ok = file:set_cwd(OldDir).
+
+
 compile_app(TopDir, AppName) ->
     AppDir = filename:join([TopDir, AppName]),
     SrcDir = filename:join([AppDir, "src"]),
diff --git a/lib/stdlib/test/escript_SUITE_data/archive_script/archive_script_main2.erl b/lib/stdlib/test/escript_SUITE_data/archive_script/archive_script_main2.erl
index de56579998..431a51b0e5 100644
--- a/lib/stdlib/test/escript_SUITE_data/archive_script/archive_script_main2.erl
+++ b/lib/stdlib/test/escript_SUITE_data/archive_script/archive_script_main2.erl
@@ -21,6 +21,8 @@
 
 -export([main/1]).
 
+-include_lib("kernel/include/file.hrl").
+
 -define(DUMMY, archive_script_dummy).
 -define(DICT, archive_script_dict).
 
@@ -32,7 +34,7 @@ main(MainArgs) ->
     io:format("dummy:~p\n",[[E || E <- ErlArgs, element(1, E) =:= ?DUMMY]]),
 
     %% Start the applications
-    {error, {not_started, ?DICT}} = application:start(archive_script_dummy),
+    {error, {not_started, ?DICT}} = application:start(?DUMMY),
     ok = application:start(?DICT),
     ok = application:start(?DUMMY),
     
@@ -57,4 +59,17 @@ main(MainArgs) ->
     ok = ?DICT:erase(Tab, Key),
     error = ?DICT:find(Tab, Key),
     ok = ?DICT:erase(Tab),
+
+    %% Check mtime related caching bug with escript/primary archive files
+    Escript = escript:script_name(),
+    {ok, FileInfo} = file:read_file_info(Escript),
+    %% Modify mtime of archive file and try to reload module
+    FileInfo2 = FileInfo#file_info{mtime=calendar:now_to_local_time(now())},
+    ok = file:write_file_info(Escript, FileInfo2),
+    Module = ?DICT,
+    {file, _} = code:is_loaded(Module),
+    true = code:delete(Module),
+    false = code:is_loaded(Module),
+    {module, Module} = code:ensure_loaded(Module),
+
     ok.
diff --git a/lib/stdlib/test/escript_SUITE_data/archive_script_file_access/archive_script_file_access.erl b/lib/stdlib/test/escript_SUITE_data/archive_script_file_access/archive_script_file_access.erl
new file mode 100644
index 0000000000..b03c8ba70d
--- /dev/null
+++ b/lib/stdlib/test/escript_SUITE_data/archive_script_file_access/archive_script_file_access.erl
@@ -0,0 +1,105 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. 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
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(archive_script_file_access).
+-behaviour(escript).
+
+-export([main/1]).
+
+-include_lib("kernel/include/file.hrl").
+
+main([RelArchiveFile]) ->
+
+    AbsArchiveFile = filename:absname(RelArchiveFile),
+    DotSlashArchiveFile = "./" ++ RelArchiveFile,
+
+    Beam = atom_to_list(?MODULE) ++ ".beam",
+    AbsBeam = filename:join(AbsArchiveFile,Beam),
+    RelBeam = filename:join(RelArchiveFile,Beam),
+    DotSlashBeam = filename:join(DotSlashArchiveFile,Beam),
+    Dir = "dir1",
+    AbsDir = filename:join(AbsArchiveFile,Dir),
+    RelDir = filename:join(RelArchiveFile,Dir),
+    DotSlashDir = filename:join(DotSlashArchiveFile,Dir),
+    SubDir = "subdir1",
+    AbsSubDir = filename:join(AbsDir,SubDir),
+    RelSubDir = filename:join(RelDir,SubDir),
+    DotSlashSubDir = filename:join(DotSlashDir,SubDir),
+
+    {ok,List1} = erl_prim_loader:list_dir(AbsArchiveFile),
+    {ok,List1} = erl_prim_loader:list_dir(RelArchiveFile),
+    {ok,List1} = erl_prim_loader:list_dir(DotSlashArchiveFile),
+    {ok,List1} = erl_prim_loader:list_dir(AbsArchiveFile ++ "/"),
+    {ok,List1} = erl_prim_loader:list_dir(AbsArchiveFile ++ "/."),
+    {ok,List1} = erl_prim_loader:list_dir(filename:join([AbsDir,".."])),
+    {ok,List1} = erl_prim_loader:list_dir(filename:join([RelDir,".."])),
+    {ok,List1} = erl_prim_loader:list_dir(filename:join([DotSlashDir,".."])),
+    {ok,List1} = erl_prim_loader:list_dir(filename:join([AbsSubDir,"..",".."])),
+    {ok,List1} = erl_prim_loader:list_dir(filename:join([RelSubDir,"..",".."])),
+    {ok,List1} = erl_prim_loader:list_dir(filename:join([DotSlashSubDir,"..",".."])),
+    false = lists:member([],List1),
+
+    %% If symlinks are supported on this platform...
+    RelSymlinkArchiveFile = "symlink_to_" ++ RelArchiveFile,
+    case file:read_link(RelSymlinkArchiveFile) of
+	{ok,_} ->
+	    DotSlashSymlinkArchiveFile = "./" ++ RelSymlinkArchiveFile,
+	    AbsSymlinkArchiveFile=filename:join(filename:dirname(AbsArchiveFile),
+						RelSymlinkArchiveFile),
+	    {ok,List1} = erl_prim_loader:list_dir(AbsSymlinkArchiveFile),
+	    {ok,List1} = erl_prim_loader:list_dir(RelSymlinkArchiveFile),
+	    {ok,List1} = erl_prim_loader:list_dir(DotSlashSymlinkArchiveFile);
+	_ -> % not supported
+	    ok
+    end,
+
+
+    {ok,List2} = erl_prim_loader:list_dir(AbsDir),
+    {ok,List2} = erl_prim_loader:list_dir(RelDir),
+    {ok,List2} = erl_prim_loader:list_dir(DotSlashDir),
+    false = lists:member([],List2),
+
+    error = erl_prim_loader:list_dir(AbsBeam),
+    error = erl_prim_loader:list_dir(RelBeam),
+    error = erl_prim_loader:list_dir(DotSlashBeam),
+
+    error = erl_prim_loader:get_file(AbsArchiveFile),
+    error = erl_prim_loader:get_file(RelArchiveFile),
+    error = erl_prim_loader:get_file(DotSlashArchiveFile),
+    error = erl_prim_loader:get_file(AbsArchiveFile ++ "/"),
+    error = erl_prim_loader:get_file(AbsArchiveFile ++ "/."),
+    {ok,Bin,AbsBeam} = erl_prim_loader:get_file(AbsBeam),
+    {ok,Bin,RelBeam} = erl_prim_loader:get_file(RelBeam),
+    {ok,Bin,DotSlashBeam} = erl_prim_loader:get_file(DotSlashBeam),
+
+    {ok,#file_info{type=directory}=DFI} =
+	erl_prim_loader:read_file_info(AbsArchiveFile),
+    {ok,DFI} = erl_prim_loader:read_file_info(RelArchiveFile),
+    {ok,DFI} = erl_prim_loader:read_file_info(DotSlashArchiveFile),
+    {ok,DFI} = erl_prim_loader:read_file_info(AbsArchiveFile ++ "/"),
+    {ok,DFI} = erl_prim_loader:read_file_info(AbsArchiveFile ++ "/."),
+    {ok,#file_info{type=regular}=RFI} = erl_prim_loader:read_file_info(AbsBeam),
+    {ok,RFI} = erl_prim_loader:read_file_info(RelBeam),
+    {ok,RFI} = erl_prim_loader:read_file_info(DotSlashBeam),
+
+    F = AbsArchiveFile ++ ".extension",
+    error = erl_prim_loader:list_dir(F),
+    {ok,_,_} = erl_prim_loader:get_file(F),
+    {ok,#file_info{type=regular}} = erl_prim_loader:read_file_info(F),
+
+    ok.
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index cdf15ba017..48ef7e55ed 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -37,7 +37,8 @@
 
 % spawn export
 -export([spec_init_local/2, spec_init_global/2, spec_init_via/2,
-	 spec_init_default_timeout/2, spec_init_anonymous/1,
+	 spec_init_default_timeout/2, spec_init_global_default_timeout/2,
+         spec_init_anonymous/1,
 	 spec_init_anonymous_default_timeout/1,
 	 spec_init_not_proc_lib/1, cast_fast_messup/0]).
 
@@ -749,7 +750,7 @@ spec_init(suite) ->
 spec_init(Config) when is_list(Config) ->
     
     OldFlag = process_flag(trap_exit, true),
-    
+
     ?line {ok, Pid0} = start_link(spec_init_local, [{ok, my_server}, []]),
     ?line ok = gen_server:call(Pid0, started_p),
     ?line ok = gen_server:call(Pid0, stop),
@@ -819,6 +820,14 @@ spec_init(Config) when is_list(Config) ->
 	    test_server:fail(gen_server_did_not_die)
     end,
 
+    %% Before the OTP-10130 fix this failed because a timeout message
+    %% was generated as the spawned process crashed because a {global, Name}
+    %% was matched as a timeout value instead of matching on scope.
+    {ok, _PidHurra} =
+	start_link(spec_init_global_default_timeout, [{ok, hurra}, []]),
+    timer:sleep(1000),
+    ok = gen_server:call(_PidHurra, started_p),
+    
     ?line Pid5 = 
 	erlang:spawn_link(?MODULE, spec_init_not_proc_lib, [[]]),
     receive 
@@ -1125,6 +1134,15 @@ spec_init_default_timeout({ok, Name}, Options) ->
     %% Supervised init can occur here  ...
     gen_server:enter_loop(?MODULE, Options, {}, {local, Name}).
 
+%% OTP-10130, A bug was introduced where global scope was not matched when
+%% enter_loop/4 was called (no timeout).
+spec_init_global_default_timeout({ok, Name}, Options) ->
+    process_flag(trap_exit, true),
+    global:register_name(Name, self()),
+    proc_lib:init_ack({ok, self()}),
+    %% Supervised init can occur here  ...
+    gen_server:enter_loop(?MODULE, Options, {}, {global, Name}).
+
 spec_init_anonymous(Options) ->
     process_flag(trap_exit, true),
     proc_lib:init_ack({ok, self()}),