[m-rev.] for review: multiple foreign clauses for the same language

[Julien Fischer]

For review by anyone.

Estimated hours taken: 1
Branches: main

Fix a bug reported by Ondrej Bojar.  If there were multiple foreign clauses
in the same language for a procedure we silently ignored all but the first;
we now emit an error message.

This isn't a complete fix: multiple foreign clauses in a language not
supported as a foreign language by the current target language won't be
reported, and whether multiple clauses in a foreign language that is
supported by the target language but is not the preferred foreign language
depends upon the presence of clauses in the preferred foreign language (and
their order relative to each other.) Fixing these two problems (particularly
the first) would be a lot more work; given the rarity of the problem it
also has a rather low priority.

compiler/add_pragma.m:
 	Emit an error message if there are multiple foreign clauses
 	in the same language for a procedure.

tests/invalid/Mmakefile:
tests/invalid/fp_dup_bug.{m,err_exp}:
 	Test case for the above.

Julien.

Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.60
diff -u -r1.60 add_pragma.m
--- compiler/add_pragma.m	19 Jan 2007 07:04:07 -0000	1.60
+++ compiler/add_pragma.m	6 Feb 2007 14:04:55 -0000
@@ -2515,8 +2515,10 @@
      module_info_get_globals(!.ModuleInfo, Globals),
      globals.get_target(Globals, Target),
      NewLang = get_foreign_language(Attributes0),
-    list.foldl2(decide_action(Globals, Target, NewLang, ProcId), ClauseList,
-        add, FinalAction, 1, _),
+    list.foldl3(
+        decide_action(PredName, Arity, PredOrFunc, Context, Globals,
+            Target, NewLang, ProcId),
+        ClauseList, add, FinalAction, 1, _, !Specs),

      globals.get_backend_foreign_languages(Globals, BackendForeignLanguages),
      pragma_get_vars(PVars, Args0),
@@ -2715,20 +2717,22 @@
      ;       split_add(int, clause)
      ;       replace(int).

-:- pred decide_action(globals::in, compilation_target::in,
+:- pred decide_action(sym_name::in, arity::in, pred_or_func::in,
+    prog_context::in, globals::in, compilation_target::in,
      foreign_language::in, proc_id::in, clause::in,
      foreign_proc_action::in, foreign_proc_action::out,
-    int::in, int::out) is det.
+    int::in, int::out, list(error_spec)::in, list(error_spec)::out) is det.

-decide_action(Globals, Target, NewLang, ProcId, Clause, !Action, !ClauseNum) :-
-    Clause = clause(ProcIds, Body, ClauseLang, Context),
+decide_action(PredName, Arity, PredOrFunc, NewContext, Globals,
+        Target, NewLang, ProcId, Clause, !Action, !ClauseNum, !Specs) :-
+    Clause = clause(ProcIds, Body, ClauseLang, ClauseContext),
      (
          ClauseLang = impl_lang_mercury,
          ( ProcIds = [ProcId] ->
              !:Action = replace(!.ClauseNum)
          ; list.delete_first(ProcIds, ProcId, MercuryProcIds) ->
              NewMercuryClause = clause(MercuryProcIds, Body, ClauseLang,
-                Context),
+                ClauseContext),
              !:Action = split_add(!.ClauseNum, NewMercuryClause)
          ;
              true
@@ -2744,8 +2748,32 @@
                  % language, so we should replace it
                  !:Action = replace(!.ClauseNum)
              ;
-                % Just ignore it.
-                !:Action = ignore
+                % Just ignore the clause - if they are both for the same
+                % language then we emit an error message as well.
+                % XXX This won't detect multiple clauses in languages
+                %     that are not supported by this backend. 
+                !:Action = ignore,
+                ( OldLang = NewLang ->
+                    PiecesA = [
+                        words("Error: multiple clauses for"),
+                        p_or_f(PredOrFunc),
+                        sym_name_and_arity(PredName / Arity),
+                        words("in language"),
+                        words(foreign_language_string(OldLang)),
+                        suffix("."), nl
+                    ],
+                    PiecesB = [
+                        words("The first occurrence was here.")
+                    ],
+                    MsgA = simple_msg(NewContext, [always(PiecesA)]),
+                    MsgB = error_msg(yes(ClauseContext), yes, 0,
+                        [always(PiecesB)]),
+                    Spec = error_spec(severity_error,
+                        phase_parse_tree_to_hlds, [MsgA, MsgB]),
+                    !:Specs = [Spec | !.Specs]
+                ;
+                    true
+                )
              )
          ;
              true
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.207
diff -u -r1.207 Mmakefile
--- tests/invalid/Mmakefile	5 Feb 2007 03:12:53 -0000	1.207
+++ tests/invalid/Mmakefile	6 Feb 2007 14:04:55 -0000
@@ -86,6 +86,7 @@
  	foreign_singleton \
  	foreign_type_2 \
  	foreign_type_visibility \
+	fp_dup_bug \
  	freefree \
  	func_errors \
  	funcs_as_preds \
Index: tests/invalid/fp_dup_bug.err_exp
===================================================================
RCS file: tests/invalid/fp_dup_bug.err_exp
diff -N tests/invalid/fp_dup_bug.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/fp_dup_bug.err_exp	6 Feb 2007 14:04:55 -0000
@@ -0,0 +1,6 @@
+fp_dup_bug.m:017: Error: multiple clauses for predicate `fp_dup_bug.foo'/2 in
+fp_dup_bug.m:017:   language C.
+fp_dup_bug.m:010: The first occurrence was here.
+fp_dup_bug.m:024: Error: multiple clauses for predicate `fp_dup_bug.foo'/2 in
+fp_dup_bug.m:024:   language C.
+fp_dup_bug.m:010: The first occurrence was here.
Index: tests/invalid/fp_dup_bug.m
===================================================================
RCS file: tests/invalid/fp_dup_bug.m
diff -N tests/invalid/fp_dup_bug.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/fp_dup_bug.m	6 Feb 2007 14:04:55 -0000
@@ -0,0 +1,29 @@
+% rotd-2007-02-06 and before silently ignored the face that
+% there were multiple foreign clauses for the same language. 
+:- module fp_dup_bug.
+:- 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;
+").
+
+:- pragma foreign_proc("C",
+     foo(X::in, Y::out),
+     [will_not_call_mercury, promise_pure],
+"
+	X = Y;
+").
+
+:- pragma foreign_proc("C",
+     foo(X::in, Y::out),
+     [will_not_call_mercury, promise_pure],
+"
+	X = Y;
+").

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------