merge revisions 13898-13899:

 - compiler: allow message after the *deprecated* keyword
 - compiler: raise an internal error if deprecated message is trying to set to a non clear string pointer

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@13997 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 21 insertions, 11 deletions

diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas
index 5e6c4e767c..99a36c8a2b 100644
--- a/compiler/pdecl.pas
+++ b/compiler/pdecl.pas
@@ -160,6 +160,7 @@ implementation
          hdef : tdef;
          sym : tsym;
          dummysymoptions : tsymoptions;
+         deprecatedmsg : pshortstring;
          storetokenpos,filepos : tfileposinfo;
          old_block_type : tblock_type;
          skipequal : boolean;
@@ -181,12 +182,16 @@ implementation
                    sym:=readconstant(orgname,filepos);
                    { Support hint directives }
                    dummysymoptions:=[];
-                   try_consume_hintdirective(dummysymoptions);
+                   deprecatedmsg:=nil;
+                   try_consume_hintdirective(dummysymoptions,deprecatedmsg);
                    if assigned(sym) then
                      begin
                        sym.symoptions:=sym.symoptions+dummysymoptions;
+                       sym.deprecatedmsg:=deprecatedmsg;
                        symtablestack.top.insert(sym);
-                     end;
+                     end
+                   else
+                     stringdispose(deprecatedmsg);
                    consume(_SEMICOLON);
                 end;
 
@@ -439,7 +444,7 @@ implementation
               case hdef.typ of
                 pointerdef :
                   begin
-                    try_consume_hintdirective(newtype.symoptions);
+                    try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
                     consume(_SEMICOLON);
                     if try_to_consume(_FAR) then
                      begin
@@ -452,19 +457,19 @@ implementation
                     { in case of type renaming, don't parse proc directives }
                     if istyperenaming then
                       begin
-                        try_consume_hintdirective(newtype.symoptions);
+                        try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
                         consume(_SEMICOLON);
                       end
                     else
                      begin
                        if not check_proc_directive(true) then
                          begin
-                           try_consume_hintdirective(newtype.symoptions);
+                           try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
                            consume(_SEMICOLON);
                          end;
                        parse_var_proc_directives(tsym(newtype));
                        handle_calling_convention(tprocvardef(hdef));
-                       if try_consume_hintdirective(newtype.symoptions) then
+                       if try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg) then
                          consume(_SEMICOLON);
                      end;
                   end;
@@ -479,17 +484,17 @@ implementation
                         vmtbuilder.generate_vmt;
                         vmtbuilder.free;
                       end;
-                    try_consume_hintdirective(newtype.symoptions);
+                    try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
                     consume(_SEMICOLON);
                   end;
                 recorddef :
                   begin
-                    try_consume_hintdirective(newtype.symoptions);
+                    try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
                     consume(_SEMICOLON);
                   end;
                 else
                   begin
-                    try_consume_hintdirective(newtype.symoptions);
+                    try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
                     consume(_SEMICOLON);
                   end;
               end;
@@ -564,6 +569,7 @@ implementation
          orgname : TIDString;
          p : tnode;
          dummysymoptions : tsymoptions;
+         deprecatedmsg : pshortstring;
          storetokenpos,filepos : tfileposinfo;
          old_block_type : tblock_type;
          sp : pchar;
@@ -612,12 +618,16 @@ implementation
                    current_tokenpos:=storetokenpos;
                    { Support hint directives }
                    dummysymoptions:=[];
-                   try_consume_hintdirective(dummysymoptions);
+                   deprecatedmsg:=nil;
+                   try_consume_hintdirective(dummysymoptions,deprecatedmsg);
                    if assigned(sym) then
                      begin
                        sym.symoptions:=sym.symoptions+dummysymoptions;
+                       sym.deprecatedmsg:=deprecatedmsg;
                        symtablestack.top.insert(sym);
-                     end;
+                     end
+                   else
+                     stringdispose(deprecatedmsg);
                    consume(_SEMICOLON);
                    p.free;
                 end;