* patch by J. Gareth Moreton: clarity in directive conflict error messages, resolves #33754

git-svn-id: trunk@39407 -

.gitattributes

@@ -187,7 +187,7 @@ compiler/generic/cpuinfo.pas svneol=native#text/plain
 compiler/generic/symcpu.pas svneol=native#text/plain
 compiler/globals.pas -text svneol=native#text/plain
 compiler/globstat.pas svneol=native#text/pascal
-compiler/globtype.pas -text svneol=native#text/plain
+compiler/globtype.pas svneol=native#text/plain
 compiler/hlcg2ll.pas svneol=native#text/plain
 compiler/hlcgobj.pas svneol=native#text/plain
 compiler/html/i386/readme.txt svneol=native#text/plain

compiler/globtype.pas

@@ -444,8 +444,8 @@ interface
          m_blocks,              { support for http://en.wikipedia.org/wiki/Blocks_(C_language_extension) }
          m_isolike_io,          { I/O as it required by an ISO compatible compiler }
          m_isolike_program_para, { program parameters as it required by an ISO compatible compiler }
-         m_isolike_mod,         { mod operation as it is required by an iso compatible compiler }
-         m_array_operators      { use Delphi compatible array operators instead of custom ones ("+") }
+         m_isolike_mod,         { mod operation as it is required by an iso compatible compiler }
+         m_array_operators      { use Delphi compatible array operators instead of custom ones ("+") }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -577,7 +577,7 @@ interface
            'Interrupt',
            'HardFloat',
            'SysV_ABI_Default',
-           'MS_ABI_CDecl', { TODO: Is this correct? Shouldn't it be SysV_ABI_Default }
+           'SysV_ABI_CDecl',
            'MS_ABI_Default',
            'MS_ABI_CDecl',
            'VectorCall'
@@ -633,8 +633,8 @@ interface
          'CBLOCKS',
          'ISOIO',
          'ISOPROGRAMPARAS',
-         'ISOMOD',
-         'ARRAYOPERATORS'
+         'ISOMOD',
+         'ARRAYOPERATORS'
          );
 
 

compiler/msg/errore.msg

@@ -842,7 +842,7 @@ parser_f_assembler_reader_not_supported=03127_F_Selected assembler reader not su
 % The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not
 % supported. The compiler can be compiled with or without support for a
 % particular assembler reader.
-parser_e_proc_dir_conflict=03128_E_Procedure directive "$1" has conflicts with other directives
+parser_e_proc_dir_conflict=03128_E_Procedure directive "$1" cannot be used with $2
 % You specified a procedure directive that conflicts with other directives.
 % For instance \var{cdecl} and \var{pascal} are mutually exclusive.
 parser_e_call_convention_dont_match_forward=03129_E_Calling convention doesn't match forward

compiler/msgidx.inc

@@ -1103,7 +1103,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 82423;
+  MsgTxtSize = 82410;
 
   MsgIdxMax : array[1..20] of longint=(
     28,106,349,126,96,59,142,34,221,67,

compiler/pdecsub.pas

@@ -128,6 +128,25 @@ implementation
         Declaring it as string here results in an error when compiling (PFV) }
       current_procinfo = 'error';
 
+    { get_first_proc_str - returns the token string of the first option that
+      appears in the list }
+    function get_first_proc_str(Options: TProcOptions): ShortString;
+      var
+        X: TProcOption;
+      begin
+        if Options = [] then
+          InternalError(2018051700);
+
+        get_first_proc_str := '';
+
+        for X := Low(TProcOption) to High(TProcOption) do
+          if X in Options then
+            begin
+              get_first_proc_str := ProcOptionKeywords[X];
+              Exit;
+            end;
+      end;
+
     function push_child_hierarchy(obj:tabstractrecorddef):integer;
       var
         _class,hp : tobjectdef;
@@ -1922,7 +1941,7 @@ begin
   if (not assigned(pd.owner.defowner) or
       not is_java_class_or_interface(tdef(pd.owner.defowner))) and
      (po_external in pd.procoptions) then
-    Message1(parser_e_proc_dir_conflict,'EXTERNAL');
+    Message2(parser_e_proc_dir_conflict,'EXTERNAL','"VIRTUAL"');
 
   if pd.typ<>procdef then
     internalerror(2003042610);
@@ -2007,7 +2026,7 @@ begin
           not is_objc_class_or_protocol(tprocdef(pd).struct) and
           not is_cppclass(tprocdef(pd).struct) and
           not is_java_class_or_interface(tprocdef(pd).struct) then
-    Message1(parser_e_proc_dir_conflict,'OVERRIDE');
+    Message2(parser_e_proc_dir_conflict,'OVERRIDE','"EXTERNAL"');
 end;
 
 procedure pd_overload(pd:tabstractprocdef);
@@ -2039,7 +2058,7 @@ begin
   if not is_objc_class_or_protocol(tprocdef(pd).struct) then
     begin
       if po_external in pd.procoptions then
-        Message1(parser_e_proc_dir_conflict,'MESSAGE');
+        Message2(parser_e_proc_dir_conflict,'MESSAGE','"EXTERNAL"');
       paracnt:=0;
       pd.parast.SymList.ForEachCall(@check_msg_para,@paracnt);
       if paracnt<>1 then
@@ -2899,7 +2918,10 @@ const
       }
       var
         p     : longint;
-        name  : TIDString;
+        name,
+        other : TIDString;
+        po_comp : tprocoptions;
+        tokenloc : TFilePosInfo;
       begin
         parse_proc_direc:=false;
         name:=tokeninfo^[idtoken].str;
@@ -2919,7 +2941,6 @@ const
                    { could the new token still be a directive? }
                    if token<>_ID then
                      exit;
-                   name:=tokeninfo^[idtoken].str;
                  end
                else
                  exit;
@@ -2970,28 +2991,46 @@ const
            is_javainterface(tdef(symtablestack.top.defowner)) then
           exit;
 
-        { Conflicts between directives ? }
-        if (pd.proctypeoption in proc_direcdata[p].mutexclpotype) or
-           (pd.proccalloption in proc_direcdata[p].mutexclpocall) or
-           ((pd.procoptions*proc_direcdata[p].mutexclpo)<>[]) then
-         begin
-           Message1(parser_e_proc_dir_conflict,name);
-           exit;
-         end;
+        { Keep track of the token's position in the file so it's correctly indicated if an error occurs. }
+        tokenloc := current_tokenpos;
+
+        { consume directive, and turn flag on }
+        consume(token);
+        parse_proc_direc:=true;
+
+        { Conflicts between directives? }
+        if (pd.proctypeoption in proc_direcdata[p].mutexclpotype) then
+          begin
+            MessagePos2(tokenloc, parser_e_proc_dir_conflict,name,ProcTypeOptionKeywords[pd.proctypeoption]);
+            exit;
+          end;
+
+        if (pd.proccalloption in proc_direcdata[p].mutexclpocall) then
+          begin
+            MessagePos2(tokenloc, parser_e_proc_dir_conflict,name,'"' + UpCase(proccalloptionStr[pd.proccalloption]) + '"');
+            exit;
+          end;
+
+        po_comp := (pd.procoptions*proc_direcdata[p].mutexclpo);
+        if (po_comp<>[]) then
+          begin
+            MessagePos2(tokenloc, parser_e_proc_dir_conflict,name,get_first_proc_str(po_comp));
+            exit;
+          end;
 
         { set calling convention }
         if proc_direcdata[p].pocall<>pocall_none then
          begin
            if (po_hascallingconvention in pd.procoptions) then
             begin
-              Message2(parser_w_proc_overriding_calling,
+              MessagePos2(tokenloc, parser_w_proc_overriding_calling,
                 proccalloptionStr[pd.proccalloption],
                 proccalloptionStr[proc_direcdata[p].pocall]);
             end;
            { check if the target processor supports this calling convention }
            if not(proc_direcdata[p].pocall in supported_calling_conventions) then
              begin
-               Message1(parser_e_illegal_calling_convention,proccalloptionStr[proc_direcdata[p].pocall]);
+               MessagePos1(tokenloc, parser_e_illegal_calling_convention,proccalloptionStr[proc_direcdata[p].pocall]);
                { recover }
                proc_direcdata[p].pocall:=pocall_stdcall;
              end;
@@ -3034,29 +3073,26 @@ const
            { check if method and directive not for record/class helper }
            if is_objectpascal_helper(tprocdef(pd).struct) and
              (pd_nothelper in proc_direcdata[p].pd_flags) then
+              { TODO: Missing exit? [Kit] }
          end;
 
-        { consume directive, and turn flag on }
-        consume(token);
-        parse_proc_direc:=true;
-
         { Check the pd_flags if the directive should be allowed }
         if (pd_interface in pdflags) and
            not(pd_interface in proc_direcdata[p].pd_flags) then
           begin
-            Message1(parser_e_proc_dir_not_allowed_in_interface,name);
+            MessagePos1(tokenloc, parser_e_proc_dir_not_allowed_in_interface,name);
             exit;
           end;
         if (pd_implemen in pdflags) and
            not(pd_implemen in proc_direcdata[p].pd_flags) then
           begin
-            Message1(parser_e_proc_dir_not_allowed_in_implementation,name);
+            MessagePos1(tokenloc, parser_e_proc_dir_not_allowed_in_implementation,name);
             exit;
           end;
         if (pd_procvar in pdflags) and
            not(pd_procvar in proc_direcdata[p].pd_flags) then
           begin
-            Message1(parser_e_proc_dir_not_allowed_in_procvar,name);
+            MessagePos1(tokenloc, parser_e_proc_dir_not_allowed_in_procvar,name);
             exit;
           end;
 
@@ -3725,8 +3761,9 @@ const
                            if virtualdirinfo=-1 then
                              internalerror(2018010101);
                          end;
-                       if (proc_direcdata[virtualdirinfo].mutexclpo * currpd.procoptions)<>[] then
-                         MessagePos1(currpd.fileinfo,parser_e_proc_dir_conflict,tokeninfo^[_VIRTUAL].str);
+                       po_comp := (proc_direcdata[virtualdirinfo].mutexclpo * currpd.procoptions);
+                       if po_comp<>[] then
+                         MessagePos2(currpd.fileinfo,parser_e_proc_dir_conflict,tokeninfo^[_VIRTUAL].str,get_first_proc_str(po_comp));
                      end;
                     { Check parameters }
                    if (m_repeat_forward in current_settings.modeswitches) or

compiler/symconst.pas

@@ -940,6 +940,88 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
       { suffix for indirect symbols (AB_INDIRECT) }
       suffix_indirect = '$indirect';
 
+    { TProcTypeOption string identifiers for error messsages }
+    ProcTypeOptionKeywords: array[tproctypeoption] of ShortString = (
+      'potype_none',        {potype_none}
+      'program initialization',{potype_proginit}
+      '"INITIALIZATION"',   {potype_unitinit}
+      '"FINALIZATION"',     {potype_unitfinalize}
+      '"CONSTRUCTOR"',      {potype_constructor}
+      '"DESTRUCTOR"',       {potype_destructor}
+      '"OPERATOR"',         {potype_operator}
+      '"PROCEDURE"',        {potype_procedure}
+      '"FUNCTION"',         {potype_function}
+      '"CLASS CONSTRUCTOR"',{potype_class_constructor}
+      '"CLASS DESTRUCTOR"', {potype_class_destructor}
+      'property getters',   {potype_propgetter}
+      'property setters',   {potype_propsetter}
+      'exception filters',  {potype_exceptfilter}
+      '"main" stub',        {potype_mainstub}
+      'package stub'        {potype_pkgstub}
+    );
+
+    { TProcOption string identifiers for error messages }
+    ProcOptionKeywords: array[tprocoption] of ShortString = (
+      'po_none',            {po_none}
+      '"CLASS"',            {po_classmethod}
+      '"VIRTUAL"',          {po_virtualmethod}
+      '"ABSTRACT"',         {po_abstractmethod}
+      '"FINAL"',            {po_finalmethod}
+      '"STATIC"',           {po_staticmethod}
+      '"OVERRIDE"',         {po_overridingmethod}
+      'method pointers',    {po_methodpointer}
+      '"INTERRUPT"',        {po_interrupt}
+      'po_iocheck',         {po_iocheck}
+      '"ASSEMBLER"',        {po_assembler}
+      '"MESSAGE"',          {po_msgstr}
+      '"MESSAGE"',          {po_msgint}
+      '"EXPORT"',           {po_exports}
+      '"EXTERNAL"',         {po_external}
+      '"OVERLOAD"',         {po_overload}
+      'variable argument lists',{po_varargs}
+      'po_internconst',     {po_internconst}
+      'po_addressonly',     {po_addressonly}
+      '"PUBLIC"',           {po_public}
+      'po_hascallingconvention',{po_hascallingconvention}
+      '"REINTRODUCE"',      {po_reintroduce}
+      'po_explicitparaloc', {po_explicitparaloc}
+      '"NOSTACKFRAME"',     {po_nostackframe}
+      'po_has_mangledname', {po_has_mangledname}
+      'po_has_public_name', {po_has_public_name}
+      '"FORWARD"',          {po_forward}
+      'global routines',    {po_global}
+      '"SYSCALL"',          {po_syscall}
+      '"SYSCALL"',          {po_syscall_legacy}
+      '"SYSCALL"',          {po_syscall_basenone}
+      '"SYSCALL"',          {po_syscall_basefirst}
+      '"SYSCALL"',          {po_syscall_baselast}
+      '"SYSCALL"',          {po_syscall_basereg}
+      '"SYSCALL"',          {po_syscall_has_libsym}
+      '"SYSCALL"',          {po_syscall_has_importnr}
+      '"INLINE"',           {po_inline}
+      '"COMPILERPROC"',     {po_compilerproc}
+      'po_has_importdll',   {po_has_importdll}
+      'po_has_importname',  {po_has_importname}
+      'po_kylixlocal',      {po_kylixlocal}
+      '"DISPID"',           {po_dispid}
+      'po_weakexternal',    {po_weakexternal}
+      'po_objc',            {po_objc}
+      'po_enumerator_movenext',{po_enumerator_movenext}
+      'po_optional',        {po_optional}
+      'po_delphi_nested_cc',{po_delphi_nested_cc}
+      'RTL procedures',     {po_rtlproc}
+      'non-virtual Java methods',{po_java_nonvirtual}
+      'po_ignore_for_overload_resolution',{po_ignore_for_overload_resolution}
+      'po_auto_raised_visibility',{po_auto_raised_visibility}
+      '"FAR"',              {po_far}
+      'po_hasnearfarcallmodel',{po_hasnearfarcallmodel}
+      '"NORETURN"',{po_noreturn}
+      'po_is_function_ref',{po_is_function_ref}
+      'C-style blocks',{po_is_block}
+      'po_is_auto_getter',{po_is_auto_getter}
+      'po_is_auto_setter'{po_is_auto_setter}
+    );
+
 implementation
 
 end.