[m-rev.] for review: improve error reporting for foreign_enum pragmas

Julien Fischer jfischer at opturion.com
Wed May 18 11:22:15 AEST 2016


For review by anyone.

I will make a similar change to the handling of foreign_export_enum
pragmas separately.

------------------------

Improve error reporting for foreign_enum pragmas.

Have the parser, rather than the parse tree -> HLDS conversion, check for the
third argument of a foreign_enum pragma being an empty list.  (A enumeration
must define at least one constant in order to be an enumeration so the list
should never be non-empty.)

Parse each argument of a foreign_enum pragma separately and report all of the
errors (well, most of them -- see below) that occur in one go.

Minor improvements and fixes to the wording of parser error messages for
foreign_enum pragmas.

Improve test coverage of error messages for parsing pragmas.

compiler/parse_pragma.m:
     Parse each argument of a foreign_enum pragma separately and report
     all the errors that occur.  The handling of the third argument is
     not as good as it could be -- add an XXX comment about it.

     Check that the third argument of a foreign_enum pragma is not an
     empty list during parsing -- while we currently generate an error
     for this during parse tree -> HLDS conversion, that error is not
     entirely accurate and we may as well catch this error earlier in
     any case.

     Do not incorrectly refer to 'foreign_export_enum' pragmas in error
     messages about 'foreign_enum' pragmas.  Factor out the shared code
     that was the cause of this more thoroughly.

     Improve and fix parser error messages for foreign_enum pragmas.

     Fix spelling in the error message for a misformed pragma declaration.

     Fix a misspelled predicate name: s/unrecogized/unrecognized/

     Fix the wording and spelling in some comments.

tests/invalid/bad_foreign_enum.{m,err_exp}:
     Extend this test case to cover the above.

tests/invalid/foreign_enum_invalid.{m,err_exp}:
     Delete the test for an empty mapping list, that situation is now
     caught earlier.

tests/invalid/invalid_pragma.{m,err_exp}:
     Test the error message for an invalid pragma.

tests/invalid/unrecognized_pragma.{m,err_exp}:
     Test the error message for an unrecognized pragma.

tests/invalid/Mmakefile:
     Add the new test cases.

diff --git a/compiler/parse_pragma.m b/compiler/parse_pragma.m
index 8b5bd60..caa105d 100644
--- a/compiler/parse_pragma.m
+++ b/compiler/parse_pragma.m
@@ -98,16 +98,16 @@ parse_pragma(ModuleName, VarSet, PragmaTerms, Context, SeqNum, MaybeIOM) :-
              MaybeIOM = error1([Spec])
          )
      else
-        Spec = report_unrecogized_pragma(Context),
+        Spec = report_unrecognized_pragma(Context),
          MaybeIOM = error1([Spec])
      ).

-:- func report_unrecogized_pragma(prog_context) = error_spec.
+:- func report_unrecognized_pragma(prog_context) = error_spec.

-report_unrecogized_pragma(Context) = Spec :-
+report_unrecognized_pragma(Context) = Spec :-
      Pieces = [words("Error: a"), decl("pragma"), words("declaration"),
          words("should have the form"),
-        quote(":- pragma pragma_name(pragma_rguments)."), nl],
+        quote(":- pragma pragma_name(pragma_arguments)."), nl],
      Spec = error_spec(severity_error, phase_term_to_parse_tree,
          [simple_msg(Context, [always(Pieces)])]).

@@ -333,7 +333,7 @@ parse_pragma_type(ModuleName, VarSet, ErrorTerm, PragmaName, PragmaTerms,
                  BeforeWherePragmaTerms, BeforeWhereContext, SeqNum,
                  MaybeMaybeUC, MaybeIOM)
          else
-            Spec = report_unrecogized_pragma(Context),
+            Spec = report_unrecognized_pragma(Context),
              MaybeIOM = error1([Spec])
          )
      ).
@@ -526,7 +526,8 @@ parse_pragma_foreign_export_enum(VarSet, ErrorTerm, PragmaTerms,
          )
      then
          ( if parse_foreign_language(LangTerm, ForeignLang) then
-            parse_export_enum_type_ctor(MercuryTypeTerm, MaybeTypeCtor),
+            parse_type_ctor_name_arity("foreign_export_enum", MercuryTypeTerm,
+                MaybeTypeCtor),
              (
                  MaybeTypeCtor = ok1(TypeCtor),
                  maybe_parse_export_enum_attributes(VarSet, MaybeAttributesTerm,
@@ -573,19 +574,6 @@ parse_pragma_foreign_export_enum(VarSet, ErrorTerm, PragmaTerms,
          MaybeIOM = error1([Spec])
      ).

-:- pred parse_export_enum_type_ctor(term::in, maybe1(type_ctor)::out) is det.
-
-parse_export_enum_type_ctor(TypeTerm, MaybeTypeCtor) :-
-    ( if parse_name_and_arity_unqualified(TypeTerm, Name, Arity) then
-        MaybeTypeCtor = ok1(type_ctor(Name, Arity))
-    else
-        Pieces = [words("Error: expected name/arity for type in"),
-            pragma_decl("foreign_export_enum"), words("declaration."), nl],
-        Spec = error_spec(severity_error, phase_term_to_parse_tree,
-            [simple_msg(get_term_context(TypeTerm), [always(Pieces)])]),
-        MaybeTypeCtor = error1([Spec])
-    ).
-
  :- pred maybe_parse_export_enum_overrides(varset::in, maybe(term)::in,
      maybe1(assoc_list(sym_name, string))::out) is det.

@@ -693,7 +681,7 @@ parse_export_enum_attributes(VarSet, AttributesTerm, AttributesResult) :-
      export_enum_attributes::in, export_enum_attributes::out) is det.

  process_export_enum_attribute(ee_attr_prefix(MaybePrefix), !Attributes) :-
-    % We haved alredy checked that the prefix attribute is not specified
+    % We have already checked that the prefix attribute is not specified
      % multiple times in parse_export_enum_attributes so it is safe to
      % ignore it in the input here.
      !.Attributes = export_enum_attributes(_, MakeUpperCase),
@@ -737,42 +725,72 @@ parse_export_enum_attr(VarSet, Term, MaybeAttribute) :-
  parse_pragma_foreign_enum(VarSet, ErrorTerm, PragmaTerms, Context, SeqNum,
          MaybeIOM) :-
      ( if PragmaTerms = [LangTerm, MercuryTypeTerm, ValuesTerm] then
+
          ( if parse_foreign_language(LangTerm, ForeignLang) then
-            parse_export_enum_type_ctor(MercuryTypeTerm, MaybeTypeCtor),
+            MaybeForeignLang = ok1(ForeignLang)
+        else
+            LangPieces = [words("Error: invalid foreign language in"),
+                pragma_decl("foreign_enum"), words("declaration."),
+                nl],
+            LangSpec = error_spec(severity_error, phase_term_to_parse_tree,
+                [simple_msg(get_term_context(LangTerm), [always(LangPieces)])]),
+            MaybeForeignLang = error1([LangSpec])
+        ),
+
+        parse_type_ctor_name_arity("foreign_enum", MercuryTypeTerm,
+            MaybeTypeCtor),
+
+        UnrecognizedPieces =
+            [words("Error: expected a valid mapping element")],
+        PairContextPieces = cord.from_list([
+            words("In"), pragma_decl("foreign_enum"),
+            words("mapping constructor name:")
+        ]),
+        % XXX the following doesn't check that foreign values are sensible
+        % (e.g. it should reject the empty string).
+        convert_maybe_list("mapping elements", yes(VarSet), ValuesTerm,
+            parse_sym_name_string_pair(VarSet, PairContextPieces),
+            UnrecognizedPieces, MaybeValues0),
+        (
+            MaybeValues0 = ok1(Values),
              (
-                MaybeTypeCtor = ok1(TypeCtor),
-                UnrecognizedPieces =
-                    [words("Error: expected a valid mapping element."), nl],
-                PairContextPieces =
-                    cord.singleton(words("In foreign_enum constructor name:")),
-                convert_maybe_list("mapping elements", yes(VarSet), ValuesTerm,
-                    parse_sym_name_string_pair(VarSet, PairContextPieces),
-                    UnrecognizedPieces, MaybeValues),
-                (
-                    MaybeValues = ok1(Values),
-                    FEInfo = pragma_info_foreign_enum(ForeignLang, TypeCtor,
-                        Values),
-                    Pragma = pragma_foreign_enum(FEInfo),
-                    ItemPragma = item_pragma_info(Pragma, item_origin_user,
-                        Context, SeqNum),
-                    Item = item_pragma(ItemPragma),
-                    MaybeIOM = ok1(iom_item(Item))
-                ;
-                    MaybeValues = error1(Specs),
-                    MaybeIOM = error1(Specs)
-                )
+                Values = [],
+                NoValuesPieces = [
+                    words("Error: expected a non-empty list"),
+                    words("mapping constructors to foreign values in"),
+                    pragma_decl("foreign_enum"), words("declaration."), nl
+                ],
+                NoValuesSpec = error_spec(severity_error,
+                    phase_term_to_parse_tree,
+                    [simple_msg(get_term_context(ValuesTerm),
+                        [always(NoValuesPieces)])]),
+                MaybeValues = error1([NoValuesSpec])
              ;
-                MaybeTypeCtor = error1(Specs),
-                MaybeIOM = error1(Specs)
+                Values = [_ | _],
+                MaybeValues = MaybeValues0
              )
+        ;
+            MaybeValues0 = error1(_),
+            MaybeValues = MaybeValues0
+        ),
+
+        ( if
+            MaybeForeignLang = ok1(ForeignLangPrime),
+            MaybeTypeCtor = ok1(TypeCtor),
+            MaybeValues = ok1(ValuesPrime)
+        then
+            FEInfo = pragma_info_foreign_enum(ForeignLangPrime, TypeCtor,
+                ValuesPrime),
+            Pragma = pragma_foreign_enum(FEInfo),
+            ItemPragma = item_pragma_info(Pragma, item_origin_user, Context,
+                SeqNum),
+            Item = item_pragma(ItemPragma),
+            MaybeIOM = ok1(iom_item(Item))
          else
-            Pieces = [words("Error: invalid foreign language in"),
-                pragma_decl("foreign_enum"), words("declaration."),
-                nl],
-            % XXX We should use the context of LangTerm.
-            Spec = error_spec(severity_error, phase_term_to_parse_tree,
-                [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
-            MaybeIOM = error1([Spec])
+            Specs = get_any_errors1(MaybeForeignLang) ++
+                get_any_errors1(MaybeTypeCtor) ++
+                get_any_errors1(MaybeValues),
+            MaybeIOM = error1(Specs)
          )
      else
          Pieces = [words("Error: wrong number of arguments in"),
@@ -784,6 +802,25 @@ parse_pragma_foreign_enum(VarSet, ErrorTerm, PragmaTerms, Context, SeqNum,

  %---------------------------------------------------------------------------%
  %
+% Common code for parsing foreign_export_enum and foreign_enum pragms.
+%
+
+:- pred parse_type_ctor_name_arity(string::in, term::in,
+    maybe1(type_ctor)::out) is det.
+
+parse_type_ctor_name_arity(PragmaName, TypeTerm, MaybeTypeCtor) :-
+    ( if parse_name_and_arity_unqualified(TypeTerm, Name, Arity) then
+        MaybeTypeCtor = ok1(type_ctor(Name, Arity))
+    else
+        Pieces = [words("Error: expected name/arity for type in"),
+            pragma_decl(PragmaName), words("declaration."), nl],
+        Spec = error_spec(severity_error, phase_term_to_parse_tree,
+            [simple_msg(get_term_context(TypeTerm), [always(Pieces)])]),
+        MaybeTypeCtor = error1([Spec])
+    ).
+
+%---------------------------------------------------------------------------%
+%
  % Code for parsing foreign_export pragmas.
  %

@@ -3293,7 +3330,7 @@ convert_int_list(VarSet, ListTerm, Result) :-
      %
      % Convert Term into a list of elements where Pred converts each element
      % of the list into the correct type. Result will hold the list if the
-    % conversion succeded for each element of M, otherwise it will hold
+    % conversion succeeded for each element of M, otherwise it will hold
      % the error. What should be a plural noun or noun phrase describing
      % the expected list. If MaybeVarSet is yes, it should specify the varset
      % for use in describing any unrecognized list elements.
diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile
index 1bfc046..295526b 100644
--- a/tests/invalid/Mmakefile
+++ b/tests/invalid/Mmakefile
@@ -166,6 +166,7 @@ SINGLEMODULE= \
  	invalid_main \
  	invalid_mllibs \
  	invalid_new \
+	invalid_pragma \
  	invalid_typeclass \
  	io_in_ite_cond \
  	kind \
@@ -300,6 +301,7 @@ SINGLEMODULE= \
  	uniq_modes \
  	uniq_mutable \
  	uniq_neg \
+	unrecognized_pragma \
  	unsatisfiable_constraint \
  	unsatisfiable_constraint_bug \
  	unsatisfiable_constraint_msg \
diff --git a/tests/invalid/bad_foreign_enum.err_exp b/tests/invalid/bad_foreign_enum.err_exp
index 9676258..79785ba 100644
--- a/tests/invalid/bad_foreign_enum.err_exp
+++ b/tests/invalid/bad_foreign_enum.err_exp
@@ -1,4 +1,19 @@
-bad_foreign_enum.m:024: Error: wrong number of arguments in
-bad_foreign_enum.m:024:   `:- pragma foreign_enum' declaration.
-bad_foreign_enum.m:028: Error: invalid foreign language in
-bad_foreign_enum.m:028:   `:- pragma foreign_enum' declaration.
+bad_foreign_enum.m:044: Error: wrong number of arguments in
+bad_foreign_enum.m:044:   `:- pragma foreign_enum' declaration.
+bad_foreign_enum.m:048: Error: expected a non-empty list mapping constructors
+bad_foreign_enum.m:048:   to foreign values in `:- pragma foreign_enum'
+bad_foreign_enum.m:048:   declaration.
+bad_foreign_enum.m:048: Error: invalid foreign language in
+bad_foreign_enum.m:048:   `:- pragma foreign_enum' declaration.
+bad_foreign_enum.m:052: Error: expected name/arity for type in
+bad_foreign_enum.m:052:   `:- pragma foreign_enum' declaration.
+bad_foreign_enum.m:059: Error: invalid foreign language in
+bad_foreign_enum.m:059:   `:- pragma foreign_enum' declaration.
+bad_foreign_enum.m:060: Error: expected name/arity for type in
+bad_foreign_enum.m:060:   `:- pragma foreign_enum' declaration.
+bad_foreign_enum.m:061: Error: expected a non-empty list mapping constructors
+bad_foreign_enum.m:061:   to foreign values in `:- pragma foreign_enum'
+bad_foreign_enum.m:061:   declaration.
+bad_foreign_enum.m:067: Error: expected a valid mapping element, not `chicken'.
+bad_foreign_enum.m:074: In `:- pragma foreign_enum' mapping constructor name:
+bad_foreign_enum.m:074:   error: atom expected at "goose".
diff --git a/tests/invalid/bad_foreign_enum.m b/tests/invalid/bad_foreign_enum.m
index 58e857a..d16bec4 100644
--- a/tests/invalid/bad_foreign_enum.m
+++ b/tests/invalid/bad_foreign_enum.m
@@ -2,8 +2,10 @@
  % vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
  %---------------------------------------------------------------------------%
  %
-% Regression test: rotd-2016-05-16 and before incorrectly reported the errors
-% in the foreign_enum pragmas as occurring in foreign_export_enum pragmas.
+% Test for various syntax errors in 'foreign_enum' pragmas.
+% This is also a regression test for a problem in rotd-2016-05-16 and before
+% where errors occurring in 'foreign_enum' pragmas were incorrectly reported
+% as occurring in 'foreign_export_enum' pragmas.

  :- module bad_foreign_enum.
  :- interface.
@@ -17,6 +19,24 @@
      --->   pear
      ;      grapefruit.

+:- type vegetable
+    --->   carrot
+    ;      potato
+    ;      turnip.
+
+:- type meat
+    --->    beef
+    ;       lamb
+    ;       pork.
+
+:- type poultry
+    --->    chicken
+    ;       duck.
+
+:- type more_poultry
+    --->    goose
+    ;       turkey.
+
  :- implementation.

      % Wrong number of arguments.
@@ -25,4 +45,39 @@

      % Invalid foreign language.
      %
-:- pragma foreign_enum("UnsupportedLanguage", more_fruit/0, []).
+:- pragma foreign_enum("InvalidLanguage", more_fruit/0, []).
+
+    % Second arg is not name / arity.
+    %
+:- pragma foreign_enum("C", vegetable,
+    [carrot - "1", potato - "2", turnip - "3"]).
+
+    % Check that multiple errors are reported and that the correct
+    % contexts are attached to them.
+    %
+:- pragma foreign_enum(
+    "InvalidLanguage",
+    meat,
+    []
+).
+
+    % Check for invalid elements in the mapping list.
+    %
+:- pragma foreign_enum("C", poultry/0, [
+     chicken,
+     duck - "2"
+]).
+
+    % Ditto.
+    %
+:- pragma foreign_enum("C", more_poultry/0, [
+     "goose" - "1",
+     turkey - "561"
+]).
+
+% XXX TODO: we should generate more specific error messages in cases
+% like the following:
+%:- pragma foreign_enum("C", more_poultry/0, [
+%     goose - "",
+%     turkey - 562
+%]).
diff --git a/tests/invalid/foreign_enum_invalid.err_exp b/tests/invalid/foreign_enum_invalid.err_exp
index 9b4a8ff..958ddf9 100644
--- a/tests/invalid/foreign_enum_invalid.err_exp
+++ b/tests/invalid/foreign_enum_invalid.err_exp
@@ -1,26 +1,18 @@
-foreign_enum_invalid.m:026: Error: `:- pragma foreign_enum' declaration for
-foreign_enum_invalid.m:026:   `foreign_enum_invalid.in_int'/0 in module
-foreign_enum_invalid.m:026:   interface.
+foreign_enum_invalid.m:021: Error: `:- pragma foreign_enum' declaration for
+foreign_enum_invalid.m:021:   `foreign_enum_invalid.in_int'/0 in module
+foreign_enum_invalid.m:021:   interface.
+foreign_enum_invalid.m:027: In `:- pragma foreign_enum' declaration for
+foreign_enum_invalid.m:027:   `foreign_enum_invalid.incomplete'/0:
+foreign_enum_invalid.m:027:   error: not all constructors have a foreign value.
+foreign_enum_invalid.m:027:   The following constructor does not have a foreign
+foreign_enum_invalid.m:027:   value
+foreign_enum_invalid.m:027:       `foreign_enum_invalid.baz'
  foreign_enum_invalid.m:032: In `:- pragma foreign_enum' declaration for
-foreign_enum_invalid.m:032:   `foreign_enum_invalid.incomplete'/0:
-foreign_enum_invalid.m:032:   error: not all constructors have a foreign value.
-foreign_enum_invalid.m:032:   The following constructor does not have a foreign
-foreign_enum_invalid.m:032:   value
-foreign_enum_invalid.m:032:       `foreign_enum_invalid.baz'
-foreign_enum_invalid.m:037: In `:- pragma foreign_enum' declaration for
-foreign_enum_invalid.m:037:   `foreign_enum_invalid.incomplete2'/0:
-foreign_enum_invalid.m:037:   error: not all constructors have a foreign value.
-foreign_enum_invalid.m:037:   The following constructors do not have foreign
-foreign_enum_invalid.m:037:   values
-foreign_enum_invalid.m:037:       `foreign_enum_invalid.bar2',
-foreign_enum_invalid.m:037:       `foreign_enum_invalid.baz2',
-foreign_enum_invalid.m:037:       `foreign_enum_invalid.foo2'
-foreign_enum_invalid.m:039: In `:- pragma foreign_enum' declaration for
-foreign_enum_invalid.m:039:   `foreign_enum_invalid.not_a_bijection'/0:
-foreign_enum_invalid.m:039:   error: the mapping between Mercury enumeration
-foreign_enum_invalid.m:039:   values and foreign values does not form a
-foreign_enum_invalid.m:039:   bijection.
-foreign_enum_invalid.m:047: In `:- pragma foreign_enum' declaration for
-foreign_enum_invalid.m:047:   `foreign_enum_invalid.dup_foreign_enum'/0:
-foreign_enum_invalid.m:047:   error: `foreign_enum_invalid.dup_foreign_enum'/0
-foreign_enum_invalid.m:047:   has multiple foreign_enum pragmas.
+foreign_enum_invalid.m:032:   `foreign_enum_invalid.not_a_bijection'/0:
+foreign_enum_invalid.m:032:   error: the mapping between Mercury enumeration
+foreign_enum_invalid.m:032:   values and foreign values does not form a
+foreign_enum_invalid.m:032:   bijection.
+foreign_enum_invalid.m:040: In `:- pragma foreign_enum' declaration for
+foreign_enum_invalid.m:040:   `foreign_enum_invalid.dup_foreign_enum'/0:
+foreign_enum_invalid.m:040:   error: `foreign_enum_invalid.dup_foreign_enum'/0
+foreign_enum_invalid.m:040:   has multiple foreign_enum pragmas.
diff --git a/tests/invalid/foreign_enum_invalid.m b/tests/invalid/foreign_enum_invalid.m
index 63f1a8e..d1de536 100644
--- a/tests/invalid/foreign_enum_invalid.m
+++ b/tests/invalid/foreign_enum_invalid.m
@@ -10,11 +10,6 @@
      ;       bar
      ;       baz.

-:- type incomplete2
-    --->    foo2
-    ;       bar2
-    ;       baz2.
-
  :- type not_a_bijection
      --->    a
      ;       b
@@ -34,8 +29,6 @@
      bar - "4"
  ]).

-:- pragma foreign_enum("C", incomplete2/0, []).
-
  :- pragma foreign_enum("C", not_a_bijection/0, [
      a - "30",
      a - "40",
diff --git a/tests/invalid/invalid_pragma.err_exp b/tests/invalid/invalid_pragma.err_exp
new file mode 100644
index 0000000..6a9fe32
--- /dev/null
+++ b/tests/invalid/invalid_pragma.err_exp
@@ -0,0 +1,2 @@
+invalid_pragma.m:006: Error: a `:- pragma' declaration should have the form
+invalid_pragma.m:006:   `:- pragma pragma_name(pragma_arguments).'
diff --git a/tests/invalid/invalid_pragma.m b/tests/invalid/invalid_pragma.m
new file mode 100644
index 0000000..20b7dec
--- /dev/null
+++ b/tests/invalid/invalid_pragma.m
@@ -0,0 +1,6 @@
+% Test error message for misformed pragam declaration.
+
+:- module invalid_pragma.
+:- interface.
+:- type foo == int.
+:- pragma 1235.
diff --git a/tests/invalid/unrecognized_pragma.err_exp b/tests/invalid/unrecognized_pragma.err_exp
new file mode 100644
index 0000000..53a1712
--- /dev/null
+++ b/tests/invalid/unrecognized_pragma.err_exp
@@ -0,0 +1,2 @@
+unrecognized_pragma.m:008: Error: `not_a_pragma' is not a recognized pragma
+unrecognized_pragma.m:008:   name.
diff --git a/tests/invalid/unrecognized_pragma.m b/tests/invalid/unrecognized_pragma.m
new file mode 100644
index 0000000..f9dfb0e
--- /dev/null
+++ b/tests/invalid/unrecognized_pragma.m
@@ -0,0 +1,8 @@
+% Test the error message we generate for unrecognized pragmas.
+
+:- module unrecognized_pragma.
+:- interface.
+
+:- type foo == int.
+
+:- pragma not_a_pragma([]).


More information about the reviews mailing list