[m-rev.] for review: --warn-suspicious-foreign-procs
Julien Fischer
juliensf at csse.unimelb.edu.au
Sat Sep 5 02:37:16 AEST 2009
Add a new warning, --warn-suspicious-foreign-procs.
This checks the bodies of foreign_proc pragmas for possible errors.
Currently, these errors are:
(1) the presence of SUCCESS_INDICATOR (or in Java, succeeded),
in foreign procs. for predicates that cannot fail.
(2) the lack of SUCCESS_INDICATOR (succeeded) in foreign procs.
for predicates that can fail.
(3) the presence of "return" (or "ret" or "jmp" in IL). This could
indicate the presence of a return statement in the foreign proc.
Potentially, we could also check for the presence of the this
pointer in Java and C# foreign_procs, but that isn't implemented
at the moment.
The warning is disabled by default, since it will produce spurious
results if the things it checks for occur in foreign language
comments.
compiler/make_hlds_warn.m:
Implement the new warning.
compiler/options.m:
Add the new option.
compiler/add_pragma.m:
compiler/pred_table.m:
Unrelated change: update some module qualifiers in a comment.
doc/user_guide.texi:
Document the new warning.
tests/warnings/Mercury.options:
tests/warnings/Mmakefile:
tests/warnings/warn_return.m:
tests/warnings/warn_return.exp*:
tests/warnings/warn_succ_id.m:
tests/warnings/warn_succ_id.exp*:
Test the output of the new warning.
Julien.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.97
diff -u -r1.97 add_pragma.m
--- compiler/add_pragma.m 4 Sep 2009 02:27:48 -0000 1.97
+++ compiler/add_pragma.m 4 Sep 2009 13:23:38 -0000
@@ -2396,7 +2396,7 @@
assoc_list.keys(ArgInfoBox, ArgInfo),
warn_singletons_in_pragma_foreign_proc(PragmaImpl,
PragmaForeignLanguage, ArgInfo, Context, SimpleCallId,
- !.ModuleInfo, !Specs)
+ PredId, ProcId, !.ModuleInfo, !Specs)
;
Pieces = [words("Error: `:- pragma foreign_proc' declaration"),
words("for undeclared mode of"),
Index: compiler/make_hlds_warn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_warn.m,v
retrieving revision 1.32
diff -u -r1.32 make_hlds_warn.m
--- compiler/make_hlds_warn.m 2 Sep 2009 00:30:16 -0000 1.32
+++ compiler/make_hlds_warn.m 4 Sep 2009 14:31:22 -0000
@@ -50,8 +50,8 @@
%
:- pred warn_singletons_in_pragma_foreign_proc(pragma_foreign_code_impl::in,
foreign_language::in, list(maybe(pair(string, mer_mode)))::in,
- prog_context::in, simple_call_id::in, module_info::in,
- list(error_spec)::in, list(error_spec)::out) is det.
+ prog_context::in, simple_call_id::in, pred_id::in, proc_id::in,
+ module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
% This predicate performs the following checks on promise ex declarations
% (see notes/promise_ex.html).
@@ -220,12 +220,13 @@
warn_singletons_in_unify(Var, RHS, GoalInfo, QuantVars, VarSet,
PredCallId, ModuleInfo, !Specs)
;
- GoalExpr = call_foreign_proc(Attrs, _, _, Args, _, _, PragmaImpl),
+ GoalExpr = call_foreign_proc(Attrs, PredId, ProcId, Args, _, _,
+ PragmaImpl),
Context = goal_info_get_context(GoalInfo),
Lang = get_foreign_language(Attrs),
NamesModes = list.map(foreign_arg_maybe_name_mode, Args),
warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang,
- NamesModes, Context, PredCallId, ModuleInfo, !Specs)
+ NamesModes, Context, PredCallId, PredId, ProcId, ModuleInfo, !Specs)
;
GoalExpr = shorthand(ShortHand),
(
@@ -400,7 +401,7 @@
%-----------------------------------------------------------------------------%
warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang, Args, Context,
- PredOrFuncCallId, ModuleInfo, !Specs) :-
+ PredOrFuncCallId, PredId, ProcId, ModuleInfo, !Specs) :-
LangStr = foreign_language_string(Lang),
(
PragmaImpl = fc_impl_ordinary(C_Code, _),
@@ -422,7 +423,9 @@
Spec1 = error_spec(Severity1, phase_parse_tree_to_hlds,
[Msg1]),
!:Specs = [Spec1 | !.Specs]
- )
+ ),
+ pragma_foreign_proc_body_checks(Lang, Context, PredOrFuncCallId,
+ PredId, ProcId, ModuleInfo, C_CodeList, !Specs)
;
PragmaImpl = fc_impl_model_non(_, _, FirstCode, _, LaterCode,
_, _, SharedCode, _),
@@ -529,7 +532,7 @@
( UnmentionedVars = [Var] ->
Pieces = [words("warning: variable"), quote(Var), words("does")]
;
- Pieces = [words("warning: variables)"),
+ Pieces = [words("warning: variables"),
words(add_quotes(string.join_list(", ", UnmentionedVars))),
words("do")]
).
@@ -608,9 +611,178 @@
varset.search_name(VarSet, Var, Name),
string.prefix(Name, "_").
+:- pred pragma_foreign_proc_body_checks(foreign_language::in,
+ prog_context::in, simple_call_id::in, pred_id::in, proc_id::in,
+ module_info::in, list(string)::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+pragma_foreign_proc_body_checks(Lang, Context, PredOrFuncCallId, PredId, ProcId,
+ ModuleInfo, BodyPieces, !Specs) :-
+ check_fp_body_for_success_indicator(Lang, Context, PredOrFuncCallId,
+ PredId, ProcId, ModuleInfo, BodyPieces, !Specs),
+ check_fp_body_for_return(Lang, Context, PredOrFuncCallId, BodyPieces,
+ !Specs).
+
+:- pred check_fp_body_for_success_indicator(foreign_language::in,
+ prog_context::in, simple_call_id::in, pred_id::in, proc_id::in,
+ module_info::in, list(string)::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+check_fp_body_for_success_indicator(Lang, Context, CallId, PredId, ProcId,
+ ModuleInfo, BodyPieces, !Specs) :-
+ module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
+ proc_info_get_declared_determinism(ProcInfo, MaybeDeclDetism),
+ (
+ MaybeDeclDetism = yes(Detism),
+ (
+ (
+ Lang = lang_c,
+ SuccIndStr = "SUCCESS_INDICATOR"
+ ;
+ Lang = lang_csharp,
+ SuccIndStr = "SUCCESS_INDICATOR"
+ ;
+ Lang = lang_erlang,
+ SuccIndStr = "SUCCESS_INDICATOR"
+ ;
+ Lang = lang_java,
+ SuccIndStr = "succeeded"
+ ),
+ ( if list.member(SuccIndStr, BodyPieces)
+ then
+ LangStr = foreign_language_string(Lang),
+ (
+ ( Detism = detism_det
+ ; Detism = detism_cc_multi
+ ; Detism = detism_erroneous
+ ),
+ Pieces = [
+ words("warning: the "), fixed(LangStr),
+ words("code for"), simple_call(CallId),
+ words("may set"), quote(SuccIndStr),
+ words(", but it cannot fail.")
+ ],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_suspicious_foreign_procs, yes,
+ [always(Pieces)])]),
+ Severity = severity_conditional(
+ warn_suspicious_foreign_procs, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds,
+ [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ ( Detism = detism_semi
+ ; Detism = detism_multi
+ ; Detism = detism_non
+ ; Detism = detism_cc_non
+ ; Detism = detism_failure
+ )
+ )
+ else
+ (
+ ( Detism = detism_semi
+ ; Detism = detism_cc_non
+ ),
+ LangStr = foreign_language_string(Lang),
+ Pieces = [
+ words("warning: the "), fixed(LangStr),
+ words("code for"), simple_call(CallId),
+ words("does not appear to set"),
+ quote(SuccIndStr),
+ words(", but it can fail.")
+ ],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_suspicious_foreign_procs, yes,
+ [always(Pieces)])]),
+ Severity = severity_conditional(
+ warn_suspicious_foreign_procs, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds,
+ [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ ( Detism = detism_det
+ ; Detism = detism_cc_multi
+ ; Detism = detism_failure
+ ; Detism = detism_non
+ ; Detism = detism_multi
+ ; Detism = detism_erroneous
+ )
+ )
+ )
+ ;
+ Lang = lang_il
+ )
+ ;
+ MaybeDeclDetism = no
+ ).
+
+ % Check to see if a foreign_proc body contains a return statment
+ % (or whatever the foreign language equivalent is).
+ %
+:- pred check_fp_body_for_return(foreign_language::in,
+ prog_context::in, simple_call_id::in, list(string)::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+check_fp_body_for_return(Lang, Context, Id, BodyPieces, !Specs) :-
+ (
+ ( Lang = lang_c
+ ; Lang = lang_csharp
+ ; Lang = lang_java
+ ),
+ ( if list.member("return", BodyPieces)
+ then
+ LangStr = foreign_language_string(Lang),
+ Pieces = [
+ words("warning: the "), fixed(LangStr), words("code for"),
+ simple_call(Id),
+ words("may contain a"), quote("return"),
+ words("statement.")
+ ],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_suspicious_foreign_procs, yes,
+ [always(Pieces)])]
+ ),
+ Severity = severity_conditional(
+ warn_suspicious_foreign_procs, yes, severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ else
+ true
+ )
+ ;
+ Lang = lang_il,
+ ( if ( list.member("ret", BodyPieces)
+ ; list.member("jmp", BodyPieces)
+ )
+ then
+ Pieces = [
+ words("warning: the IL code for"),
+ simple_call(Id),
+ words("may contain a"), quote("ret"),
+ words("or"), quote("jmp"),
+ words("instruction.")
+ ],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_suspicious_foreign_procs, yes,
+ [always(Pieces)])]
+ ),
+ Severity = severity_conditional(
+ warn_suspicious_foreign_procs, yes, severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ else
+ true
+ )
+ ;
+ Lang = lang_erlang
+ ).
+
%-----------------------------------------------------------------------------%
%
% Promise_ex error checking.
+%
check_promise_ex_decl(UnivVars, PromiseType, Goal, Context, !Specs) :-
% Are universally quantified variables present?
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.653
diff -u -r1.653 options.m
--- compiler/options.m 3 Sep 2009 23:57:27 -0000 1.653
+++ compiler/options.m 4 Sep 2009 10:27:00 -0000
@@ -135,6 +135,7 @@
; warn_unused_imports
; inform_ite_instead_of_switch
; warn_unresolved_polymorphism
+ ; warn_suspicious_foreign_procs
% Verbosity options
; verbose
@@ -1042,7 +1043,8 @@
% with --halt-at-warn by default.
warn_unused_imports - bool(no),
inform_ite_instead_of_switch - bool(no),
- warn_unresolved_polymorphism - bool(yes)
+ warn_unresolved_polymorphism - bool(yes),
+ warn_suspicious_foreign_procs - bool(no)
]).
option_defaults_2(verbosity_option, [
% Verbosity Options
@@ -1863,6 +1865,7 @@
long_option("warn-unused-imports", warn_unused_imports).
long_option("inform-ite-instead-of-switch", inform_ite_instead_of_switch).
long_option("warn-unresolved-polymorphism", warn_unresolved_polymorphism).
+long_option("warn-suspicious-foreign-procs", warn_suspicious_foreign_procs).
% verbosity options
long_option("verbose", verbose).
@@ -3359,7 +3362,10 @@
"\tGenerate informational messages for if-then-elses that could be",
"\treplaced by switches.",
"--no-warn-unresolved-polymorphism",
- "\tDo not warn about unresolved polymorphism."
+ "\tDo not warn about unresolved polymorphism.",
+ "--warn-suspicious-foreign-procs",
+ "\tWarn about possible errors in the bodies of foreign",
+ "\tprocedures."
]).
:- pred options_help_verbosity(io::di, io::uo) is det.
Index: compiler/pred_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pred_table.m,v
retrieving revision 1.12
diff -u -r1.12 pred_table.m
--- compiler/pred_table.m 16 Jul 2009 02:48:52 -0000 1.12
+++ compiler/pred_table.m 20 Jul 2009 14:31:03 -0000
@@ -165,8 +165,8 @@
% could only be one matching pred_id, since each predicate or function
% could be uniquely identified by its module, name, arity, and category
% (function/predicate). However this is no longer true, due to nested
- % modules. (For example, `pred foo:bar/2' might match both
- % `pred mod1:foo:bar/2' and `pred mod2:foo:bar/2'). I hope it doesn't
+ % modules. (For example, `pred foo.bar/2' might match both
+ % `pred mod1.foo.bar/2' and `pred mod2.foo.bar/2'). I hope it doesn't
% break anything too badly...
%
% (`m_n_a' here is short for "module, name, arity".)
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.592
diff -u -r1.592 user_guide.texi
--- doc/user_guide.texi 3 Sep 2009 23:57:44 -0000 1.592
+++ doc/user_guide.texi 4 Sep 2009 15:01:07 -0000
@@ -6313,6 +6313,11 @@
@findex --no-warn-unresolved-polymorphism
Do not warn about unresolved polymorphism.
+ at sp 1
+ at item --warn-suspicious-foreign-procs
+ at findex --warn-suspicious-foreign-procs
+Warn about possible errors in the bodies of foreign procedures.
+
@end table
@node Verbosity options
Index: tests/warnings/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/Mercury.options,v
retrieving revision 1.15
diff -u -r1.15 Mercury.options
--- tests/warnings/Mercury.options 19 Aug 2009 07:45:13 -0000 1.15
+++ tests/warnings/Mercury.options 4 Sep 2009 15:20:57 -0000
@@ -61,3 +61,6 @@
MCFLAGS-warn_non_contiguous_foreign_group = \
--warn-non-contiguous-clauses \
--no-warn-non-contiguous-foreign-procs
+
+MCFLAGS-warn_return = --warn-suspicious-foreign-procs
+MCFLAGS-warn_succ_ind = --warn-suspicious-foreign-procs
Index: tests/warnings/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/Mmakefile,v
retrieving revision 1.47
diff -u -r1.47 Mmakefile
--- tests/warnings/Mmakefile 19 Aug 2009 07:45:13 -0000 1.47
+++ tests/warnings/Mmakefile 4 Sep 2009 15:22:05 -0000
@@ -38,6 +38,8 @@
warn_non_contiguous \
warn_non_contiguous_foreign \
warn_non_contiguous_foreign_group \
+ warn_return \
+ warn_succ_ind \
warn_stubs
# We don't yet pass (or even have a .exp file for) this test.
Index: tests/warnings/warn_return.exp
===================================================================
RCS file: tests/warnings/warn_return.exp
diff -N tests/warnings/warn_return.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_return.exp 4 Sep 2009 15:21:21 -0000
@@ -0,0 +1,2 @@
+warn_return.m:012: warning: the C code for predicate `warn_return.foo'/2 may
+warn_return.m:012: contain a `return' statement.
Index: tests/warnings/warn_return.exp2
===================================================================
RCS file: tests/warnings/warn_return.exp2
diff -N tests/warnings/warn_return.exp2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_return.exp2 4 Sep 2009 15:21:32 -0000
@@ -0,0 +1,2 @@
+warn_return.m:028: warning: the Java code for predicate `warn_return.foo'/2 may
+warn_return.m:028: contain a `return' statement.
Index: tests/warnings/warn_return.exp3
===================================================================
RCS file: tests/warnings/warn_return.exp3
diff -N tests/warnings/warn_return.exp3
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_return.exp3 4 Sep 2009 15:21:41 -0000
@@ -0,0 +1,2 @@
+warn_return.m:020: warning: the C# code for predicate `warn_return.foo'/2 may
+warn_return.m:020: contain a `return' statement.
Index: tests/warnings/warn_return.m
===================================================================
RCS file: tests/warnings/warn_return.m
diff -N tests/warnings/warn_return.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_return.m 4 Sep 2009 15:20:26 -0000
@@ -0,0 +1,36 @@
+% vim: ft=mercury ts=4 sw=4 et
+
+% Test --warn-suspicious-foreign-procs for return statements.
+
+:- module warn_return.
+:- interface.
+
+:- pred foo(int::in, int::out) is det.
+
+:- implementation.
+
+:- pragma foreign_proc("C",
+ foo(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ return;
+").
+
+:- pragma foreign_proc("C#",
+ foo(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ return;
+").
+
+:- pragma foreign_proc("Java",
+ foo(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ return;
+").
+
+:- end_module warn_return.
Index: tests/warnings/warn_succ_ind.exp
===================================================================
RCS file: tests/warnings/warn_succ_ind.exp
diff -N tests/warnings/warn_succ_ind.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_succ_ind.exp 4 Sep 2009 15:09:58 -0000
@@ -0,0 +1,10 @@
+warn_succ_ind.m:016: warning: the C code for predicate `warn_succ_ind.foo'/2
+warn_succ_ind.m:016: may set `SUCCESS_INDICATOR' , but it cannot fail.
+warn_succ_ind.m:048: warning: the C code for predicate `warn_succ_ind.foo2'/2
+warn_succ_ind.m:048: may set `SUCCESS_INDICATOR' , but it cannot fail.
+warn_succ_ind.m:080: warning: the C code for predicate `warn_succ_ind.bar'/2
+warn_succ_ind.m:080: does not appear to set `SUCCESS_INDICATOR' , but it can
+warn_succ_ind.m:080: fail.
+warn_succ_ind.m:108: warning: the C code for predicate `warn_succ_ind.bar2'/2
+warn_succ_ind.m:108: does not appear to set `SUCCESS_INDICATOR' , but it can
+warn_succ_ind.m:108: fail.
Index: tests/warnings/warn_succ_ind.exp2
===================================================================
RCS file: tests/warnings/warn_succ_ind.exp2
diff -N tests/warnings/warn_succ_ind.exp2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_succ_ind.exp2 4 Sep 2009 15:08:53 -0000
@@ -0,0 +1,10 @@
+warn_succ_ind.m:024: warning: the C# code for predicate `warn_succ_ind.foo'/2
+warn_succ_ind.m:024: may set `SUCCESS_INDICATOR' , but it cannot fail.
+warn_succ_ind.m:056: warning: the C# code for predicate `warn_succ_ind.foo2'/2
+warn_succ_ind.m:056: may set `SUCCESS_INDICATOR' , but it cannot fail.
+warn_succ_ind.m:087: warning: the C# code for predicate `warn_succ_ind.bar'/2
+warn_succ_ind.m:087: does not appear to set `SUCCESS_INDICATOR' , but it can
+warn_succ_ind.m:087: fail.
+warn_succ_ind.m:115: warning: the C# code for predicate `warn_succ_ind.bar2'/2
+warn_succ_ind.m:115: does not appear to set `SUCCESS_INDICATOR' , but it can
+warn_succ_ind.m:115: fail.
Index: tests/warnings/warn_succ_ind.exp3
===================================================================
RCS file: tests/warnings/warn_succ_ind.exp3
diff -N tests/warnings/warn_succ_ind.exp3
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_succ_ind.exp3 4 Sep 2009 15:09:00 -0000
@@ -0,0 +1,10 @@
+warn_succ_ind.m:032: warning: the Java code for predicate `warn_succ_ind.foo'/2
+warn_succ_ind.m:032: may set `succeeded' , but it cannot fail.
+warn_succ_ind.m:064: warning: the Java code for predicate
+warn_succ_ind.m:064: `warn_succ_ind.foo2'/2 may set `succeeded' , but it
+warn_succ_ind.m:064: cannot fail.
+warn_succ_ind.m:094: warning: the Java code for predicate `warn_succ_ind.bar'/2
+warn_succ_ind.m:094: does not appear to set `succeeded' , but it can fail.
+warn_succ_ind.m:122: warning: the Java code for predicate
+warn_succ_ind.m:122: `warn_succ_ind.bar2'/2 does not appear to set
+warn_succ_ind.m:122: `succeeded' , but it can fail.
Index: tests/warnings/warn_succ_ind.exp4
===================================================================
RCS file: tests/warnings/warn_succ_ind.exp4
diff -N tests/warnings/warn_succ_ind.exp4
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_succ_ind.exp4 4 Sep 2009 15:09:08 -0000
@@ -0,0 +1,12 @@
+warn_succ_ind.m:040: warning: the Erlang code for predicate
+warn_succ_ind.m:040: `warn_succ_ind.foo'/2 may set `SUCCESS_INDICATOR' , but
+warn_succ_ind.m:040: it cannot fail.
+warn_succ_ind.m:072: warning: the Erlang code for predicate
+warn_succ_ind.m:072: `warn_succ_ind.foo2'/2 may set `SUCCESS_INDICATOR' , but
+warn_succ_ind.m:072: it cannot fail.
+warn_succ_ind.m:101: warning: the Erlang code for predicate
+warn_succ_ind.m:101: `warn_succ_ind.bar'/2 does not appear to set
+warn_succ_ind.m:101: `SUCCESS_INDICATOR' , but it can fail.
+warn_succ_ind.m:129: warning: the Erlang code for predicate
+warn_succ_ind.m:129: `warn_succ_ind.bar2'/2 does not appear to set
+warn_succ_ind.m:129: `SUCCESS_INDICATOR' , but it can fail.
Index: tests/warnings/warn_succ_ind.m
===================================================================
RCS file: tests/warnings/warn_succ_ind.m
diff -N tests/warnings/warn_succ_ind.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_succ_ind.m 4 Sep 2009 15:18:13 -0000
@@ -0,0 +1,136 @@
+% vim: ft=mercury ts=4 sw=4 et
+
+% Test --warn-suspicious-foreign-procs for SUCCESS_INDICATOR
+
+:- module warn_succ_ind.
+:- interface.
+
+:- pred foo(int::in, int::out) is det.
+:- pred foo2(int::in, int::out) is cc_multi.
+
+:- pred bar(int::in, int::out) is semidet.
+:- pred bar2(int::in, int::out) is cc_nondet.
+
+:- implementation.
+
+:- pragma foreign_proc("C",
+ foo(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ SUCCESS_INDICATOR = MR_FALSE;
+").
+
+:- pragma foreign_proc("C#",
+ foo(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ SUCCESS_INDICATOR = MR_FALSE;
+").
+
+:- pragma foreign_proc("Java",
+ foo(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ succeeded = MR_FALSE;
+").
+
+:- pragma foreign_proc("Erlang",
+ foo(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y,
+ SUCCESS_INDICATOR = true
+").
+
+:- pragma foreign_proc("C",
+ foo2(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ SUCCESS_INDICATOR = MR_FALSE;
+").
+
+:- pragma foreign_proc("C#",
+ foo2(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ SUCCESS_INDICATOR = MR_FALSE;
+").
+
+:- pragma foreign_proc("Java",
+ foo2(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+ succeeded = MR_FALSE;
+").
+
+:- pragma foreign_proc("Erlang",
+ foo2(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y,
+ SUCCESS_INDICATOR = true
+").
+
+:- pragma foreign_proc("C",
+ bar(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+").
+
+:- pragma foreign_proc("C#",
+ bar(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+").
+
+:- pragma foreign_proc("Java",
+ bar(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+").
+
+:- pragma foreign_proc("Erlang",
+ bar(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y
+").
+
+:- pragma foreign_proc("C",
+ bar2(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+").
+
+:- pragma foreign_proc("C#",
+ bar2(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+").
+
+:- pragma foreign_proc("Java",
+ bar2(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y;
+").
+
+:- pragma foreign_proc("Erlang",
+ bar2(X::in, Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = Y
+").
+
+:- end_module warn_succ_ind.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list