[m-rev.] diff: fix bug #83
Julien Fischer
juliensf at csse.unimelb.edu.au
Mon Apr 6 02:14:01 AEST 2009
Estimated hours taken: 1
Branches: main
Fix bug #83. The compiler was incorrectly reporting ambiguous predicate
or function names in `pragma foreign_export' declarations as not existing.
compiler/add_pragma.m:
Report ambiguous predicate or function names in foreign_export
pragmas properly.
tests/invalid/Mercury.options:
tests/invalid/Mmakefile:
tests/invalid/bug83.{m,err_exp}:
Test for the above.
Julien.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.87
diff -u -r1.87 add_pragma.m
--- compiler/add_pragma.m 28 Aug 2008 04:10:51 -0000 1.87
+++ compiler/add_pragma.m 5 Apr 2009 16:05:44 -0000
@@ -142,9 +142,10 @@
:- import_module backend_libs.rtti.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
-:- import_module hlds.hlds_args.
:- import_module hlds.code_model.
+:- import_module hlds.hlds_args.
:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_rtti.
@@ -394,112 +395,150 @@
list.length(Modes, Arity),
(
predicate_table_search_pf_sym_arity(PredTable,
- may_be_partially_qualified, PredOrFunc, Name, Arity, [PredId])
+ may_be_partially_qualified, PredOrFunc, Name, Arity, PredIds),
+ ( PredIds = [_]
+ ; PredIds = [_, _ | _]
+ )
->
- predicate_table_get_preds(PredTable, Preds),
- map.lookup(Preds, PredId, PredInfo),
- pred_info_get_procedures(PredInfo, Procs),
- map.to_assoc_list(Procs, ExistingProcs),
(
- get_procedure_matching_declmodes_with_renaming(ExistingProcs,
- Modes, !.ModuleInfo, ProcId)
- ->
- map.lookup(Procs, ProcId, ProcInfo),
- proc_info_get_declared_determinism(ProcInfo, MaybeDet),
- % We cannot catch those multi or nondet procedures that don't have
- % a determinism declaration until after determinism analysis.
- (
- MaybeDet = yes(Det),
- ( Det = detism_non
- ; Det = detism_multi
- )
- ->
- Pieces = [words("Error: "),
- fixed("`:- pragma foreign_export' declaration"),
- words("for a procedure that has"),
- words("a declared determinism of"),
- fixed(hlds_out.determinism_to_string(Det) ++ ".")
- ],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds,
- [Msg]),
- !:Specs = [Spec | !.Specs]
+ PredIds = [PredId],
+ add_pragma_foreign_export_2(Arity, PredTable, Origin, Lang, Name,
+ PredId, Modes, ExportedName, Context, !ModuleInfo, !Specs)
+ ;
+ PredIds = [_, _ | _],
+ StartPieces = [
+ words("error: ambiguous"), p_or_f(PredOrFunc),
+ words("name in"), quote("pragma foreign_export"),
+ words("declaration."), nl,
+ words("The possible matches are:"), nl_indent_delta(1)
+ ],
+ PredIdPiecesList = list.map(
+ describe_one_pred_name(!.ModuleInfo, should_module_qualify),
+ PredIds),
+ PredIdPieces = component_list_to_line_pieces(PredIdPiecesList,
+ [suffix(".")]),
+ MainPieces = StartPieces ++ PredIdPieces,
+ VerbosePieces = [
+ words("An explicit module qualifier may"),
+ words("be necessary.")
+ ],
+ Msg = simple_msg(Context,
+ [always(MainPieces), verbose_only(VerbosePieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ )
+ ;
+ (
+ Origin = user,
+ undefined_pred_or_func_error(Name, Arity, Context,
+ "`:- pragma foreign_export' declaration", !Specs)
+ ;
+ Origin = compiler(Details),
+ (
+ Details = initialise_decl
;
- % Emit a warning about using pragma foreign_export with
- % a foreign language that is not supported.
- % XXX That's currently all of them except C, IL and Erlang.
- (
- ( Lang = lang_java
- ; Lang = lang_csharp
- ),
- Pieces = [words("Warning:"),
- fixed("`:- pragma foreign_export' declarations"),
- words("are not yet implemented for language"),
- words(foreign_language_string(Lang)), suffix("."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_warning,
- phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs]
- ;
- ( Lang = lang_c
- ; Lang = lang_il
- ; Lang = lang_erlang
- )
+ Details = mutable_decl
+ ;
+ Details = finalise_decl
+ ;
+ ( Details = solver_type
+ ; Details = foreign_imports
+ ; Details = pragma_memo_attribute
),
+ unexpected(this_file, "Bad introduced foreign_export pragma.")
+ )
+ )
+ ).
- % Only add the foreign export if the specified language matches
- % one of the foreign languages available for this backend.
- module_info_get_globals(!.ModuleInfo, Globals),
- globals.get_backend_foreign_languages(Globals,
- ForeignLanguages),
- (
- % XXX C# exports currently cause an
- % assertion failure in the MLDS->IL code generator.
+:- pred add_pragma_foreign_export_2(arity::in, predicate_table::in,
+ item_origin::in, foreign_language::in,
+ sym_name::in, pred_id::in, list(mer_mode)::in, string::in,
+ prog_context::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
- Lang \= lang_csharp,
- list.member(Lang, ForeignLanguages)
- ->
- module_info_get_pragma_exported_procs(!.ModuleInfo,
- PragmaExportedProcs0),
- NewExportedProc = pragma_exported_proc(Lang,
- PredId, ProcId, ExportedName, Context),
- PragmaExportedProcs =
- [NewExportedProc | PragmaExportedProcs0],
- module_info_set_pragma_exported_procs(PragmaExportedProcs,
- !ModuleInfo)
- ;
- true
- )
+add_pragma_foreign_export_2(Arity, PredTable, Origin, Lang, Name, PredId, Modes,
+ ExportedName, Context, !ModuleInfo, !Specs) :-
+ predicate_table_get_preds(PredTable, Preds),
+ map.lookup(Preds, PredId, PredInfo),
+ pred_info_get_procedures(PredInfo, Procs),
+ map.to_assoc_list(Procs, ExistingProcs),
+ (
+ get_procedure_matching_declmodes_with_renaming(ExistingProcs,
+ Modes, !.ModuleInfo, ProcId)
+ ->
+ map.lookup(Procs, ProcId, ProcInfo),
+ proc_info_get_declared_determinism(ProcInfo, MaybeDet),
+ % We cannot catch those multi or nondet procedures that don't have
+ % a determinism declaration until after determinism analysis.
+ (
+ MaybeDet = yes(Det),
+ ( Det = detism_non
+ ; Det = detism_multi
)
+ ->
+ Pieces = [words("Error: "),
+ fixed("`:- pragma foreign_export' declaration"),
+ words("for a procedure that has"),
+ words("a declared determinism of"),
+ fixed(hlds_out.determinism_to_string(Det) ++ ".")
+ ],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds,
+ [Msg]),
+ !:Specs = [Spec | !.Specs]
;
- % We do not warn about errors in export pragmas created by the
- % compiler as part of a source-to-source transformation.
+ % Emit a warning about using pragma foreign_export with
+ % a foreign language that is not supported.
+ % XXX That's currently all of them except C, IL and Erlang.
(
- Origin = user,
- undefined_mode_error(Name, Arity, Context,
- "`:- pragma foreign_export' declaration", !Specs)
+ ( Lang = lang_java
+ ; Lang = lang_csharp
+ ),
+ Pieces = [words("Warning:"),
+ fixed("`:- pragma foreign_export' declarations"),
+ words("are not yet implemented for language"),
+ words(foreign_language_string(Lang)), suffix("."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_warning,
+ phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
;
- Origin = compiler(Details),
- (
- Details = initialise_decl
- ;
- Details = mutable_decl
- ;
- Details = finalise_decl
- ;
- ( Details = solver_type
- ; Details = foreign_imports
- ; Details = pragma_memo_attribute
- ),
- unexpected(this_file,
- "Bad introduced foreign_export pragma.")
+ ( Lang = lang_c
+ ; Lang = lang_il
+ ; Lang = lang_erlang
)
+ ),
+
+ % Only add the foreign export if the specified language matches
+ % one of the foreign languages available for this backend.
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.get_backend_foreign_languages(Globals,
+ ForeignLanguages),
+ (
+ % XXX C# exports currently cause an
+ % assertion failure in the MLDS->IL code generator.
+
+ Lang \= lang_csharp,
+ list.member(Lang, ForeignLanguages)
+ ->
+ module_info_get_pragma_exported_procs(!.ModuleInfo,
+ PragmaExportedProcs0),
+ NewExportedProc = pragma_exported_proc(Lang,
+ PredId, ProcId, ExportedName, Context),
+ PragmaExportedProcs =
+ [NewExportedProc | PragmaExportedProcs0],
+ module_info_set_pragma_exported_procs(PragmaExportedProcs,
+ !ModuleInfo)
+ ;
+ true
)
)
;
+ % We do not warn about errors in export pragmas created by the
+ % compiler as part of a source-to-source transformation.
(
Origin = user,
- undefined_pred_or_func_error(Name, Arity, Context,
+ undefined_mode_error(Name, Arity, Context,
"`:- pragma foreign_export' declaration", !Specs)
;
Origin = compiler(Details),
@@ -514,7 +553,8 @@
; Details = foreign_imports
; Details = pragma_memo_attribute
),
- unexpected(this_file, "Bad introduced foreign_export pragma.")
+ unexpected(this_file,
+ "Bad introduced foreign_export pragma.")
)
)
).
Index: tests/invalid/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mercury.options,v
retrieving revision 1.31
diff -u -r1.31 Mercury.options
--- tests/invalid/Mercury.options 5 Apr 2009 12:16:48 -0000 1.31
+++ tests/invalid/Mercury.options 5 Apr 2009 15:58:23 -0000
@@ -117,6 +117,7 @@
MCFLAGS-anys_in_negated_contexts = --verbose-error-messages
MCFLAGS-bigtest = --verbose-error-messages
MCFLAGS-bind_in_negated = --verbose-error-messages
+MCFLAGS-bug83 = --verbose-error-messages
MCFLAGS-complex_constraint_err = --verbose-error-messages
MCFLAGS-errors2 = --verbose-error-messages
MCFLAGS-ext_type = --verbose-error-messages
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.234
diff -u -r1.234 Mmakefile
--- tests/invalid/Mmakefile 5 Apr 2009 12:16:48 -0000 1.234
+++ tests/invalid/Mmakefile 5 Apr 2009 15:57:05 -0000
@@ -49,6 +49,7 @@
bind_var_errors \
builtin_int \
builtin_proc \
+ bug83 \
circ_inst \
circ_inst2 \
circ_inst3 \
Index: tests/invalid/bug83.err_exp
===================================================================
RCS file: tests/invalid/bug83.err_exp
diff -N tests/invalid/bug83.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/bug83.err_exp 5 Apr 2009 15:57:36 -0000
@@ -0,0 +1,6 @@
+bug83.m:022: error: ambiguous function name in `pragma foreign_export'
+bug83.m:022: declaration.
+bug83.m:022: The possible matches are:
+bug83.m:022: function `io.make_io_error'/1,
+bug83.m:022: function `bug83.make_io_error'/1.
+bug83.m:022: An explicit module qualifier may be necessary.
Index: tests/invalid/bug83.m
===================================================================
RCS file: tests/invalid/bug83.m
diff -N tests/invalid/bug83.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/bug83.m 5 Apr 2009 16:07:46 -0000
@@ -0,0 +1,28 @@
+%-----------------------------------------------------------------------------%
+% rotd-2009-04-5 and before incorrectly reported that the function in the
+% foreign_export pragam below did not exist; the correct error to report
+% is that there are multiple matches for the second argument of the pragma.
+% (This was Mercury bug #83.)
+
+:- module bug83.
+:- interface.
+
+:- import_module io.
+
+:- func make_io_error(string) = io.res.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+% WORKS
+% :- pragma foreign_export("C", fe.make_io_error(in) = out, "OAMQ_make_io_error").
+
+:- pragma foreign_export("C", make_io_error(in) = out, "OAMQ_make_io_error").
+
+make_io_error(Message) = io.error(Error) :-
+ Error = io.make_io_error(Message).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
--------------------------------------------------------------------------
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