compiler:

  * don't allow to apply the same hint directive twice
  * change parser_e_proc_dir_not_allowed to more generic variant parser_e_dir_not_allowed - they are similar and 'procedure' prefix does not give more information about the error.
  * maybe_parse_hint_directives() uses procdef settings for initial values
  + add tests

git-svn-id: trunk@25720 -

.gitattributes

@@ -11324,6 +11324,8 @@ tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
 tests/test/thintdir.pp svneol=native#text/plain
 tests/test/thintdir1.pp svneol=native#text/pascal
+tests/test/thintdir2a.pp svneol=native#text/pascal
+tests/test/thintdir2b.pp svneol=native#text/pascal
 tests/test/thlp1.pp svneol=native#text/pascal
 tests/test/thlp10.pp svneol=native#text/pascal
 tests/test/thlp11.pp svneol=native#text/pascal

compiler/msg/errord.msg

@@ -1504,8 +1504,8 @@ parser_e_not_allowed_in_record=03332_E_Sichtbarkeits-Abschnitt "$1" ist in Recor
 % The visibility sections \var(protected) and \var(strict protected) are only
 % useful together with inheritance. Since records do not support that they are
 % forbidden.
-parser_e_proc_dir_not_allowed=03333_E_Prozedurdirektive "$1" ist hier nicht erlaubt
-% This procedure directive is not allowed in the given context. E.g. "static"
+parser_e_dir_not_allowed=03333_E_Direktive "$1" ist hier nicht erlaubt
+% This directive is not allowed in the given context. E.g. "static"
 % is not allowed for instance methods or class operators.
 parser_e_no_assembler_in_generic=03334_E_Assemblerbl”cke sind innerhalb von "generics" nicht erlaubt
 % The use of assembler blocks/routines is not allowed inside generics.

compiler/msg/errordu.msg

@@ -1504,8 +1504,8 @@ parser_e_not_allowed_in_record=03332_E_Sichtbarkeits-Abschnitt "$1" ist in Recor
 % The visibility sections \var(protected) and \var(strict protected) are only
 % useful together with inheritance. Since records do not support that they are
 % forbidden.
-parser_e_proc_dir_not_allowed=03333_E_Prozedurdirektive "$1" ist hier nicht erlaubt
-% This procedure directive is not allowed in the given context. E.g. "static"
+parser_e_dir_not_allowed=03333_E_Direktive "$1" ist hier nicht erlaubt
+% This directive is not allowed in the given context. E.g. "static"
 % is not allowed for instance methods or class operators.
 parser_e_no_assembler_in_generic=03334_E_Assemblerblöcke sind innerhalb von "generics" nicht erlaubt
 % The use of assembler blocks/routines is not allowed inside generics.

compiler/msg/errore.msg

@@ -1493,8 +1493,8 @@ parser_e_not_allowed_in_record=03332_E_Visibility section "$1" not allowed in re
 % The visibility sections \var(protected) and \var(strict protected) are only
 % useful together with inheritance. Since records do not support that they are
 % forbidden.
-parser_e_proc_dir_not_allowed=03333_E_Procedure directive "$1" not allowed here
-% This procedure directive is not allowed in the given context. E.g. "static"
+parser_e_dir_not_allowed=03333_E_Directive "$1" not allowed here
+% This directive is not allowed in the given context. E.g. "static"
 % is not allowed for instance methods or class operators.
 parser_e_no_assembler_in_generic=03334_E_Assembler blocks not allowed inside generics
 % The use of assembler blocks/routines is not allowed inside generics.

compiler/msgidx.inc

@@ -430,7 +430,7 @@ const
   parser_e_no_properties_in_local_anonymous_records=03330;
   parser_e_no_class_in_local_anonymous_records=03331;
   parser_e_not_allowed_in_record=03332;
-  parser_e_proc_dir_not_allowed=03333;
+  parser_e_dir_not_allowed=03333;
   parser_e_no_assembler_in_generic=03334;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
@@ -977,7 +977,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 70086;
+  MsgTxtSize = 70076;
 
   MsgIdxMax : array[1..20] of longint=(
     26,95,335,121,88,56,126,27,202,64,

compiler/pbase.pas

@@ -343,34 +343,49 @@ implementation
       begin
         try_consume_hintdirective:=false;
         if not(m_hintdirective in current_settings.modeswitches) then
-         exit;
+          exit;
         repeat
           last_is_deprecated:=false;
           case idtoken of
-            _LIBRARY :
+            _LIBRARY:
               begin
-                include(symopt,sp_hint_library);
+                if sp_hint_library in symopt then
+                  Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
+                else
+                  include(symopt,sp_hint_library);
                 try_consume_hintdirective:=true;
               end;
-            _DEPRECATED :
+            _DEPRECATED:
               begin
-                include(symopt,sp_hint_deprecated);
+                if sp_hint_deprecated in symopt then
+                  Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
+                else
+                  include(symopt,sp_hint_deprecated);
                 try_consume_hintdirective:=true;
                 last_is_deprecated:=true;
               end;
-            _EXPERIMENTAL :
+            _EXPERIMENTAL:
               begin
-                include(symopt,sp_hint_experimental);
+                if sp_hint_experimental in symopt then
+                  Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
+                else
+                  include(symopt,sp_hint_experimental);
                 try_consume_hintdirective:=true;
               end;
-            _PLATFORM :
+            _PLATFORM:
               begin
-                include(symopt,sp_hint_platform);
+                if sp_hint_platform in symopt then
+                  Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
+                else
+                  include(symopt,sp_hint_platform);
                 try_consume_hintdirective:=true;
               end;
-            _UNIMPLEMENTED :
+            _UNIMPLEMENTED:
               begin
-                include(symopt,sp_hint_unimplemented);
+                if sp_hint_unimplemented in symopt then
+                  Message1(parser_e_dir_not_allowed,arraytokeninfo[idtoken].str)
+                else
+                  include(symopt,sp_hint_unimplemented);
                 try_consume_hintdirective:=true;
               end;
             else
@@ -380,12 +395,13 @@ implementation
           { handle deprecated message }
           if ((token=_CSTRING) or (token=_CCHAR)) and last_is_deprecated then
             begin
-              if deprecatedmsg<>nil then
-                internalerror(200910181);
-              if token=_CSTRING then
-                deprecatedmsg:=stringdup(cstringpattern)
-              else
-                deprecatedmsg:=stringdup(pattern);
+              if not assigned(deprecatedmsg) then
+                begin
+                  if token=_CSTRING then
+                    deprecatedmsg:=stringdup(cstringpattern)
+                  else
+                    deprecatedmsg:=stringdup(pattern);
+                end;
               consume(token);
               include(symopt,sp_has_deprecated_msg);
             end;

compiler/pdecsub.pas

@@ -1639,7 +1639,7 @@ begin
         not is_object(tprocdef(pd).struct)
       )
       then
-    Message1(parser_e_proc_dir_not_allowed,arraytokeninfo[_STATIC].str);
+    Message1(parser_e_dir_not_allowed,arraytokeninfo[_STATIC].str);
   include(pd.procoptions,po_staticmethod);
 end;
 

compiler/ptype.pas

@@ -96,10 +96,18 @@ implementation
         dummysymoptions : tsymoptions;
         deprecatedmsg : pshortstring;
       begin
-        dummysymoptions:=[];
-        deprecatedmsg:=nil;
+        if assigned(pd) then
+          begin
+            dummysymoptions:=pd.symoptions;
+            deprecatedmsg:=pd.deprecatedmsg;
+          end
+        else
+          begin
+            dummysymoptions:=[];
+            deprecatedmsg:=nil;
+          end;
         while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do
-          Consume(_SEMICOLON);
+          consume(_SEMICOLON);
         if assigned(pd) then
           begin
             pd.symoptions:=pd.symoptions+dummysymoptions;

tests/test/thintdir.pp

@@ -1,4 +1,5 @@
 { %version=1.1 }
+{ %NORUN }
 
 program thintdir;
 

tests/test/thintdir1.pp

@@ -1,3 +1,4 @@
+{ %NORUN }
 program thintdir1;
 
 // test the possibility to use the hint modifiers as regular identifiers

tests/test/thintdir2a.pp

@@ -0,0 +1,11 @@
+{ %FAIL }
+{ %NORUN }
+program thintdir2a;
+
+// don't allow to use hint modifier twice
+
+{$mode delphi}
+const
+  Test = 1 deprecated 'Do not use this const' deprecated 'Use that const';
+begin
+end.                      

tests/test/thintdir2b.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+{ %NORUN }
+program thintdir2b;
+
+// don't allow to use hint modifier twice
+
+{$mode delphi}
+type
+  TTest = class(TObject)
+  public
+    procedure Test(); virtual; deprecated 'Do not use this method'; abstract; deprecated 'Use that method';
+  end;
+begin
+end.