Browse Source

--- Merging r13896 into '.':
U packages/fcl-passrc/src/pparser.pp
U packages/pxlib/src/pxlib.pp
U packages/pxlib/examples/ppxview.pp
--- Merging r13925 into '.':
U packages/fcl-passrc/src/pastree.pp
--- Merging r13929 into '.':
G packages/fcl-passrc/src/pastree.pp
G packages/fcl-passrc/src/pparser.pp
--- Merging r13930 into '.':
U packages/fcl-net/src/mkxmlrpc.pp
--- Merging r14046 into '.':
U packages/fcl-passrc/src/pscanner.pp

# revisions: 13896,13925,13929,13930,14046
------------------------------------------------------------------------
r13896 | michael | 2009-10-17 16:01:00 +0200 (Sat, 17 Oct 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-passrc/src/pparser.pp
M /trunk/packages/pxlib/examples/ppxview.pp
M /trunk/packages/pxlib/src/pxlib.pp

* Removed px_sdntogregorian for windows
------------------------------------------------------------------------
------------------------------------------------------------------------
r13925 | michael | 2009-10-23 12:10:34 +0200 (Fri, 23 Oct 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-passrc/src/pastree.pp

* (reworked) Patch from m. spiller to implement visitor pattern
------------------------------------------------------------------------
------------------------------------------------------------------------
r13929 | michael | 2009-10-23 17:11:08 +0200 (Fri, 23 Oct 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-passrc/src/pastree.pp
M /trunk/packages/fcl-passrc/src/pparser.pp

* Added support for export modifier (bug ID 13863)
------------------------------------------------------------------------
------------------------------------------------------------------------
r13930 | michael | 2009-10-23 17:11:32 +0200 (Fri, 23 Oct 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-net/src/mkxmlrpc.pp

* Adapted to new pastree declaration
------------------------------------------------------------------------
------------------------------------------------------------------------
r14046 | michael | 2009-11-04 15:02:13 +0100 (Wed, 04 Nov 2009) | 1 line
Changed paths:
M /trunk/packages/fcl-passrc/src/pscanner.pp

* Added support for $IFEND instead of $ENDIF
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14642 -

marco 15 years ago
parent
commit
2f0116cd9b

+ 1 - 1
packages/fcl-net/src/mkxmlrpc.pp

@@ -738,7 +738,7 @@ begin
         // Create dispatcher method
         // Create dispatcher method
         ProcMember := TPasProcedure.Create('Dispatch', ServerClass);
         ProcMember := TPasProcedure.Create('Dispatch', ServerClass);
         ProcMember.Visibility := visProtected;
         ProcMember.Visibility := visProtected;
-        ProcMember.IsOverride := True;
+        ProcMember.AddModifier(pmOverride);
         ProcMember.ProcType := TPasProcedureType.Create('', ProcMember);
         ProcMember.ProcType := TPasProcedureType.Create('', ProcMember);
         ProcMember.ProcType.CreateArgument('AParser', 'TXMLRPCParser').
         ProcMember.ProcType.CreateArgument('AParser', 'TXMLRPCParser').
           Visibility := visPublic;
           Visibility := visPublic;

+ 191 - 4
packages/fcl-passrc/src/pastree.pp

@@ -63,19 +63,30 @@ resourcestring
   SPasTreeDestructorImpl = 'destructor implementation';
   SPasTreeDestructorImpl = 'destructor implementation';
 
 
 type
 type
+  // Visitor pattern.
+  TPassTreeVisitor = class;
+
+  TPasElementBase = class
+    procedure Accept(Visitor: TPassTreeVisitor); virtual; abstract;
+  end;
+
 
 
   TPasModule = class;
   TPasModule = class;
 
 
   TPasMemberVisibility = (visDefault, visPrivate, visProtected, visPublic,
   TPasMemberVisibility = (visDefault, visPrivate, visProtected, visPublic,
     visPublished, visAutomated);
     visPublished, visAutomated);
 
 
+  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
+
   TPasMemberVisibilities = set of TPasMemberVisibility;
   TPasMemberVisibilities = set of TPasMemberVisibility;
   TPasMemberHint = (hDeprecated,hLibrary,hPlatform);
   TPasMemberHint = (hDeprecated,hLibrary,hPlatform);
   TPasMemberHints = set of TPasMemberHint; 
   TPasMemberHints = set of TPasMemberHint; 
 
 
   TPTreeElement = class of TPasElement;
   TPTreeElement = class of TPasElement;
 
 
-  TPasElement = class
+  { TPasElement }
+
+  TPasElement = class(TPasElementBase)
   private
   private
     FRefCount: LongWord;
     FRefCount: LongWord;
     FName: string;
     FName: string;
@@ -94,12 +105,15 @@ type
     function GetModule: TPasModule;
     function GetModule: TPasModule;
     function ElementTypeName: string; virtual;
     function ElementTypeName: string; virtual;
     function GetDeclaration(full : Boolean) : string; virtual;
     function GetDeclaration(full : Boolean) : string; virtual;
+    procedure Accept(Visitor: TPassTreeVisitor); override;
     property RefCount: LongWord read FRefCount;
     property RefCount: LongWord read FRefCount;
     property Name: string read FName write FName;
     property Name: string read FName write FName;
     property Parent: TPasElement read FParent;
     property Parent: TPasElement read FParent;
     Property Hints : TPasMemberHints Read FHints Write FHints;
     Property Hints : TPasMemberHints Read FHints Write FHints;
   end;
   end;
 
 
+  { TPasSection }
+
   TPasSection = class(TPasElement)
   TPasSection = class(TPasElement)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -112,6 +126,8 @@ type
     Functions, Variables, Properties: TList;
     Functions, Variables, Properties: TList;
   end;
   end;
 
 
+  { TPasModule }
+
   TPasModule = class(TPasElement)
   TPasModule = class(TPasElement)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -122,6 +138,8 @@ type
     PackageName: string;
     PackageName: string;
   end;
   end;
 
 
+  { TPasPackage }
+
   TPasPackage = class(TPasElement)
   TPasPackage = class(TPasElement)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -131,6 +149,8 @@ type
     Modules: TList;     // List of TPasModule objects
     Modules: TList;     // List of TPasModule objects
   end;
   end;
 
 
+  { TPasResString }
+
   TPasResString = class(TPasElement)
   TPasResString = class(TPasElement)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
@@ -139,11 +159,15 @@ type
     Value: string;
     Value: string;
   end;
   end;
 
 
+  { TPasType }
+
   TPasType = class(TPasElement)
   TPasType = class(TPasElement)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
   end;
   end;
 
 
+  { TPasPointerType }
+
   TPasPointerType = class(TPasType)
   TPasPointerType = class(TPasType)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -153,6 +177,8 @@ type
     DestType: TPasType;
     DestType: TPasType;
   end;
   end;
 
 
+  { TPasAliasType }
+
   TPasAliasType = class(TPasType)
   TPasAliasType = class(TPasType)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -162,11 +188,15 @@ type
     DestType: TPasType;
     DestType: TPasType;
   end;
   end;
 
 
+  { TPasTypeAliasType }
+
   TPasTypeAliasType = class(TPasAliasType)
   TPasTypeAliasType = class(TPasAliasType)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
   end;
   end;
 
 
+  { TPasClassOfType }
+
   TPasClassOfType = class(TPasAliasType)
   TPasClassOfType = class(TPasAliasType)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
@@ -174,6 +204,8 @@ type
   end;
   end;
 
 
 
 
+  { TPasRangeType }
+
   TPasRangeType = class(TPasType)
   TPasRangeType = class(TPasType)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
@@ -182,6 +214,8 @@ type
     RangeStart, RangeEnd: string;
     RangeStart, RangeEnd: string;
   end;
   end;
 
 
+  { TPasArrayType }
+
   TPasArrayType = class(TPasType)
   TPasArrayType = class(TPasType)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -193,6 +227,8 @@ type
     ElType: TPasType;
     ElType: TPasType;
   end;
   end;
 
 
+  { TPasFileType }
+
   TPasFileType = class(TPasType)
   TPasFileType = class(TPasType)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -202,6 +238,8 @@ type
     ElType: TPasType;
     ElType: TPasType;
   end;
   end;
 
 
+  { TPasEnumValue }
+
   TPasEnumValue = class(TPasElement)
   TPasEnumValue = class(TPasElement)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
@@ -211,6 +249,8 @@ type
     AssignedValue : string;
     AssignedValue : string;
   end;
   end;
 
 
+  { TPasEnumType }
+
   TPasEnumType = class(TPasType)
   TPasEnumType = class(TPasType)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -222,6 +262,8 @@ type
     Values: TList;      // List of TPasEnumValue objects
     Values: TList;      // List of TPasEnumValue objects
   end;
   end;
 
 
+  { TPasSetType }
+
   TPasSetType = class(TPasType)
   TPasSetType = class(TPasType)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -233,6 +275,8 @@ type
 
 
   TPasRecordType = class;
   TPasRecordType = class;
 
 
+  { TPasVariant }
+
   TPasVariant = class(TPasElement)
   TPasVariant = class(TPasElement)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -242,6 +286,8 @@ type
     Members: TPasRecordType;
     Members: TPasRecordType;
   end;
   end;
 
 
+  { TPasRecordType }
+
   TPasRecordType = class(TPasType)
   TPasRecordType = class(TPasType)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -260,6 +306,8 @@ type
 
 
   TPasObjKind = (okObject, okClass, okInterface);
   TPasObjKind = (okObject, okClass, okInterface);
 
 
+  { TPasClassType }
+
   TPasClassType = class(TPasType)
   TPasClassType = class(TPasType)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -276,6 +324,8 @@ type
 
 
   TArgumentAccess = (argDefault, argConst, argVar, argOut);
   TArgumentAccess = (argDefault, argConst, argVar, argOut);
 
 
+  { TPasArgument }
+
   TPasArgument = class(TPasElement)
   TPasArgument = class(TPasElement)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -287,6 +337,8 @@ type
     Value: string;
     Value: string;
   end;
   end;
 
 
+  { TPasProcedureType }
+
   TPasProcedureType = class(TPasType)
   TPasProcedureType = class(TPasType)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -301,6 +353,8 @@ type
     Args: TList;        // List of TPasArgument objects
     Args: TList;        // List of TPasArgument objects
   end;
   end;
 
 
+  { TPasResultElement }
+
   TPasResultElement = class(TPasElement)
   TPasResultElement = class(TPasElement)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -309,6 +363,8 @@ type
     ResultType: TPasType;
     ResultType: TPasType;
   end;
   end;
 
 
+  { TPasFunctionType }
+
   TPasFunctionType = class(TPasProcedureType)
   TPasFunctionType = class(TPasProcedureType)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -326,12 +382,17 @@ type
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
   end;
   end;
 
 
+  { TPasTypeRef }
+
   TPasTypeRef = class(TPasUnresolvedTypeRef)
   TPasTypeRef = class(TPasUnresolvedTypeRef)
+  public
   public
   public
     // function GetDeclaration(full : Boolean): string; override;
     // function GetDeclaration(full : Boolean): string; override;
     RefType: TPasType;
     RefType: TPasType;
   end;
   end;
 
 
+  { TPasVariable }
+
   TPasVariable = class(TPasElement)
   TPasVariable = class(TPasElement)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -344,11 +405,16 @@ type
     AbsoluteLocation : String;
     AbsoluteLocation : String;
   end;
   end;
 
 
+  { TPasConst }
+
   TPasConst = class(TPasVariable)
   TPasConst = class(TPasVariable)
+  public
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
   end;
   end;
 
 
+  { TPasProperty }
+
   TPasProperty = class(TPasVariable)
   TPasProperty = class(TPasVariable)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -362,11 +428,15 @@ type
     IsDefault, IsNodefault: Boolean;
     IsDefault, IsNodefault: Boolean;
   end;
   end;
 
 
+  { TPasProcedureBase }
+
   TPasProcedureBase = class(TPasElement)
   TPasProcedureBase = class(TPasElement)
   public
   public
     function TypeName: string; virtual; abstract;
     function TypeName: string; virtual; abstract;
   end;
   end;
 
 
+  { TPasOverloadedProc }
+
   TPasOverloadedProc = class(TPasProcedureBase)
   TPasOverloadedProc = class(TPasProcedureBase)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -377,7 +447,19 @@ type
     Overloads: TList;           // List of TPasProcedure nodes
     Overloads: TList;           // List of TPasProcedure nodes
   end;
   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)
   TPasProcedure = class(TPasProcedureBase)
+  Private
+    FCallingConvention : TCallingConvention;
+    FModifiers : TProcedureModifiers;
+    FMessageName : String;
+    FMessageType : TProcedureMessageType;
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
@@ -385,9 +467,21 @@ type
     function GetDeclaration(full: Boolean): string; override;
     function GetDeclaration(full: Boolean): string; override;
     procedure GetModifiers(List: TStrings);
     procedure GetModifiers(List: TStrings);
   public
   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;
   end;
 
 
   TPasFunction = class(TPasProcedure)
   TPasFunction = class(TPasProcedure)
@@ -396,18 +490,24 @@ type
     function GetDeclaration (full : boolean) : string; override;
     function GetDeclaration (full : boolean) : string; override;
   end;
   end;
 
 
+  { TPasOperator }
+
   TPasOperator = class(TPasProcedure)
   TPasOperator = class(TPasProcedure)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function GetDeclaration (full : boolean) : string; override;
     function GetDeclaration (full : boolean) : string; override;
   end;
   end;
 
 
+  { TPasConstructor }
+
   TPasConstructor = class(TPasProcedure)
   TPasConstructor = class(TPasProcedure)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
   end;
   end;
 
 
+  { TPasDestructor }
+
   TPasDestructor = class(TPasProcedure)
   TPasDestructor = class(TPasProcedure)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
@@ -417,6 +517,8 @@ type
 
 
   TPasImplBlock = class;
   TPasImplBlock = class;
 
 
+  { TPasProcedureImpl }
+
   TPasProcedureImpl = class(TPasElement)
   TPasProcedureImpl = class(TPasElement)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -429,12 +531,16 @@ type
     Body: TPasImplBlock;
     Body: TPasImplBlock;
   end;
   end;
 
 
+  { TPasConstructorImpl }
+
   TPasConstructorImpl = class(TPasProcedureImpl)
   TPasConstructorImpl = class(TPasProcedureImpl)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
   end;
   end;
 
 
+  { TPasDestructorImpl }
+
   TPasDestructorImpl = class(TPasProcedureImpl)
   TPasDestructorImpl = class(TPasProcedureImpl)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
@@ -444,11 +550,15 @@ type
   TPasImplElement = class(TPasElement)
   TPasImplElement = class(TPasElement)
   end;
   end;
 
 
+  { TPasImplCommand }
+
   TPasImplCommand = class(TPasImplElement)
   TPasImplCommand = class(TPasImplElement)
   public
   public
     Command: string;
     Command: string;
   end;
   end;
 
 
+  { TPasImplCommands }
+
   TPasImplCommands = class(TPasImplElement)
   TPasImplCommands = class(TPasImplElement)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -457,6 +567,8 @@ type
     Commands: TStrings;
     Commands: TStrings;
   end;
   end;
 
 
+  { TPasImplIfElse }
+
   TPasImplIfElse = class(TPasImplElement)
   TPasImplIfElse = class(TPasImplElement)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -465,6 +577,8 @@ type
     IfBranch, ElseBranch: TPasImplElement;
     IfBranch, ElseBranch: TPasImplElement;
   end;
   end;
 
 
+  { TPasImplForLoop }
+
   TPasImplForLoop = class(TPasImplElement)
   TPasImplForLoop = class(TPasImplElement)
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
@@ -474,6 +588,8 @@ type
     Body: TPasImplElement;
     Body: TPasImplElement;
   end;
   end;
 
 
+  { TPasImplBlock }
+
   TPasImplBlock = class(TPasImplElement)
   TPasImplBlock = class(TPasImplElement)
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -487,6 +603,11 @@ type
     Elements: TList;    // TPasImplElement objects
     Elements: TList;    // TPasImplElement objects
   end;
   end;
 
 
+  { TPassTreeVisitor }
+
+  TPassTreeVisitor = class
+    procedure Visit(obj: TPasElement); virtual;
+  end;
 
 
 const
 const
   AccessNames: array[TArgumentAccess] of string[6] = ('', 'const ', 'var ', 'out ');
   AccessNames: array[TArgumentAccess] of string[6] = ('', 'const ', 'var ', 'out ');
@@ -635,6 +756,11 @@ begin
     Result := '';
     Result := '';
 end;
 end;
 
 
+procedure TPasElement.Accept(Visitor: TPassTreeVisitor);
+begin
+  Visitor.Visit(Self);
+end;
+
 constructor TPasSection.Create(const AName: string; AParent: TPasElement);
 constructor TPasSection.Create(const AName: string; AParent: TPasElement);
 begin
 begin
   inherited Create(AName, AParent);
   inherited Create(AName, AParent);
@@ -1457,6 +1583,58 @@ begin
   DoAdd(IsMessage,' Message');
   DoAdd(IsMessage,' Message');
 end;
 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;
 function TPasProcedure.GetDeclaration (full : boolean) : string;
 
 
 Var
 Var
@@ -1550,4 +1728,13 @@ begin
     Result:='';
     Result:='';
 end;
 end;
 
 
+
+
+{ TPassTreeVisitor }
+
+procedure TPassTreeVisitor.Visit(obj: TPasElement);
+begin
+  // Needs to be implemented by descendents.
+end;
+
 end.
 end.

+ 46 - 33
packages/fcl-passrc/src/pparser.pp

@@ -124,7 +124,7 @@ type
 
 
     function ParseType(Parent: TPasElement; Prefix : String): TPasType;overload;
     function ParseType(Parent: TPasElement; Prefix : String): TPasType;overload;
     function ParseType(Parent: TPasElement): TPasType;overload;
     function ParseType(Parent: TPasElement): TPasType;overload;
-    function ParseComplexType: TPasType;
+    function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseFileType(Element: TPasFileType);
     procedure ParseFileType(Element: TPasFileType);
     function ParseExpression: String;
     function ParseExpression: String;
@@ -516,20 +516,20 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TPasParser.ParseComplexType: TPasType;
+function TPasParser.ParseComplexType(Parent : TPasElement = Nil): TPasType;
 begin
 begin
   NextToken;
   NextToken;
   case CurToken of
   case CurToken of
     tkProcedure:
     tkProcedure:
       begin
       begin
-        Result := TPasProcedureType(CreateElement(TPasProcedureType, '', nil));
+        Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
         ParseProcedureOrFunctionHeader(Result,
         ParseProcedureOrFunctionHeader(Result,
           TPasProcedureType(Result), ptProcedure, True);
           TPasProcedureType(Result), ptProcedure, True);
         UngetToken;        // Unget semicolon
         UngetToken;        // Unget semicolon
       end;
       end;
     tkFunction:
     tkFunction:
       begin
       begin
-        Result := Engine.CreateFunctionType('', 'Result', nil, False,
+        Result := Engine.CreateFunctionType('', 'Result', Parent, False,
 	  Scanner.CurFilename, Scanner.CurRow);
 	  Scanner.CurFilename, Scanner.CurRow);
         ParseProcedureOrFunctionHeader(Result,
         ParseProcedureOrFunctionHeader(Result,
           TPasFunctionType(Result), ptFunction, True);
           TPasFunctionType(Result), ptFunction, True);
@@ -538,7 +538,7 @@ begin
     else
     else
     begin
     begin
       UngetToken;
       UngetToken;
-      Result := ParseType(nil);
+      Result := ParseType(Parent);
       exit;
       exit;
     end;
     end;
   end;
   end;
@@ -1198,7 +1198,7 @@ begin
       ExpectIdentifier;
       ExpectIdentifier;
     end;
     end;
 
 
-    VarType := ParseComplexType;
+    VarType := ParseComplexType(Parent);
 
 
     H:=CheckHint(Nil,False);
     H:=CheckHint(Nil,False);
     NextToken;
     NextToken;
@@ -1523,73 +1523,77 @@ begin
       Tok:=UpperCase(CurTokenString);
       Tok:=UpperCase(CurTokenString);
       If (Tok='CDECL') then
       If (Tok='CDECL') then
         begin
         begin
- {       El['calling-conv'] := 'cdecl';}
+        TPasProcedure(Parent).CallingConvention:=ccCDecl;
+        ExpectToken(tkSemicolon);
+        end 
+      else If (Tok='EXPORT') then
+        begin
+        TPasProcedure(Parent).AddModifier(pmExported);
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (Tok='PASCAL') then
       else if (Tok='PASCAL') then
         begin
         begin
-{        El['calling-conv'] := 'pascal';}
+        TPasProcedure(Parent).CallingConvention:=ccPascal;
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (Tok='STDCALL') then
       else if (Tok='STDCALL') then
         begin
         begin
-{        El['calling-conv'] := 'stdcall';}
+        TPasProcedure(Parent).CallingConvention:=ccStdCall;
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (Tok='OLDFPCCALL') then
       else if (Tok='OLDFPCCALL') then
         begin
         begin
-{        El['calling-conv'] := 'oldfpccall';}
+        TPasProcedure(Parent).CallingConvention:=ccOldFPCCall;
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (Tok='EXTDECL') then
       else if (Tok='EXTDECL') then
         begin
         begin
-{        El['calling-conv'] := 'extdecl';}
+        TPasProcedure(Parent).AddModifier(pmExternal);
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (Tok='REGISTER') then
       else if (Tok='REGISTER') then
         begin
         begin
-{        El['calling-conv'] := 'register';}
+        TPasProcedure(Parent).CallingConvention:=ccRegister;
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (Tok='COMPILERPROC') then
       else if (Tok='COMPILERPROC') then
         begin
         begin
-{      El['calling-conv'] := 'compilerproc';}
+        TPasProcedure(Parent).AddModifier(pmCompilerProc);
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end
         end
       else if (Tok='VARARGS') then
       else if (Tok='VARARGS') then
         begin
         begin
-{      'varargs': needs CDECL & EXTERNAL }
+        TPasProcedure(Parent).AddModifier(pmVarArgs);
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end
         end
       else if (tok='DEPRECATED') then  
       else if (tok='DEPRECATED') then  
         begin
         begin
-{       El['calling-conv'] := 'deprecated';}
         element.hints:=element.hints+[hDeprecated];
         element.hints:=element.hints+[hDeprecated];
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end
         end
       else if (tok='PLATFORM') then  
       else if (tok='PLATFORM') then  
         begin
         begin
-{       El['calling-conv'] := 'deprecated';}
         element.hints:=element.hints+[hPlatform];
         element.hints:=element.hints+[hPlatform];
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end
         end
       else if (tok='LIBRARY') then  
       else if (tok='LIBRARY') then  
         begin
         begin
-{       El['calling-conv'] := 'deprecated';}
         element.hints:=element.hints+[hLibrary];
         element.hints:=element.hints+[hLibrary];
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end
         end
       else if (tok='OVERLOAD') then
       else if (tok='OVERLOAD') then
         begin
         begin
-        TPasProcedure(Parent).IsOverload := True;
+        TPasProcedure(Parent).AddModifier(pmOverload);
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (tok='INLINE') then
       else if (tok='INLINE') then
         begin
         begin
+        TPasProcedure(Parent).AddModifier(pmInline);
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (tok='ASSEMBLER') then
       else if (tok='ASSEMBLER') then
         begin
         begin
+        TPasProcedure(Parent).AddModifier(pmAssembler);
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end 
         end 
       else if (tok = 'EXTERNAL') then  
       else if (tok = 'EXTERNAL') then  
@@ -1621,7 +1625,8 @@ begin
       end  
       end  
     else if (CurToken = tkInline) then
     else if (CurToken = tkInline) then
       begin
       begin
-{      TPasProcedure(Parent).IsInline := True;}
+      if Parent is TPasProcedure then
+        TPasProcedure(Parent).AddModifier(pmInline);
       ExpectToken(tkSemicolon);
       ExpectToken(tkSemicolon);
       end 
       end 
     else if (CurToken = tkSquaredBraceOpen) then
     else if (CurToken = tkSquaredBraceOpen) then
@@ -2018,38 +2023,46 @@ var
       begin
       begin
         s := UpperCase(CurTokenString);
         s := UpperCase(CurTokenString);
         if s = 'VIRTUAL' then
         if s = 'VIRTUAL' then
-          Proc.IsVirtual := True
+          Proc.AddModifier(pmVirtual)
         else if s = 'DYNAMIC' then
         else if s = 'DYNAMIC' then
-          Proc.IsDynamic := True
+          Proc.AddModifier(pmDynamic)
         else if s = 'ABSTRACT' then
         else if s = 'ABSTRACT' then
-          Proc.IsAbstract := True
+          Proc.AddModifier(pmAbstract)
         else if s = 'OVERRIDE' then
         else if s = 'OVERRIDE' then
-          Proc.IsOverride := True
+          Proc.AddModifier(pmOverride)
         else if s = 'REINTRODUCE' then
         else if s = 'REINTRODUCE' then
-          Proc.IsReintroduced := True
+          Proc.AddModifier(pmReintroduce)
         else if s = 'OVERLOAD' then
         else if s = 'OVERLOAD' then
-          Proc.IsOverload := True
+          Proc.AddModifier(pmOverload)
         else if s = 'STATIC' then
         else if s = 'STATIC' then
-          Proc.IsStatic := True
+          Proc.AddModifier(pmStatic)
         else if s = 'MESSAGE' then begin
         else if s = 'MESSAGE' then begin
-          Proc.IsMessage := True;
+          Proc.AddModifier(pmMessage);
           repeat
           repeat
             NextToken;
             NextToken;
+            If CurToken<>tkSemicolon then
+              begin
+              Proc.MessageName:=CurtokenString;
+              If (CurToken=tkString) then
+                Proc.Messagetype:=pmtString;
+              end;  
           until CurToken = tkSemicolon;
           until CurToken = tkSemicolon;
           UngetToken;
           UngetToken;
         end 
         end 
 	else if s = 'CDECL' then
 	else if s = 'CDECL' then
-{      El['calling-conv'] := 'cdecl';}
+	  Proc.CallingConvention:=ccCDecl
 	else if s = 'PASCAL' then
 	else if s = 'PASCAL' then
-{      El['calling-conv'] := 'cdecl';}
+	  Proc.CallingConvention:=ccPascal
         else if s = 'STDCALL' then
         else if s = 'STDCALL' then
-{      El['calling-conv'] := 'stdcall';}
+          Proc.CallingConvention:=ccStdCall
         else if s = 'OLDFPCCALL' then
         else if s = 'OLDFPCCALL' then
-{      El['calling-conv'] := 'oldfpccall';}
+          Proc.CallingConvention:=ccOldFPCCall
         else if s = 'EXTDECL' then
         else if s = 'EXTDECL' then
-{      El['calling-conv'] := 'extdecl';}
+          Proc.AddModifier(pmExtdecl)
         else if s = 'DEPRECATED' then
         else if s = 'DEPRECATED' then
-{      El['calling-conv'] := 'deprecated';}
+         Proc.Hints:=Proc.Hints+[hDeprecated]
+        else if s = 'EXPORT' then
+          Proc.AddModifier(pmExported)
         else
         else
         begin
         begin
           UngetToken;
           UngetToken;

+ 1 - 1
packages/fcl-passrc/src/pscanner.pp

@@ -1036,7 +1036,7 @@ begin
                 PPIsSkipping := false
                 PPIsSkipping := false
               else if PPSkipMode = ppSkipElseBranch then
               else if PPSkipMode = ppSkipElseBranch then
                 PPIsSkipping := true;
                 PPIsSkipping := true;
-            end else if Directive = 'ENDIF' then
+            end else if ((Directive = 'ENDIF') or (Directive='IFEND')) then
             begin
             begin
               if PPSkipStackIndex = 0 then
               if PPSkipStackIndex = 0 then
                 Error(SErrInvalidPPEndif);
                 Error(SErrInvalidPPEndif);

+ 4 - 0
packages/pxlib/examples/ppxview.pp

@@ -81,8 +81,12 @@ begin
         pxfDate:
         pxfDate:
            if PX_get_data_long(Doc,fbuf,flen,@longv)>0 then
            if PX_get_data_long(Doc,fbuf,flen,@longv)>0 then
               begin
               begin
+              {$ifdef windows}
+              S:=DateToStr(Longv+1721425-2415019);
+              {$else}
               PX_SdnToGregorian(longv+1721425,@Y,@M,@D);
               PX_SdnToGregorian(longv+1721425,@Y,@M,@D);
               S:=DateToStr(EncodeDate(Y,M,D));
               S:=DateToStr(EncodeDate(Y,M,D));
+              {$endif}
               end;
               end;
         pxfShort:
         pxfShort:
           if PX_get_data_short(Doc,fbuf, flen, @D)>0 then
           if PX_get_data_short(Doc,fbuf, flen, @D)>0 then

+ 6 - 0
packages/pxlib/src/pxlib.pp

@@ -369,7 +369,9 @@ var
   PX_put_data_byte : procedure(pxdoc:Ppxdoc_t; data:pcchar; len:cint; value:cchar);cdecl;
   PX_put_data_byte : procedure(pxdoc:Ppxdoc_t; data:pcchar; len:cint; value:cchar);cdecl;
   PX_put_data_bcd : procedure(pxdoc:Ppxdoc_t; data:pcchar; len:cint; value:pcchar);cdecl;
   PX_put_data_bcd : procedure(pxdoc:Ppxdoc_t; data:pcchar; len:cint; value:pcchar);cdecl;
   PX_put_data_blob : function(pxdoc:Ppxdoc_t; data:pcchar; len:cint; value:pcchar; valuelen:cint):cint;cdecl;
   PX_put_data_blob : function(pxdoc:Ppxdoc_t; data:pcchar; len:cint; value:pcchar; valuelen:cint):cint;cdecl;
+{$ifndef windows}
   PX_SdnToGregorian : procedure(sdn:clong; pYear:pcint; pMonth:pcint; pDay:pcint);cdecl;
   PX_SdnToGregorian : procedure(sdn:clong; pYear:pcint; pMonth:pcint; pDay:pcint);cdecl;
+{$endif}
   PX_GregorianToSdn : function(year:cint; month:cint; day:cint):clong;cdecl;
   PX_GregorianToSdn : function(year:cint; month:cint; day:cint):clong;cdecl;
   PX_make_time : function(pxdoc:Ppxdoc_t; hour:cint; minute:cint; second:cint):Ppxval_t;cdecl;
   PX_make_time : function(pxdoc:Ppxdoc_t; hour:cint; minute:cint; second:cint):Ppxval_t;cdecl;
   PX_make_date : function(pxdoc:Ppxdoc_t; year:cint; month:cint; day:cint):Ppxval_t;cdecl;
   PX_make_date : function(pxdoc:Ppxdoc_t; year:cint; month:cint; day:cint):Ppxval_t;cdecl;
@@ -472,7 +474,9 @@ begin
   PX_put_data_byte:=nil;
   PX_put_data_byte:=nil;
   PX_put_data_bcd:=nil;
   PX_put_data_bcd:=nil;
   PX_put_data_blob:=nil;
   PX_put_data_blob:=nil;
+{$ifndef windows}
   PX_SdnToGregorian:=nil;
   PX_SdnToGregorian:=nil;
+{$endif}  
   PX_GregorianToSdn:=nil;
   PX_GregorianToSdn:=nil;
   PX_make_time:=nil;
   PX_make_time:=nil;
   PX_make_date:=nil;
   PX_make_date:=nil;
@@ -563,7 +567,9 @@ begin
   pointer(PX_put_data_byte):=GetProcAddress(hlib,'PX_put_data_byte');
   pointer(PX_put_data_byte):=GetProcAddress(hlib,'PX_put_data_byte');
   pointer(PX_put_data_bcd):=GetProcAddress(hlib,'PX_put_data_bcd');
   pointer(PX_put_data_bcd):=GetProcAddress(hlib,'PX_put_data_bcd');
   pointer(PX_put_data_blob):=GetProcAddress(hlib,'PX_put_data_blob');
   pointer(PX_put_data_blob):=GetProcAddress(hlib,'PX_put_data_blob');
+{$ifndef windows}
   pointer(PX_SdnToGregorian):=GetProcAddress(hlib,'PX_SdnToGregorian');
   pointer(PX_SdnToGregorian):=GetProcAddress(hlib,'PX_SdnToGregorian');
+{$endif windows}  
   pointer(PX_GregorianToSdn):=GetProcAddress(hlib,'PX_GregorianToSdn');
   pointer(PX_GregorianToSdn):=GetProcAddress(hlib,'PX_GregorianToSdn');
   pointer(PX_make_time):=GetProcAddress(hlib,'PX_make_time');
   pointer(PX_make_time):=GetProcAddress(hlib,'PX_make_time');
   pointer(PX_make_date):=GetProcAddress(hlib,'PX_make_date');
   pointer(PX_make_date):=GetProcAddress(hlib,'PX_make_date');