* Added support for export modifier (bug ID 13863)

git-svn-id: trunk@13929 -

packages/fcl-passrc/src/pastree.pp

@@ -76,6 +76,8 @@ type
   TPasMemberVisibility = (visDefault, visPrivate, visProtected, visPublic,
     visPublished, visAutomated);
 
+  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
+
   TPasMemberVisibilities = set of TPasMemberVisibility;
   TPasMemberHint = (hDeprecated,hLibrary,hPlatform);
   TPasMemberHints = set of TPasMemberHint; 
@@ -445,7 +447,19 @@ type
     Overloads: TList;           // List of TPasProcedure nodes
   end;
 
+  TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
+                        pmExported, pmOverload, pmMessage, pmReintroduce,
+                        pmStatic,pmInline,pmAssembler,pmVarargs,
+                        pmCompilerProc,pmExternal,pmExtdecl);
+  TProcedureModifiers = Set of TProcedureModifier;
+  TProcedureMessageType = (pmtInteger,pmtString);
+                        
   TPasProcedure = class(TPasProcedureBase)
+  Private
+    FCallingConvention : TCallingConvention;
+    FModifiers : TProcedureModifiers;
+    FMessageName : String;
+    FMessageType : TProcedureMessageType;
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
@@ -453,9 +467,21 @@ type
     function GetDeclaration(full: Boolean): string; override;
     procedure GetModifiers(List: TStrings);
   public
-    ProcType: TPasProcedureType;
-    IsVirtual, IsDynamic, IsAbstract, IsOverride,
-      IsOverload, IsMessage, isReintroduced, isStatic: Boolean;
+    ProcType : TPasProcedureType;
+    Procedure AddModifier(AModifier : TProcedureModifier);
+    Function IsVirtual : Boolean;
+    Function IsDynamic : Boolean;
+    Function IsAbstract : Boolean;
+    Function IsOverride : Boolean;
+    Function IsExported : Boolean;
+    Function IsOverload : Boolean;
+    Function IsMessage: Boolean;
+    Function IsReintroduced : Boolean;
+    Function IsStatic : Boolean;
+    Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
+    Property CallingConvention : TCallingConvention Read FCallingConvention Write FCallingConvention;
+    Property MessageName : String Read FMessageName Write FMessageName;
+    property MessageType : TProcedureMessageType Read FMessageType Write FMessageType;
   end;
 
   TPasFunction = class(TPasProcedure)
@@ -1557,6 +1583,58 @@ begin
   DoAdd(IsMessage,' Message');
 end;
 
+Procedure TPasProcedure.AddModifier(AModifier : TProcedureModifier);
+
+begin
+  Include(FModifiers,AModifier);
+end;
+
+Function TPasProcedure.IsVirtual : Boolean;
+begin
+  Result:=pmVirtual in FModifiers;
+end;
+
+Function TPasProcedure.IsDynamic : Boolean;
+begin
+  Result:=pmDynamic in FModifiers;
+end;
+
+Function TPasProcedure.IsAbstract : Boolean;
+begin
+  Result:=pmAbstract in FModifiers;
+end;
+
+Function TPasProcedure.IsOverride : Boolean;
+begin
+  Result:=pmOverride in FModifiers;
+end;
+
+Function TPasProcedure.IsExported : Boolean;
+begin
+  Result:=pmExported in FModifiers;
+end;
+
+Function TPasProcedure.IsOverload : Boolean;
+begin
+  Result:=pmOverload in FModifiers;
+end;
+
+Function TPasProcedure.IsMessage: Boolean;
+begin
+  Result:=pmMessage in FModifiers;
+end;
+
+Function TPasProcedure.IsReintroduced : Boolean;
+begin
+  Result:=pmReintroduce in FModifiers;
+end;
+
+Function TPasProcedure.IsStatic : Boolean;
+
+begin
+  Result:=pmStatic in FModifiers;
+end;
+
 function TPasProcedure.GetDeclaration (full : boolean) : string;
 
 Var

packages/fcl-passrc/src/pparser.pp

@@ -1523,73 +1523,77 @@ begin
       Tok:=UpperCase(CurTokenString);
       If (Tok='CDECL') then
         begin
- {       El['calling-conv'] := 'cdecl';}
+        TPasProcedure(Parent).CallingConvention:=ccCDecl;
+        ExpectToken(tkSemicolon);
+        end 
+      else If (Tok='EXPORT') then
+        begin
+        TPasProcedure(Parent).AddModifier(pmExported);
         ExpectToken(tkSemicolon);
         end 
       else if (Tok='PASCAL') then
         begin
-{        El['calling-conv'] := 'pascal';}
+        TPasProcedure(Parent).CallingConvention:=ccPascal;
         ExpectToken(tkSemicolon);
         end 
       else if (Tok='STDCALL') then
         begin
-{        El['calling-conv'] := 'stdcall';}
+        TPasProcedure(Parent).CallingConvention:=ccStdCall;
         ExpectToken(tkSemicolon);
         end 
       else if (Tok='OLDFPCCALL') then
         begin
-{        El['calling-conv'] := 'oldfpccall';}
+        TPasProcedure(Parent).CallingConvention:=ccOldFPCCall;
         ExpectToken(tkSemicolon);
         end 
       else if (Tok='EXTDECL') then
         begin
-{        El['calling-conv'] := 'extdecl';}
+        TPasProcedure(Parent).AddModifier(pmExternal);
         ExpectToken(tkSemicolon);
         end 
       else if (Tok='REGISTER') then
         begin
-{        El['calling-conv'] := 'register';}
+        TPasProcedure(Parent).CallingConvention:=ccRegister;
         ExpectToken(tkSemicolon);
         end 
       else if (Tok='COMPILERPROC') then
         begin
-{      El['calling-conv'] := 'compilerproc';}
+        TPasProcedure(Parent).AddModifier(pmCompilerProc);
         ExpectToken(tkSemicolon);
         end
       else if (Tok='VARARGS') then
         begin
-{      'varargs': needs CDECL & EXTERNAL }
+        TPasProcedure(Parent).AddModifier(pmVarArgs);
         ExpectToken(tkSemicolon);
         end
       else if (tok='DEPRECATED') then  
         begin
-{       El['calling-conv'] := 'deprecated';}
         element.hints:=element.hints+[hDeprecated];
         ExpectToken(tkSemicolon);
         end
       else if (tok='PLATFORM') then  
         begin
-{       El['calling-conv'] := 'deprecated';}
         element.hints:=element.hints+[hPlatform];
         ExpectToken(tkSemicolon);
         end
       else if (tok='LIBRARY') then  
         begin
-{       El['calling-conv'] := 'deprecated';}
         element.hints:=element.hints+[hLibrary];
         ExpectToken(tkSemicolon);
         end
       else if (tok='OVERLOAD') then
         begin
-        TPasProcedure(Parent).IsOverload := True;
+        TPasProcedure(Parent).AddModifier(pmOverload);
         ExpectToken(tkSemicolon);
         end 
       else if (tok='INLINE') then
         begin
+        TPasProcedure(Parent).AddModifier(pmInline);
         ExpectToken(tkSemicolon);
         end 
       else if (tok='ASSEMBLER') then
         begin
+        TPasProcedure(Parent).AddModifier(pmAssembler);
         ExpectToken(tkSemicolon);
         end 
       else if (tok = 'EXTERNAL') then  
@@ -1621,7 +1625,8 @@ begin
       end  
     else if (CurToken = tkInline) then
       begin
-{      TPasProcedure(Parent).IsInline := True;}
+      if Parent is TPasProcedure then
+        TPasProcedure(Parent).AddModifier(pmInline);
       ExpectToken(tkSemicolon);
       end 
     else if (CurToken = tkSquaredBraceOpen) then
@@ -2018,38 +2023,46 @@ var
       begin
         s := UpperCase(CurTokenString);
         if s = 'VIRTUAL' then
-          Proc.IsVirtual := True
+          Proc.AddModifier(pmVirtual)
         else if s = 'DYNAMIC' then
-          Proc.IsDynamic := True
+          Proc.AddModifier(pmDynamic)
         else if s = 'ABSTRACT' then
-          Proc.IsAbstract := True
+          Proc.AddModifier(pmAbstract)
         else if s = 'OVERRIDE' then
-          Proc.IsOverride := True
+          Proc.AddModifier(pmOverride)
         else if s = 'REINTRODUCE' then
-          Proc.IsReintroduced := True
+          Proc.AddModifier(pmReintroduce)
         else if s = 'OVERLOAD' then
-          Proc.IsOverload := True
+          Proc.AddModifier(pmOverload)
         else if s = 'STATIC' then
-          Proc.IsStatic := True
+          Proc.AddModifier(pmStatic)
         else if s = 'MESSAGE' then begin
-          Proc.IsMessage := True;
+          Proc.AddModifier(pmMessage);
           repeat
             NextToken;
+            If CurToken<>tkSemicolon then
+              begin
+              Proc.MessageName:=CurtokenString;
+              If (CurToken=tkString) then
+                Proc.Messagetype:=pmtString;
+              end;  
           until CurToken = tkSemicolon;
           UngetToken;
         end 
 	else if s = 'CDECL' then
-{      El['calling-conv'] := 'cdecl';}
+	  Proc.CallingConvention:=ccCDecl
 	else if s = 'PASCAL' then
-{      El['calling-conv'] := 'cdecl';}
+	  Proc.CallingConvention:=ccPascal
         else if s = 'STDCALL' then
-{      El['calling-conv'] := 'stdcall';}
+          Proc.CallingConvention:=ccStdCall
         else if s = 'OLDFPCCALL' then
-{      El['calling-conv'] := 'oldfpccall';}
+          Proc.CallingConvention:=ccOldFPCCall
         else if s = 'EXTDECL' then
-{      El['calling-conv'] := 'extdecl';}
+          Proc.AddModifier(pmExtdecl)
         else if s = 'DEPRECATED' then
-{      El['calling-conv'] := 'deprecated';}
+         Proc.Hints:=Proc.Hints+[hDeprecated]
+        else if s = 'EXPORT' then
+          Proc.AddModifier(pmExported)
         else
         begin
           UngetToken;