[m-rev.] diff: improve formatting of some error messages

Julien Fischer juliensf at cs.mu.OZ.AU
Mon Feb 27 16:52:04 AEDT 2006


Estimated hours taken: 2
Branches: main

Improve the formatting of some error messages by using error_util
and hlds_error_util to handle the formatting of the error messages.

compiler/error_util.m:
	Add a new format component `quote', which is identical to `fixed'
	except that it outputs it's argument surrounded by `' quotes.

compiler/add_clause.m:
compiler/add_type.m:
compiler/make_hlds_passes.m:
compiler/options_file.m:
compiler/qual_info.m:
compiler/stratify.m:
	Use the error_util to format warning/error messages rather than
	doing it manually.

compiler/passes_aux.m:
complier/hlds_out.m:
	Update comments.

tests/invalid/errors.err_exp:
tests/invalid/errors1.err_exp:
tests/invalid/multimode_dcg.err_exp:
tests/invalid/multimode_syntax.err_exp:
tests/invalid/sub_c.err_exp:
tests/invalid/types.err_exp:
	Update the expected outputs of these test cases to account
	for formatting changes introduced by the above.

tests/warnings/Mmakefile:
tests/warnings/Mercury.options:
tests/warnings/non_stratification.{exp,m}:
	Add a test case for the `--warn-non-stratification' option.

Julien.

Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.15
diff -u -r1.15 add_clause.m
--- compiler/add_clause.m	24 Feb 2006 05:49:23 -0000	1.15
+++ compiler/add_clause.m	27 Feb 2006 04:46:15 -0000
@@ -21,6 +21,8 @@
 :- import_module io.
 :- import_module list.

+%-----------------------------------------------------------------------------%
+
 :- pred module_add_clause(prog_varset::in, pred_or_func::in, sym_name::in,
     list(prog_term)::in, goal::in, import_status::in, prog_context::in,
     goal_type::in, module_info::in, module_info::out,
@@ -49,6 +51,9 @@
 :- pred qualify_lambda_mode_list(list(mer_mode)::in, list(mer_mode)::out,
     prog_context::in, qual_info::in, qual_info::out, io::di, io::uo) is det.

+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 :- implementation.

 :- import_module check_hlds.clause_to_proc.
@@ -81,6 +86,8 @@
 :- import_module term_io.
 :- import_module varset.

+%-----------------------------------------------------------------------------%
+
 module_add_clause(ClauseVarSet, PredOrFunc, PredName, Args0, Body, Status,
         Context, GoalType, !ModuleInfo, !QualInfo, !IO) :-
     ( illegal_state_var_func_result(PredOrFunc, Args0, SVar) ->
@@ -214,8 +221,8 @@
             % easier when redefining builtins to use normal Mercury code.
             pred_info_is_builtin(!.PredInfo)
         ->
-            prog_out__write_context(Context, !IO),
-            report_warning("Warning: clause for builtin.\n", !IO)
+            report_warning(Context, 0,
+                [words("Warning: clause for builtin.")], !IO)
         ;
             pred_info_clauses_info(!.PredInfo, Clauses0),
             pred_info_typevarset(!.PredInfo, TVarSet0),
@@ -339,14 +346,14 @@
     ;
         ModeAnnotations = mixed,
         module_info_incr_errors(!ModuleInfo),
-        io__set_exit_status(1, !IO),
-        prog_out__write_context(Context, !IO),
-        io__write_string("In clause for ", !IO),
-        hlds_out__write_pred_id(!.ModuleInfo, PredId, !IO),
-        io__write_string(":\n", !IO),
-        prog_out__write_context(Context, !IO),
-        io__write_string("  syntax error: some but not all " ++
-            "arguments have mode annotations.\n", !IO),
+        io.set_exit_status(1, !IO),
+        PredIdStr = pred_id_to_string(!.ModuleInfo, PredId),
+        ModeAnnotationErrMsg = [
+            words("In clause for"), fixed(PredIdStr), suffix(":"), nl,
+            words("syntax error: some but not all arguments"),
+            words("have mode annotations.")
+        ],
+        write_error_pieces(Context, 0, ModeAnnotationErrMsg, !IO),
         % apply the clause to all modes
         % XXX would it be better to apply it to none?
         ProcIds = pred_info_all_procids(PredInfo)
Index: compiler/add_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_type.m,v
retrieving revision 1.10
diff -u -r1.10 add_type.m
--- compiler/add_type.m	28 Nov 2005 04:11:37 -0000	1.10
+++ compiler/add_type.m	27 Feb 2006 01:47:27 -0000
@@ -675,12 +675,16 @@
         OtherConsDefn = hlds_cons_defn(_, _, _, TypeCtor, _)
     ->
         % XXX we should record each error using module_info_incr_errors
-        prog_out__write_context(Context, !IO),
-        io__write_string("Error: constructor `", !IO),
-        hlds_out__write_cons_id(QualifiedConsId, !IO),
-        io__write_string("' for type `", !IO),
-        hlds_out__write_type_ctor(TypeCtor, !IO),
-        io__write_string("' multiply defined.\n", !IO),
+        QualifiedConsIdStr = cons_id_to_string(QualifiedConsId),
+        TypeCtorStr = type_ctor_to_string(TypeCtor),
+        ErrMsg = [
+            words("Error: constructor"),
+            quote(QualifiedConsIdStr),
+            words("for type"),
+            quote(TypeCtorStr),
+            words("multiply defined.")
+        ],
+        write_error_pieces(Context, 0, ErrMsg, !IO),
         io__set_exit_status(1, !IO),
         QualifiedConsDefns = QualifiedConsDefns1
     ;
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.45
diff -u -r1.45 error_util.m
--- compiler/error_util.m	17 Nov 2005 15:57:09 -0000	1.45
+++ compiler/error_util.m	27 Feb 2006 01:15:00 -0000
@@ -59,7 +59,7 @@
                             % in one piece, as it is, appended directly
                             % after the previous format_component, without
                             % any intervening space.
-
+
     ;       words(string)   % This string contains words separated by
                             % white space. The words should appear in
                             % the output in the given order, but the
@@ -85,10 +85,13 @@
     ;       nl              % Insert a line break if there has been text
                             % output since the last line break.

-    ;       nl_indent_delta(int).
+    ;       nl_indent_delta(int)
                             % Act as nl, but also add the given integer
                             % (which should be a small positive or negative
-                            % integer) to the current indent level.
+                            % integer) to the current indent level
+
+    ;       quote(string). % Act as fixed, but surround the string by `'
+                           % quotes.

 :- type format_components == list(format_component).

@@ -475,6 +478,9 @@
         Component = nl_indent_delta(_),
         % There is nothing we can do about the indent delta.
         Str = "\n" ++ TailStr
+    ;
+        Component = quote(Word),
+        Str = join_string_and_tail(add_quotes(Word), Components, TailStr)
     ).

 :- func join_string_and_tail(string, list(format_component), string) = string.
@@ -554,6 +560,9 @@
         Strings = rev_words_to_strings(RevWords0),
         list.cons(paragraph(Strings, IndentDelta), !Paras),
         RevWords1 = []
+    ;
+        Component = quote(Word),
+        RevWords1 = [word(add_quotes(Word)) | RevWords0]
     ),
     convert_components_to_paragraphs_acc(Components, RevWords1, !Paras).

Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.382
diff -u -r1.382 hlds_out.m
--- compiler/hlds_out.m	24 Feb 2006 05:49:31 -0000	1.382
+++ compiler/hlds_out.m	27 Feb 2006 01:43:41 -0000
@@ -56,8 +56,8 @@
 :- func cons_id_to_string(cons_id) = string.

     % write_pred_id/4 writes out a message such as
-    %       predicate `foo:bar/3'
-    % or    function `foo:myfoo/5'
+    %       predicate `foo.bar/3'
+    % or    function `foo.myfoo/5'
     % except in some special cases where the predicate name is mangled
     % and we can print a more meaningful identification of the predicate
     % in question.
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.29
diff -u -r1.29 make_hlds_passes.m
--- compiler/make_hlds_passes.m	24 Feb 2006 07:11:11 -0000	1.29
+++ compiler/make_hlds_passes.m	27 Feb 2006 02:10:25 -0000
@@ -412,9 +412,11 @@
                 true
             )
         ;
-            prog_out__write_context(Context, !IO),
-            report_warning("Warning: `external' declaration requires arity.\n",
-                !IO)
+            ExternalArityWarnMsg = [
+                words("Warning:"), quote("external"),
+                words("declaration requires arity.")
+            ],
+            report_warning(Context, 0, ExternalArityWarnMsg, !IO)
         )
     ; ModuleDefn = module(_ModuleName) ->
         report_unexpected_decl("module", Context, !IO)
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.377
diff -u -r1.377 modules.m
--- compiler/modules.m	24 Feb 2006 07:11:12 -0000	1.377
+++ compiler/modules.m	27 Feb 2006 04:26:46 -0000
@@ -2018,15 +2018,15 @@
     (
         Item0 = clause(_, _, _, _, _, _)
     ->
-        prog_out__write_context(Context, !IO),
-        report_warning("Warning: clause in module interface.\n", !IO),
+        ClauseWarning = [words("Warning: clause in module interface.")],
+        report_warning(Context, 0, ClauseWarning, !IO),
         check_for_clauses_in_interface(Items0, Items, !IO)
     ;
         Item0 = pragma(_, Pragma),
         pragma_allowed_in_interface(Pragma, no)
     ->
-        prog_out__write_context(Context, !IO),
-        report_warning("Warning: pragma in module interface.\n", !IO),
+        PragmaWarning = [words("Warning: pragma in module interface.")],
+        report_warning(Context, 0, PragmaWarning, !IO),
         check_for_clauses_in_interface(Items0, Items, !IO)
     ;
         Items = [ItemAndContext0 | Items1],
@@ -2806,13 +2806,14 @@
             ; list__member(ModuleName, UsedModules)
             )
         ->
-            module_name_to_file_name(ModuleName, ".m", no,
-                FileName, !IO),
+            module_name_to_file_name(ModuleName, ".m", no, FileName, !IO),
             term__context_init(FileName, 1, Context),
-            prog_out__write_context(Context, !IO),
-            report_warning("Warning: module `", !IO),
-            prog_out__write_sym_name(ModuleName, !IO),
-            io__write_string("' imports itself!\n", !IO)
+            SelfImportWarning = [
+                words("Warning: module"),
+                sym_name(ModuleName),
+                words("imports itself!")
+            ],
+            report_warning(Context, 0, SelfImportWarning, !IO)
         ;
             true
         ),
@@ -6543,41 +6544,31 @@
         unexpected(this_file,
             "report_inaccessible_parent_error: invalid item")
     ),
-    prog_out__write_context(Context, !IO),
-    io__write_string("In module `", !IO),
-    prog_out__write_sym_name(ModuleName, !IO),
-    io__write_string("':\n", !IO),
-    prog_out__write_context(Context, !IO),
-    io__write_strings(["  error in `", DeclName, "' declaration:\n"], !IO),
-    prog_out__write_context(Context, !IO),
-    io__write_string("  module `", !IO),
-    prog_out__write_sym_name(qualified(ParentModule, SubModule), !IO),
-    io__write_string("' is inaccessible.\n", !IO),
+    ErrMsg0 = [
+        words("In module"), sym_name(ModuleName), suffix(":"), nl,
+        words("error in"), quote(DeclName), words("declaration:"), nl,
+        words("module"), sym_name(qualified(ParentModule, SubModule)),
+        words("is inaccessible."), nl
+    ],
     globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
     (
+
         VerboseErrors = yes,
-        prog_out__write_context(Context, !IO),
-        io__write_string("  Either there was no prior ", !IO),
-        io__write_string("`import_module' or\n", !IO),
-        prog_out__write_context(Context, !IO),
-        io__write_string("  `use_module' declaration to import ", !IO),
-        io__write_string("module\n", !IO),
-        prog_out__write_context(Context, !IO),
-        io__write_string("  `", !IO),
-        prog_out__write_sym_name(ParentModule, !IO),
-        io__write_string("', or the interface for module\n", !IO),
-        prog_out__write_context(Context, !IO),
-        io__write_string("  `", !IO),
-        prog_out__write_sym_name(ParentModule, !IO),
-        io__write_string("' does not contain an `include_module'\n", !IO),
-        prog_out__write_context(Context, !IO),
-        io__write_string("  declaration for module `", !IO),
-        io__write_string(SubModule, !IO),
-        io__write_string("'.\n", !IO)
+        ErrMsg = ErrMsg0 ++ [
+            words("Either there was no prior"), quote("import_module"),
+            words("or"), quote("use_module"),
+            words("declaration to import module"), sym_name(ParentModule),
+            suffix(","), words("or the interface for module"),
+            sym_name(ParentModule), words("does not contain an"),
+            quote("include_module"), words("declaration for module"),
+            quote(SubModule), suffix(".")
+        ]
     ;
         VerboseErrors = no,
+        ErrMsg = ErrMsg0,
         globals.io_set_extra_error_info(yes, !IO)
     ),
+    write_error_pieces(Context, 0, ErrMsg, !IO),
     io__set_exit_status(1, !IO).

 %-----------------------------------------------------------------------------%
Index: compiler/options_file.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options_file.m,v
retrieving revision 1.33
diff -u -r1.33 options_file.m
--- compiler/options_file.m	6 Jan 2006 04:06:51 -0000	1.33
+++ compiler/options_file.m	27 Feb 2006 02:07:16 -0000
@@ -323,15 +323,13 @@
         LineResult = exception(Exception),
         ( Exception = univ(options_file_error(Error)) ->
             io__input_stream_name(FileName, !IO),
-            prog_out__write_context(term__context_init(FileName, LineNumber),
-                !IO),
-            io__write_string(Error, !IO),
-            io__nl(!IO),
-
-            % This will be caught by `read_options_files'.
-            % The open options files aren't closed on
-            % the way up, but we'll be exiting straight
+            write_error_pieces(term.context_init(FileName, LineNumber),
+                0, [words(Error)], !IO),
+            %
+            % This will be caught by `read_options_files'.  The open options
+            % files aren't closed on the way up, but we'll be exiting straight
             % away so that doesn't matter.
+            %
             throw(found_options_file_error)
         ;
             rethrow(LineResult)
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.78
diff -u -r1.78 passes_aux.m
--- compiler/passes_aux.m	23 Feb 2006 09:37:00 -0000	1.78
+++ compiler/passes_aux.m	27 Feb 2006 01:52:24 -0000
@@ -126,7 +126,7 @@

     % Prints the id of the given procedure via report_pred_name_mode,
     % preceded by "In: " and the context.
-    % In new code, use describe_one_pred_name_mode in error_util instead.
+    % In new code, use describe_one_pred_name_mode in hlds_error_util instead.
     %
 :- pred report_pred_proc_id(module_info::in, pred_id::in, proc_id::in,
     maybe(prog_context)::in, prog_context::out, io::di, io::uo) is det.
@@ -136,7 +136,7 @@
     %   Name(ArgMode1, ..., ArgModeN)
     % or
     %   Name(ArgMode1, ..., ArgModeN-1) = ArgModeN
-    % In new code, use describe_one_pred_name_mode in error_util instead.
+    % In new code, use describe_one_pred_name_mode in hlds_error_util instead.
     %
 :- pred report_pred_name_mode(pred_or_func::in, string::in, list(mer_mode)::in,
     io::di, io::uo) is det.
Index: compiler/qual_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/qual_info.m,v
retrieving revision 1.9
diff -u -r1.9 qual_info.m
--- compiler/qual_info.m	23 Feb 2006 09:37:03 -0000	1.9
+++ compiler/qual_info.m	24 Feb 2006 14:23:15 -0000
@@ -93,6 +93,7 @@
 :- implementation.

 :- import_module hlds.hlds_data.
+:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_out.
 :- import_module parse_tree.prog_type.
 :- import_module parse_tree.prog_type_subst.
@@ -100,6 +101,7 @@

 :- import_module map.
 :- import_module std_util.
+:- import_module svmap.
 :- import_module term.
 :- import_module varset.

@@ -221,18 +223,19 @@
     vartypes::in, vartypes::out, io::di, io::uo) is det.

 update_var_types(Var, Type, Context, !VarTypes, !IO) :-
-    ( map__search(!.VarTypes, Var, Type0) ->
+    ( map.search(!.VarTypes, Var, Type0) ->
         ( Type = Type0 ->
             true
         ;
-            prog_out__write_context(Context, !IO),
-            io__write_string("Error: explicit type qualification does\n", !IO),
-            prog_out__write_context(Context, !IO),
-            io__write_string("  not match prior qualification.\n", !IO),
+            ErrMsg = [
+                words("Error: explicit type qualification does"),
+                words("not match prior qualification.")
+            ],
+            write_error_pieces(Context, 0, ErrMsg, !IO),
             io__set_exit_status(1, !IO)
         )
     ;
-        map__det_insert(!.VarTypes, Var, Type, !:VarTypes)
+        svmap.det_insert(Var, Type, !VarTypes)
     ).

 %-----------------------------------------------------------------------------%
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.46
diff -u -r1.46 stratify.m
--- compiler/stratify.m	24 Feb 2006 05:49:39 -0000	1.46
+++ compiler/stratify.m	27 Feb 2006 05:14:55 -0000
@@ -40,7 +40,7 @@
     % the entire module for stratification, otherwise it will only check
     % the predicates in the stratified_preds set of the module_info structure.
     %
-:- pred stratify__check_stratification(module_info::in, module_info::out,
+:- pred check_stratification(module_info::in, module_info::out,
     io::di, io::uo) is det.

 %-----------------------------------------------------------------------------%
@@ -51,6 +51,7 @@
 :- import_module check_hlds.mode_util.
 :- import_module check_hlds.type_util.
 :- import_module hlds.hlds_data.
+:- import_module hlds.hlds_error_util.
 :- import_module hlds.hlds_goal.
 :- import_module hlds.hlds_module.
 :- import_module hlds.hlds_pred.
@@ -59,6 +60,7 @@
 :- import_module libs.globals.
 :- import_module libs.options.
 :- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_data.
 :- import_module parse_tree.prog_out.
 :- import_module parse_tree.prog_type.
@@ -201,7 +203,7 @@
     ->
         goal_info_get_context(GoalInfo, Context),
         emit_message(ThisPredProcId, Context,
-            "call introduces a non-stratified loop", Error, !ModuleInfo, !IO)
+            "call introduces a non-stratified loop.", Error, !ModuleInfo, !IO)
     ;
         true
     ).
@@ -216,7 +218,7 @@
     ->
         goal_info_get_context(GInfo, Context),
         emit_message(ThisPredProcId, Context,
-            "call introduces a non-stratified loop", Error, !ModuleInfo, !IO)
+            "call introduces a non-stratified loop.", Error, !ModuleInfo, !IO)
     ;
         true
     ).
@@ -350,7 +352,7 @@
     ->
         goal_info_get_context(GoalInfo, Context),
         emit_message(ThisPredProcId, Context,
-            "call to solutions/2 introduces a non-stratified loop",
+            "call to solutions/2 introduces a non-stratified loop.",
             Error, !ModuleInfo, !IO)
     ;
         true
@@ -367,7 +369,7 @@
         )
     ->
         goal_info_get_context(GoalInfo, Context),
-        ErrorMsg = Msg ++ " call may introduce a non-stratified loop",
+        ErrorMsg = Msg ++ " call may introduce a non-stratified loop.",
         emit_message(ThisPredProcId, Context, ErrorMsg, Error, !ModuleInfo,
             !IO)
     ;
@@ -851,35 +853,36 @@
 :- pred emit_message(pred_proc_id::in, prog_context::in, string::in, bool::in,
     module_info::in, module_info::out, io::di, io::uo) is det.

-emit_message(ThisPredProc, Context, Message, Error, !ModuleInfo, !IO) :-
-    ThisPredProc = proc(TPred, TProc),
-    report_pred_proc_id(!.ModuleInfo, TPred, TProc, yes(Context), _Context,
-        !IO),
-    prog_out__write_context(Context, !IO),
+emit_message(PPId, Context, Message, Error, !ModuleInfo, !IO) :-
+    PPIdDescription = describe_one_proc_name_mode(!.ModuleInfo,
+        should_not_module_qualify, PPId),
+    ErrMsgStart = [words("In")] ++ PPIdDescription ++ [suffix(":"), nl],
     (
         Error = no,
-        io__write_string("  warning: ", !IO)
+        ErrOrWarnMsg = words("warning:")
     ;
         Error = yes,
         module_info_incr_errors(!ModuleInfo),
-        io__set_exit_status(1, !IO),
-        io__write_string("  error: ", !IO)
+        io.set_exit_status(1, !IO),
+        ErrOrWarnMsg = words("error:")
     ),
-    io__write_string(Message, !IO),
-    io__write_char('\n', !IO),
+    ErrMsgMiddle = [ ErrOrWarnMsg, words(Message) ],
     globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
     (
         VerboseErrors = yes,
-        io__write_string("\tA non-stratified loop is a " ++
-            "loop in the call graph of the given\n", !IO),
-        io__write_string("\tpredicate/function that allows it " ++
-            "to call itself negatively. This\n", !IO),
-        io__write_string("\tcan cause problems for bottom up " ++
-            "evaluation of the predicate/function.\n", !IO)
+        ErrMsgFinal = [ nl,
+            words("A non-stratified loop is a loop in the call graph"),
+            words("of the given predicate/function that allows it to call"),
+            words("itself negatively.  This can cause problems for bottom"),
+            words("up evaluation of the predicate/function.")
+        ]
     ;
         VerboseErrors = no,
+        ErrMsgFinal = [],
         globals.io_set_extra_error_info(yes, !IO)
-    ).
+    ),
+    ErrMsg = ErrMsgStart ++ ErrMsgMiddle ++ ErrMsgFinal,
+    write_error_pieces(Context, 0, ErrMsg, !IO).

 %-----------------------------------------------------------------------------%

Index: tests/invalid/errors.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/errors.err_exp,v
retrieving revision 1.13
diff -u -r1.13 errors.err_exp
--- tests/invalid/errors.err_exp	14 Sep 2005 05:26:44 -0000	1.13
+++ tests/invalid/errors.err_exp	27 Feb 2006 04:24:56 -0000
@@ -23,8 +23,10 @@
 errors.m:032: Error: mode declaration for predicate
 errors.m:032:   `errors.missing_pred_declaration/0'
 errors.m:032:   without preceding `pred' declaration.
-errors.m:049: Error: constructor `errors.a/0' for type `errors.type_with_multiply_defined_ctors/0' multiply defined.
-errors.m:049: Error: constructor `errors.f/1' for type `errors.type_with_multiply_defined_ctors/0' multiply defined.
+errors.m:049: Error: constructor `errors.a/0' for type
+errors.m:049:   `errors.type_with_multiply_defined_ctors/0' multiply defined.
+errors.m:049: Error: constructor `errors.f/1' for type
+errors.m:049:   `errors.type_with_multiply_defined_ctors/0' multiply defined.
 errors.m:038: Error: clause for predicate
 errors.m:038:   `errors.clause_without_pred_or_mode_declaration/0'
 errors.m:038:   without preceding `pred' declaration.
Index: tests/invalid/errors1.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/errors1.err_exp,v
retrieving revision 1.10
diff -u -r1.10 errors1.err_exp
--- tests/invalid/errors1.err_exp	14 Sep 2005 05:26:44 -0000	1.10
+++ tests/invalid/errors1.err_exp	27 Feb 2006 04:27:32 -0000
@@ -17,8 +17,10 @@
 errors1.m:032: Error: mode declaration for predicate
 errors1.m:032:   `errors1.missing_pred_declaration/0'
 errors1.m:032:   without preceding `pred' declaration.
-errors1.m:049: Error: constructor `errors1.a/0' for type `errors1.type_with_multiply_defined_ctors/0' multiply defined.
-errors1.m:049: Error: constructor `errors1.f/1' for type `errors1.type_with_multiply_defined_ctors/0' multiply defined.
+errors1.m:049: Error: constructor `errors1.a/0' for type
+errors1.m:049:   `errors1.type_with_multiply_defined_ctors/0' multiply defined.
+errors1.m:049: Error: constructor `errors1.f/1' for type
+errors1.m:049:   `errors1.type_with_multiply_defined_ctors/0' multiply defined.
 errors1.m:038: Error: clause for predicate
 errors1.m:038:   `errors1.clause_without_pred_or_mode_declaration/0'
 errors1.m:038:   without preceding `pred' declaration.
Index: tests/invalid/multimode_dcg.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/multimode_dcg.err_exp,v
retrieving revision 1.3
diff -u -r1.3 multimode_dcg.err_exp
--- tests/invalid/multimode_dcg.err_exp	14 Sep 2005 05:26:48 -0000	1.3
+++ tests/invalid/multimode_dcg.err_exp	27 Feb 2006 04:48:24 -0000
@@ -1,15 +1,21 @@
 multimode_dcg.m:027: In clause for predicate `multimode_dcg.test1/3':
-multimode_dcg.m:027:   syntax error: some but not all arguments have mode annotations.
+multimode_dcg.m:027:   syntax error: some but not all arguments have mode
+multimode_dcg.m:027:   annotations.
 multimode_dcg.m:029: In clause for predicate `multimode_dcg.test1/3':
-multimode_dcg.m:029:   syntax error: some but not all arguments have mode annotations.
+multimode_dcg.m:029:   syntax error: some but not all arguments have mode
+multimode_dcg.m:029:   annotations.
 multimode_dcg.m:037: In clause for predicate `multimode_dcg.test2/4':
-multimode_dcg.m:037:   syntax error: some but not all arguments have mode annotations.
+multimode_dcg.m:037:   syntax error: some but not all arguments have mode
+multimode_dcg.m:037:   annotations.
 multimode_dcg.m:039: In clause for predicate `multimode_dcg.test2/4':
-multimode_dcg.m:039:   syntax error: some but not all arguments have mode annotations.
+multimode_dcg.m:039:   syntax error: some but not all arguments have mode
+multimode_dcg.m:039:   annotations.
 multimode_dcg.m:041: In clause for predicate `multimode_dcg.test2/4':
-multimode_dcg.m:041:   syntax error: some but not all arguments have mode annotations.
+multimode_dcg.m:041:   syntax error: some but not all arguments have mode
+multimode_dcg.m:041:   annotations.
 multimode_dcg.m:043: In clause for predicate `multimode_dcg.test2/4':
-multimode_dcg.m:043:   syntax error: some but not all arguments have mode annotations.
+multimode_dcg.m:043:   syntax error: some but not all arguments have mode
+multimode_dcg.m:043:   annotations.
 multimode_dcg.m:029: In clause for `test1(out, di, uo)':
 multimode_dcg.m:029:   mode mismatch in disjunction.
 multimode_dcg.m:029:   `HeadVar__1' :: free, unique(0).
Index: tests/invalid/multimode_syntax.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/multimode_syntax.err_exp,v
retrieving revision 1.4
diff -u -r1.4 multimode_syntax.err_exp
--- tests/invalid/multimode_syntax.err_exp	14 Sep 2005 05:26:49 -0000	1.4
+++ tests/invalid/multimode_syntax.err_exp	27 Feb 2006 04:51:25 -0000
@@ -1,9 +1,11 @@
 multimode_syntax.m:013: Error: clause for predicate `multimode_syntax.::/2'
 multimode_syntax.m:013:   without preceding `pred' declaration.
 multimode_syntax.m:018: In clause for function `multimode_syntax.func1/1':
-multimode_syntax.m:018:   syntax error: some but not all arguments have mode annotations.
+multimode_syntax.m:018:   syntax error: some but not all arguments have mode
+multimode_syntax.m:018:   annotations.
 multimode_syntax.m:019: In clause for function `multimode_syntax.func1/1':
-multimode_syntax.m:019:   syntax error: some but not all arguments have mode annotations.
+multimode_syntax.m:019:   syntax error: some but not all arguments have mode
+multimode_syntax.m:019:   annotations.
 multimode_syntax.m:025: In clause for function `multimode_syntax.func2/2':
 multimode_syntax.m:025:   error: mode annotation specifies undeclared mode
 multimode_syntax.m:025:   `func2(in, out) = out'
@@ -26,9 +28,11 @@
 multimode_syntax.m:037:   of predicate `multimode_syntax.pred2b/2'.
 multimode_syntax.m:037:   (There are no declared modes for this predicate.)
 multimode_syntax.m:045: In clause for predicate `multimode_syntax.test2/2':
-multimode_syntax.m:045:   syntax error: some but not all arguments have mode annotations.
+multimode_syntax.m:045:   syntax error: some but not all arguments have mode
+multimode_syntax.m:045:   annotations.
 multimode_syntax.m:047: In clause for predicate `multimode_syntax.test2/2':
-multimode_syntax.m:047:   syntax error: some but not all arguments have mode annotations.
+multimode_syntax.m:047:   syntax error: some but not all arguments have mode
+multimode_syntax.m:047:   annotations.
 multimode_syntax.m:011: Error: no clauses for function `func0/0'.
 multimode_syntax.m:013: In clause for predicate `multimode_syntax.::/2':
 multimode_syntax.m:013:   in argument 1 of clause head:
Index: tests/invalid/sub_c.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/sub_c.err_exp,v
retrieving revision 1.4
diff -u -r1.4 sub_c.err_exp
--- tests/invalid/sub_c.err_exp	17 Jan 2003 05:57:09 -0000	1.4
+++ tests/invalid/sub_c.err_exp	27 Feb 2006 04:44:18 -0000
@@ -1,8 +1,7 @@
 sub_c.m:012: In module `sub_c':
 sub_c.m:012:   error in `import_module' declaration:
 sub_c.m:012:   module `sub_a.sub1' is inaccessible.
-sub_c.m:012:   Either there was no prior `import_module' or
-sub_c.m:012:   `use_module' declaration to import module
-sub_c.m:012:   `sub_a', or the interface for module
-sub_c.m:012:   `sub_a' does not contain an `include_module'
-sub_c.m:012:   declaration for module `sub1'.
+sub_c.m:012:   Either there was no prior `import_module' or `use_module'
+sub_c.m:012:   declaration to import module `sub_a', or the interface for
+sub_c.m:012:   module `sub_a' does not contain an `include_module' declaration
+sub_c.m:012:   for module `sub1'.
Index: tests/invalid/types.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/types.err_exp,v
retrieving revision 1.12
diff -u -r1.12 types.err_exp
--- tests/invalid/types.err_exp	14 Sep 2005 05:26:54 -0000	1.12
+++ tests/invalid/types.err_exp	27 Feb 2006 05:02:41 -0000
@@ -1,11 +1,13 @@
 types.m:001: Warning: interface for module `types' does not export anything.
-types.m:003: Error: constructor `types.a/0' for type `types.t/0' multiply defined.
-types.m:003: Error: constructor `types.f/1' for type `types.t/0' multiply defined.
+types.m:003: Error: constructor `types.a/0' for type `types.t/0' multiply
+types.m:003:   defined.
+types.m:003: Error: constructor `types.f/1' for type `types.t/0' multiply
+types.m:003:   defined.
 types.m:017: Error: clause for predicate `types.r/0'
 types.m:017:   without preceding `pred' declaration.
 types.m:020: Error: clause for predicate `types.a/1'
 types.m:020:   without preceding `pred' declaration.
-types.m:005: Error: no clauses for predicate `types.p/1'.
+types.m:005: Error: no clauses for predicate `p/1'.
 types.m:012: In clause for predicate `types.q/0':
 types.m:012:   error: undefined predicate `zzzzzzzz/0'.
 types.m:013: In clause for predicate `types.q/0':
@@ -20,7 +22,7 @@
 types.m:039:   and constant `0'.
 types.m:039:   variable `X' has type `(some [BarTypeParam] BarTypeParam)',
 types.m:039:   constant `0' has type `int'.
-types.m:050: Error: no clauses for predicate `types.bar2/1'.
+types.m:050: Error: no clauses for predicate `bar2/1'.
 types.m:018: In clause for predicate `types.r/0':
 types.m:018:   error: undefined predicate `s/0'.
 types.m:020: In clause for predicate `types.a/1':
Index: tests/warnings/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/Mercury.options,v
retrieving revision 1.11
diff -u -r1.11 Mercury.options
--- tests/warnings/Mercury.options	22 Jan 2005 06:12:56 -0000	1.11
+++ tests/warnings/Mercury.options	27 Feb 2006 05:39:13 -0000
@@ -43,3 +43,5 @@
 MCFLAGS-non_term_user_special = --enable-termination

 MCFLAGS-warn_dead_procs 	= --warn-dead-procs --infer-all
+
+MCFLAGS-non_stratification = --warn-non-stratification --verbose-error-messages
Index: tests/warnings/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/Mmakefile,v
retrieving revision 1.41
diff -u -r1.41 Mmakefile
--- tests/warnings/Mmakefile	10 Feb 2006 05:02:38 -0000	1.41
+++ tests/warnings/Mmakefile	27 Feb 2006 05:35:31 -0000
@@ -22,6 +22,7 @@
 	infinite_recursion \
 	inf_recursion_lambda \
 	missing_if \
+	non_stratification \
 	pragma_source_file \
 	purity_warnings \
 	simple_code \
Index: tests/warnings/non_stratification.exp
===================================================================
RCS file: tests/warnings/non_stratification.exp
diff -N tests/warnings/non_stratification.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/warnings/non_stratification.exp	27 Feb 2006 05:34:41 -0000
@@ -0,0 +1,6 @@
+non_stratification.m:012: In `foo(in)':
+non_stratification.m:012:   warning: call introduces a non-stratified loop.
+non_stratification.m:012:   A non-stratified loop is a loop in the call graph
+non_stratification.m:012:   of the given predicate/function that allows it to
+non_stratification.m:012:   call itself negatively. This can cause problems for
+non_stratification.m:012:   bottom up evaluation of the predicate/function.
Index: tests/warnings/non_stratification.m
===================================================================
RCS file: tests/warnings/non_stratification.m
diff -N tests/warnings/non_stratification.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/warnings/non_stratification.m	27 Feb 2006 05:06:41 -0000
@@ -0,0 +1,12 @@
+:- module non_stratification.
+:- interface.
+
+:- pred foo(int::in) is semidet.
+
+:- implementation.
+:- import_module int.
+
+foo(1).
+foo(2).
+foo(3).
+foo(X) :- not foo(X - 1).

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list