mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 18:03:36 +00:00
c02eb5163e
library/io.call_system.m:
Move the code in the "system access predicates" section of io.m
to this new module.
library/io.environment.m:
Move the predicates dealing with environment variables in io.m
to this new module.
library/io.m:
Delete the code moved to the new modules.
Leave behind in io.m "forwarding predicates", predicates that do nothing
except call the moved predicates in the new modules, to provide backward
compatibility. But do mark the forwarding predicates as obsolete,
to tell people to update their (at their leisure, since the obsoleteness
warning can be turned off).
Also leave behind in io.m the definitions of the types used
by some parameters of some of the moved predicates.
library/MODULES_DOC:
List the new modules among the documented modules.
library/library.m:
List the new modules, including io.file.m (added in a previous change)
among the documented standard library modules.
NEWS:
Announce the changes.
browser/browse.m:
browser/interactive_query.m:
compiler/fact_table.m:
compiler/handle_options.m:
compiler/make.module_target.m:
compiler/mercury_compile_main.m:
compiler/module_cmds.m:
compiler/optimize.m:
compiler/options_file.m:
deep_profiler/conf.m:
deep_profiler/mdprof_cgi.m:
deep_profiler/mdprof_test.m:
library/io.file.m:
mdbcomp/trace_counts.m:
ssdb/ssdb.m:
tests/general/environment.m:
tests/hard_coded/closeable_channel_test.m:
tests/hard_coded/setenv.m:
tests/hard_coded/system_sort.m:
Call the moved predicates directly in their new modules,
not indirectly through io.m.
438 lines
15 KiB
Mathematica
438 lines
15 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2002-2008, 2010-2011 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: mdprof_test.m.
|
|
% Author: zs.
|
|
%
|
|
% This file contains a tool for testing the behavior of the deep profiler.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module mdprof_test.
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred main(io::di, io::uo) is cc_multi.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module conf.
|
|
:- import_module dump.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.program_representation.
|
|
:- import_module profile.
|
|
:- import_module query.
|
|
:- import_module startup.
|
|
|
|
:- import_module array.
|
|
:- import_module bool.
|
|
:- import_module char.
|
|
:- import_module getopt.
|
|
:- import_module int.
|
|
:- import_module io.call_system.
|
|
:- import_module library.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
main(!IO) :-
|
|
io.progname_base("mdprof_test", ProgName, !IO),
|
|
io.command_line_arguments(Args0, !IO),
|
|
getopt.process_options(option_ops_multi(short, long, defaults),
|
|
Args0, Args, MaybeOptions),
|
|
io.stdout_stream(StdOut, !IO),
|
|
io.stderr_stream(StdErr, !IO),
|
|
(
|
|
MaybeOptions = ok(Options),
|
|
lookup_bool_option(Options, help, Help),
|
|
lookup_bool_option(Options, version, Version),
|
|
lookup_bool_option(Options, verify_profile, Verify),
|
|
(
|
|
Help = yes,
|
|
write_help_message(StdOut, ProgName, !IO)
|
|
;
|
|
Help = no
|
|
),
|
|
(
|
|
Version = yes,
|
|
write_version_message(StdOut, ProgName, !IO)
|
|
;
|
|
Version = no
|
|
),
|
|
( if
|
|
Help = no,
|
|
Version = no
|
|
then
|
|
(
|
|
Verify = no,
|
|
main_2(StdErr, ProgName, Args, Options, !IO)
|
|
;
|
|
Verify = yes,
|
|
verify_profile(StdErr, ProgName, Args, Options, !IO)
|
|
)
|
|
else
|
|
true
|
|
)
|
|
;
|
|
MaybeOptions = error(Error),
|
|
Msg = option_error_to_string(Error),
|
|
io.set_exit_status(1, !IO),
|
|
io.format(StdErr, "%s: error parsing options: %s\n",
|
|
[s(ProgName), s(Msg)], !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred main_2(io.text_output_stream::in, string::in, list(string)::in,
|
|
option_table::in, io::di, io::uo) is cc_multi.
|
|
|
|
main_2(ErrorStream, ProgName, Args, Options, !IO) :-
|
|
( if Args = [FileName] then
|
|
lookup_bool_option(Options, canonical_clique, Canonical),
|
|
lookup_bool_option(Options, verbose, Verbose),
|
|
lookup_accumulating_option(Options, dump, DumpStages),
|
|
lookup_accumulating_option(Options, dump_options, DumpArrayOptionsStr),
|
|
dump_array_options_to_dump_options(DumpArrayOptionsStr, DumpOptions),
|
|
server_name_port(Machine, !IO),
|
|
script_name(ScriptName, !IO),
|
|
(
|
|
Verbose = no,
|
|
MaybeOutput = no
|
|
;
|
|
Verbose = yes,
|
|
io.stdout_stream(Stdout, !IO),
|
|
MaybeOutput = yes(Stdout)
|
|
),
|
|
read_and_startup(Machine, ScriptName, FileName, Canonical,
|
|
MaybeOutput, DumpStages, DumpOptions, StartupResult, !IO),
|
|
(
|
|
StartupResult = ok(Deep),
|
|
lookup_bool_option(Options, test, Test),
|
|
(
|
|
Test = no
|
|
;
|
|
Test = yes,
|
|
test_server(default_preferences(Deep), Deep, Options, !IO)
|
|
)
|
|
;
|
|
StartupResult = error(Error),
|
|
io.set_exit_status(1, !IO),
|
|
io.format(ErrorStream, "%s: error reading %s: %s\n",
|
|
[s(ProgName), s(FileName), s(Error)], !IO)
|
|
)
|
|
else
|
|
io.set_exit_status(1, !IO),
|
|
write_help_message(ErrorStream, ProgName, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Verification mode
|
|
%
|
|
|
|
% In this mode of operation mdprof_test just checks to see if the deep
|
|
% profiler can read and process a Deep.data file, i.e do everything
|
|
% it needs to up to the point where we normally start querying a profile.
|
|
% This mode does not cause a server to be started.
|
|
|
|
:- pred verify_profile(io.text_output_stream::in, string::in, list(string)::in,
|
|
option_table::in, io::di, io::uo) is det.
|
|
|
|
verify_profile(ErrorStream, ProgName, Args0, Options, !IO) :-
|
|
(
|
|
Args0 = [],
|
|
Args = ["Deep.data"]
|
|
;
|
|
Args0 = [_ | _],
|
|
Args = Args0
|
|
),
|
|
list.foldl(verify_profile_2(ErrorStream, ProgName, Options), Args, !IO).
|
|
|
|
:- pred verify_profile_2(io.text_output_stream::in, string::in,
|
|
option_table::in, string::in, io::di, io::uo) is det.
|
|
|
|
verify_profile_2(ErrorStream, ProgName, Options, FileName, !IO) :-
|
|
lookup_bool_option(Options, canonical_clique, Canonical),
|
|
Machine = "dummy_server", % For verification this doesn't matter.
|
|
script_name(ScriptName, !IO),
|
|
read_and_startup(Machine, ScriptName, FileName, Canonical, no,
|
|
[], default_dump_options, Res, !IO),
|
|
(
|
|
Res = ok(_Deep)
|
|
;
|
|
Res = error(Error),
|
|
io.set_exit_status(1, !IO),
|
|
io.format(ErrorStream, "%s: error reading %s: %s\n",
|
|
[s(ProgName), s(FileName), s(Error)], !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred write_version_message(io.text_output_stream::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_version_message(OutputStream, ProgName, !IO) :-
|
|
library.version(Version, Fullarch),
|
|
io.format(OutputStream, "%s: Mercury deep profiler\n", [s(ProgName)], !IO),
|
|
io.format(OutputStream, "version: %s, on %s.\n",
|
|
[s(Version), s(Fullarch)], !IO).
|
|
|
|
:- pred write_help_message(io.text_output_stream::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_help_message(OutputStream, ProgName, !IO) :-
|
|
io.format(OutputStream,
|
|
"Usage: %s [<options>] <filename>\n", [s(ProgName)], !IO),
|
|
io.write_string(OutputStream,
|
|
"<filename> must name a deep profiling data file.\n" ++
|
|
"You should specify one of the following options:\n" ++
|
|
"--help Generate this help message.\n" ++
|
|
"--version Report the program's version number.\n" ++
|
|
"--verbose Generate progress messages during startup.\n" ++
|
|
"--test Test the deep profiler, generating all\n" ++
|
|
"\t\t\tpossible web pages of the popular types.\n" ++
|
|
"--verify-profile\n" ++
|
|
"\t\t\tVerify that <filename> is a well-formed deep profiling\n" ++
|
|
"\t\t\tdata file.\n" ++
|
|
"\n" ++
|
|
"You may also specify the following options:.\n" ++
|
|
"--test-dir <dirname>\n" ++
|
|
"\t\t\tPut the generated web pages into <dirname>.\n" ++
|
|
"--no-compress\n" ++
|
|
"\t\t\tDon't compress the resulting files, this speeds the test.\n" ++
|
|
"--procrep-coverage\n" ++
|
|
"\t\t\tRun the procrep coverage query on every static procedure\n" ++
|
|
"--recursion-types-histogram\n" ++
|
|
"\t\t\tRun the recursion types histogram query\n", !IO).
|
|
% --canonical-clique is not documented because it is not yet supported
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred test_server(preferences::in, deep::in,
|
|
option_table::in, io::di, io::uo) is cc_multi.
|
|
|
|
test_server(Pref, Deep, Options, !IO) :-
|
|
lookup_string_option(Options, test_dir, DirName),
|
|
string.format("test -d %s || mkdir -p %s", [s(DirName), s(DirName)], Cmd),
|
|
io.call_system.call_system(Cmd, _, !IO),
|
|
|
|
%XXX: These features have been disabled. Configuration options should be
|
|
% introduced to enable them as the user desires.
|
|
% array.max(Deep ^ clique_members, NumCliques),
|
|
% test_cliques(1, NumCliques, DirName, Pref, Deep, !IO),
|
|
% test_procs(1, NumProcStatics, DirName, Pref, Deep, !IO).
|
|
|
|
lookup_bool_option(Options, static_procrep_coverage,
|
|
StaticProcrepCoverage),
|
|
(
|
|
StaticProcrepCoverage = yes,
|
|
array.max(Deep ^ proc_statics, NumProcStatics),
|
|
test_procrep_static_coverages(1, NumProcStatics, Pref, Deep, Options,
|
|
!IO)
|
|
;
|
|
StaticProcrepCoverage = no
|
|
),
|
|
|
|
lookup_bool_option(Options, dynamic_procrep_coverage,
|
|
DynamicProcrepCoverage),
|
|
(
|
|
DynamicProcrepCoverage = yes,
|
|
array.max(Deep ^ proc_dynamics, NumProcDynamics),
|
|
test_procrep_dynamic_coverages(1, NumProcDynamics, Pref, Deep, Options,
|
|
!IO)
|
|
;
|
|
DynamicProcrepCoverage = no
|
|
),
|
|
|
|
lookup_bool_option(Options, recursion_types_histogram, RecTypesHistogram),
|
|
(
|
|
RecTypesHistogram = yes,
|
|
test_recursion_types_histogram(Pref, Deep, Options, !IO)
|
|
;
|
|
RecTypesHistogram = no
|
|
).
|
|
|
|
:- pred test_cliques(int::in, int::in, option_table::in, preferences::in,
|
|
deep::in, io::di, io::uo) is cc_multi.
|
|
|
|
test_cliques(Cur, Max, Options, Pref, Deep, !IO) :-
|
|
( if Cur =< Max then
|
|
try_exec(deep_cmd_clique(clique_ptr(Cur)), Pref, Deep, HTML),
|
|
write_test_html(Options, "clique", Cur, HTML, !IO),
|
|
test_cliques(Cur + 1, Max, Options, Pref, Deep, !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred test_procs(int::in, int::in, option_table::in, preferences::in,
|
|
deep::in, io::di, io::uo) is cc_multi.
|
|
|
|
test_procs(Cur, Max, Options, Pref, Deep, !IO) :-
|
|
( if Cur =< Max then
|
|
try_exec(deep_cmd_proc(proc_static_ptr(Cur)), Pref, Deep, HTML),
|
|
write_test_html(Options, "proc", Cur, HTML, !IO),
|
|
test_procs(Cur + 1, Max, Options, Pref, Deep, !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred test_procrep_static_coverages(int::in, int::in, preferences::in,
|
|
deep::in, option_table::in, io::di, io::uo) is cc_multi.
|
|
|
|
test_procrep_static_coverages(Cur, Max, Pref, Deep, Options, !IO) :-
|
|
( if Cur =< Max then
|
|
try_exec(deep_cmd_static_procrep_coverage(proc_static_ptr(Cur)), Pref,
|
|
Deep, HTML),
|
|
write_test_html(Options, "procrep_dynamic_coverage", Cur, HTML, !IO),
|
|
test_procrep_static_coverages(Cur + 1, Max, Pref, Deep, Options, !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred test_procrep_dynamic_coverages(int::in, int::in, preferences::in,
|
|
deep::in, option_table::in, io::di, io::uo) is cc_multi.
|
|
|
|
test_procrep_dynamic_coverages(Cur, Max, Pref, Deep, Options, !IO) :-
|
|
( if Cur =< Max then
|
|
try_exec(deep_cmd_dynamic_procrep_coverage(proc_dynamic_ptr(Cur)),
|
|
Pref, Deep, HTML),
|
|
write_test_html(Options, "procrep_static_coverage", Cur, HTML, !IO),
|
|
test_procrep_dynamic_coverages(Cur + 1, Max, Pref, Deep, Options, !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred test_recursion_types_histogram(preferences::in, deep::in,
|
|
option_table::in, io::di, io::uo) is det.
|
|
|
|
test_recursion_types_histogram(Pref, Deep, Options, !IO) :-
|
|
promise_equivalent_solutions [!:IO] (
|
|
try_exec(deep_cmd_recursion_types_frequency, Pref, Deep, HTML),
|
|
write_test_html(Options, "recursion_types_histogram", 1, HTML, !IO)
|
|
).
|
|
|
|
:- func progrep_error = maybe_error(prog_rep).
|
|
|
|
progrep_error =
|
|
error("No Program Representation available when using mdprof_test").
|
|
|
|
:- pred write_test_html(option_table::in, string::in, int::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_test_html(Options, BaseName, Num, HTML, !IO) :-
|
|
% For large programs such as the Mercury compiler, the profiler data
|
|
% file may contain hundreds of thousands of cliques. We therefore put
|
|
% each batch of pages in a different subdirectory, thus limiting the
|
|
% number of files/subdirs in each directory.
|
|
%
|
|
% XXX consider splitting up this predicate
|
|
Bunch = (Num - 1) // 1000,
|
|
lookup_string_option(Options, test_dir, DirName),
|
|
string.format("%s/%s_%04d",
|
|
[s(DirName), s(BaseName), i(Bunch)], BunchName),
|
|
( if (Num - 1) rem 1000 = 0 then
|
|
string.format("test -d %s || mkdir -p %s",
|
|
[s(BunchName), s(BunchName)], Cmd),
|
|
io.call_system.call_system(Cmd, _, !IO)
|
|
else
|
|
true
|
|
),
|
|
string.format("%s/%s_%06d.html",
|
|
[s(BunchName), s(BaseName), i(Num)], FileName),
|
|
io.open_output(FileName, Res, !IO),
|
|
(
|
|
Res = ok(Stream),
|
|
io.write_string(Stream, HTML, !IO),
|
|
io.close_output(Stream, !IO),
|
|
lookup_bool_option(Options, compress, Compress),
|
|
(
|
|
Compress = yes,
|
|
string.format("gzip %s", [s(FileName)], GzipCmd),
|
|
io.call_system.call_system(GzipCmd, _, !IO)
|
|
;
|
|
Compress = no
|
|
)
|
|
;
|
|
Res = error(Err),
|
|
io.error_message(Err, ErrMsg),
|
|
error(ErrMsg)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type option
|
|
---> canonical_clique
|
|
; dump
|
|
; dump_options
|
|
; compress
|
|
; help
|
|
; test
|
|
; test_dir
|
|
; verbose
|
|
; version
|
|
; verify_profile
|
|
; static_procrep_coverage
|
|
; dynamic_procrep_coverage
|
|
; recursion_types_histogram.
|
|
|
|
:- type options ---> options.
|
|
:- type option_table == (option_table(option)).
|
|
|
|
:- pred short(char::in, option::out) is semidet.
|
|
|
|
short('c', canonical_clique).
|
|
short('d', dump).
|
|
short('D', dump_options).
|
|
short('T', test).
|
|
short('v', verbose).
|
|
|
|
:- pred long(string::in, option::out) is semidet.
|
|
|
|
long("canonical-clique", canonical_clique).
|
|
long("compress", compress).
|
|
long("dump", dump).
|
|
long("dump-options", dump_options).
|
|
long("help", help).
|
|
long("test", test).
|
|
long("test-dir", test_dir).
|
|
long("verbose", verbose).
|
|
long("version", version).
|
|
long("verify-profile", verify_profile).
|
|
long("static-procrep-coverage", static_procrep_coverage).
|
|
long("dynamic-procrep-coverage", dynamic_procrep_coverage).
|
|
long("recursion-types-histogram", recursion_types_histogram).
|
|
|
|
:- pred defaults(option::out, option_data::out) is multi.
|
|
|
|
defaults(canonical_clique, bool(no)).
|
|
defaults(compress, bool(yes)).
|
|
defaults(dump, accumulating([])).
|
|
defaults(dump_options, accumulating([])).
|
|
defaults(help, bool(no)).
|
|
defaults(test, bool(no)).
|
|
defaults(test_dir, string("deep_test")).
|
|
defaults(verbose, bool(no)).
|
|
defaults(version, bool(no)).
|
|
defaults(verify_profile, bool(no)).
|
|
defaults(static_procrep_coverage, bool(no)).
|
|
defaults(dynamic_procrep_coverage, bool(no)).
|
|
defaults(recursion_types_histogram, bool(no)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module mdprof_test.
|
|
%---------------------------------------------------------------------------%
|