Browse Source

* Support for file type parsing

git-svn-id: trunk@3852 -
michael 19 years ago
parent
commit
28ce91de92
3 changed files with 55 additions and 7 deletions
  1. 26 1
      fcl/passrc/pastree.pp
  2. 27 6
      fcl/passrc/pparser.pp
  3. 2 0
      fcl/passrc/pscanner.pp

+ 26 - 1
fcl/passrc/pastree.pp

@@ -35,6 +35,7 @@ resourcestring
   SPasTreeClassOfType = '"class of" type';
   SPasTreeClassOfType = '"class of" type';
   SPasTreeRangeType = 'range type';
   SPasTreeRangeType = 'range type';
   SPasTreeArrayType = 'array type';
   SPasTreeArrayType = 'array type';
+  SPasTreeFileType = 'file type';
   SPasTreeEnumValue = 'enumeration value';
   SPasTreeEnumValue = 'enumeration value';
   SPasTreeEnumType = 'enumeration type';
   SPasTreeEnumType = 'enumeration type';
   SPasTreeSetType = 'set type';
   SPasTreeSetType = 'set type';
@@ -178,6 +179,14 @@ type
     ElType: TPasType;
     ElType: TPasType;
   end;
   end;
 
 
+  TPasFileType = class(TPasType)
+  public
+    destructor Destroy; override;
+    function ElementTypeName: string; override;
+    function GetDeclaration(full : boolean) : string; override;
+    ElType: TPasType;
+  end;
+
   TPasEnumValue = class(TPasElement)
   TPasEnumValue = class(TPasElement)
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
@@ -474,6 +483,7 @@ function TPasTypeAliasType.ElementTypeName: string; begin Result := SPasTreeType
 function TPasClassOfType.ElementTypeName: string; begin Result := SPasTreeClassOfType end;
 function TPasClassOfType.ElementTypeName: string; begin Result := SPasTreeClassOfType end;
 function TPasRangeType.ElementTypeName: string; begin Result := SPasTreeRangeType end;
 function TPasRangeType.ElementTypeName: string; begin Result := SPasTreeRangeType end;
 function TPasArrayType.ElementTypeName: string; begin Result := SPasTreeArrayType end;
 function TPasArrayType.ElementTypeName: string; begin Result := SPasTreeArrayType end;
+function TPasFileType.ElementTypeName: string; begin Result := SPasTreeFileType end;
 function TPasEnumValue.ElementTypeName: string; begin Result := SPasTreeEnumValue end;
 function TPasEnumValue.ElementTypeName: string; begin Result := SPasTreeEnumValue end;
 function TPasEnumType.ElementTypeName: string; begin Result := SPasTreeEnumType end;
 function TPasEnumType.ElementTypeName: string; begin Result := SPasTreeEnumType end;
 function TPasSetType.ElementTypeName: string; begin Result := SPasTreeSetType end;
 function TPasSetType.ElementTypeName: string; begin Result := SPasTreeSetType end;
@@ -678,6 +688,13 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
+destructor TPasFileType.Destroy;
+begin
+  if Assigned(ElType) then
+    ElType.Release;
+  inherited Destroy;
+end;
+
 
 
 constructor TPasEnumType.Create(const AName: string; AParent: TPasElement);
 constructor TPasEnumType.Create(const AName: string; AParent: TPasElement);
 begin
 begin
@@ -1104,7 +1121,15 @@ begin
     Result:=Result+ElType.Name
     Result:=Result+ElType.Name
   else
   else
     Result:=Result+'const';
     Result:=Result+'const';
-    If Assigned(ELtype) then
+  If Full Then
+    Result:=Name+' = '+Result;
+end;
+
+function TPasFileType.GetDeclaration (full : boolean) : string;
+begin
+  Result:='File of ';
+  If Assigned(Eltype) then
+    Result:=Result+ElType.Name;
   If Full Then
   If Full Then
     Result:=Name+' = '+Result;
     Result:=Name+' = '+Result;
 end;
 end;

+ 27 - 6
fcl/passrc/pparser.pp

@@ -123,6 +123,7 @@ type
     function ParseType(Parent: TPasElement): TPasType;
     function ParseType(Parent: TPasElement): TPasType;
     function ParseComplexType: TPasType;
     function ParseComplexType: TPasType;
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseArrayType(Element: TPasArrayType);
+    procedure ParseFileType(Element: TPasFileType);
     function ParseExpression: String;
     function ParseExpression: String;
     procedure AddProcOrFunction(ASection: TPasSection; AProc: TPasProcedure);
     procedure AddProcOrFunction(ASection: TPasSection; AProc: TPasProcedure);
     function CheckIfOverloaded(AOwner: TPasClassType;
     function CheckIfOverloaded(AOwner: TPasClassType;
@@ -385,6 +386,10 @@ begin
         Result := TPasPointerType(CreateElement(TPasPointerType, '', Parent));
         Result := TPasPointerType(CreateElement(TPasPointerType, '', Parent));
         TPasPointerType(Result).DestType := ParseType(nil);
         TPasPointerType(Result).DestType := ParseType(nil);
       end;
       end;
+    tkFile:
+      begin
+        Result := TPasFileType(CreateElement(TPasFileType, '', Parent));
+      end;  
     tkArray:
     tkArray:
       begin
       begin
         Result := TPasArrayType(CreateElement(TPasArrayType, '', Parent));
         Result := TPasArrayType(CreateElement(TPasArrayType, '', Parent));
@@ -535,6 +540,18 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TPasParser.ParseFileType(Element: TPasFileType);
+
+
+begin
+  NextToken;
+  If CurToken=tkOf then
+    begin
+    NextToken;
+    Element.ElType := ParseType(nil);
+    end;
+end;
+
 function TPasParser.ParseExpression: String;
 function TPasParser.ParseExpression: String;
 var
 var
   BracketLevel: Integer;
   BracketLevel: Integer;
@@ -988,13 +1005,17 @@ begin
           ParseRange;
           ParseRange;
         end;
         end;
       end;
       end;
-{    _STRING, _FILE:
+    tkFile:
       begin
       begin
-        Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent));
-        UngetToken;
-        TPasAliasType(Result).DestType := ParseType(nil);
-        ExpectToken(tkSemicolon);
-      end;}
+        Result := TPasFileType(CreateElement(TPasFileType, TypeName, Parent));
+        Try
+          ParseFileType(TPasFileType(Result));
+          ExpectToken(tkSemicolon);
+        Except
+          Result.free;
+          Raise;
+        end;
+      end;
     tkArray:
     tkArray:
       begin
       begin
         Result := TPasArrayType(CreateElement(TPasArrayType, TypeName, Parent));
         Result := TPasArrayType(CreateElement(TPasArrayType, TypeName, Parent));

+ 2 - 0
fcl/passrc/pscanner.pp

@@ -85,6 +85,7 @@ type
     tkexcept,
     tkexcept,
     tkexports,
     tkexports,
     tkfalse,
     tkfalse,
+    tkfile,
     tkfinalization,
     tkfinalization,
     tkfinally,
     tkfinally,
     tkfor,
     tkfor,
@@ -270,6 +271,7 @@ const
     'except',
     'except',
     'exports',
     'exports',
     'false',
     'false',
+    'file',
     'finalization',
     'finalization',
     'finally',
     'finally',
     'for',
     'for',