* Allow streams as source

* Improved range type parsing (handle deprecated etc.)
* Improvements in record type parsing type (handle deprecated etc.)

git-svn-id: trunk@19993 -

packages/fcl-passrc/src/pastree.pp

@@ -116,6 +116,7 @@ type
     function PathName: string;          // = Module.Name + FullName
     function GetModule: TPasModule;
     function ElementTypeName: string; virtual;
+    Function HintsString : String;
     function GetDeclaration(full : Boolean) : string; virtual;
     procedure Accept(Visitor: TPassTreeVisitor); override;
     property RefCount: LongWord read FRefCount;
@@ -307,10 +308,11 @@ type
 
   TPasResString = class(TPasElement)
   public
+    Destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : Boolean) : string; Override;
   public
-    Value: string;
+    Expr: TPasExpr;
   end;
 
   { TPasType }
@@ -365,7 +367,10 @@ type
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
   public
-    RangeStart, RangeEnd: string;
+    RangeExpr : TBinaryExpr;
+    Destructor Destroy; override;
+    Function RangeStart : String;
+    Function RangeEnd : String;
   end;
 
   { TPasArrayType }
@@ -399,8 +404,8 @@ type
   public
     function ElementTypeName: string; override;
   public
-    IsValueUsed: Boolean;
-    Value: Integer;
+//    IsValueUsed: Boolean;
+//    Value: Integer;
     AssignedValue : string;
   end;
 
@@ -1059,6 +1064,23 @@ uses SysUtils;
 { Parse tree element type name functions }
 
 function TPasElement.ElementTypeName: string; begin Result := SPasTreeElement end;
+
+function TPasElement.HintsString: String;
+
+Var
+  H : TPasmemberHint;
+
+begin
+  Result:='';
+  For H := Low(TPasmemberHint) to High(TPasMemberHint) do
+    if H in Hints then
+      begin
+      If (Result<>'') then
+        Result:=Result+'; ';
+      Result:=Result+cPasMemberHint[h];
+      end;
+end;
+
 function TPasDeclarations.ElementTypeName: string; begin Result := SPasTreeSection end;
 function TPasModule.ElementTypeName: string; begin Result := SPasTreeModule end;
 function TPasPackage.ElementTypeName: string; begin Result := SPasTreePackage end;
@@ -1119,17 +1141,18 @@ end;
 procedure TPasElement.ProcessHints(const ASemiColonPrefix: boolean; var AResult: string);
 var
   h: TPasMemberHint;
+  S : String;
 begin
   if Hints <> [] then
-  begin
+    begin
     if ASemiColonPrefix then
       AResult := AResult + ';';
-    for h := Low(TPasMemberHint) to High(TPasMemberHint) do
-    begin
-      if h in Hints then
-        AResult := AResult + ' ' + cPasMemberHint[h] + ';'
+    S:=HintsString;
+    if (S<>'') then
+      AResult:=AResult+' '+S;
+    if ASemiColonPrefix then
+      AResult:=AResult+';';
     end;
-  end;
 end;
 
 constructor TPasElement.Create(const AName: string; AParent: TPasElement);
@@ -1810,37 +1833,75 @@ end;
 
 function TPasResString.GetDeclaration (full : boolean) : string;
 begin
-  Result:=Value;
+  Result:=Expr.GetDeclaration(true);
   If Full Then
+    begin
     Result:=Name+' = '+Result;
+    ProcessHints(False,Result);
+    end;
+end;
+
+destructor TPasResString.Destroy;
+begin
+  If Assigned(Expr) then
+    Expr.Release;
+  inherited Destroy;
 end;
 
 function TPasPointerType.GetDeclaration (full : boolean) : string;
 begin
   Result:='^'+DestType.Name;
   If Full then
+    begin
     Result:=Name+' = '+Result;
+    ProcessHints(False,Result);
+    end;
 end;
 
 function TPasAliasType.GetDeclaration (full : boolean) : string;
 begin
   Result:=DestType.Name;
   If Full then
+    begin
     Result:=Name+' = '+Result;
+    ProcessHints(False,Result);
+    end;
 end;
 
 function TPasClassOfType.GetDeclaration (full : boolean) : string;
 begin
   Result:='Class of '+DestType.Name;
   If Full then
+    begin
     Result:=Name+' = '+Result;
+    ProcessHints(False,Result);
+    end;
 end;
 
 function TPasRangeType.GetDeclaration (full : boolean) : string;
 begin
   Result:=RangeStart+'..'+RangeEnd;
   If Full then
+    begin
     Result:=Name+' = '+Result;
+    ProcessHints(False,Result);
+    end;
+end;
+
+destructor TPasRangeType.Destroy;
+begin
+  FreeAndNil(RangeExpr);
+  inherited Destroy;
+end;
+
+function TPasRangeType.RangeStart: String;
+begin
+  Result:=RangeExpr.Left.GetDeclaration(False);
+end;
+
+function TPasRangeType.RangeEnd: String;
+begin
+  Result:=RangeExpr.Right.GetDeclaration(False);
 end;
 
 function TPasArrayType.GetDeclaration (full : boolean) : string;
@@ -1856,7 +1917,10 @@ begin
   else
     Result:=Result+'const';
   If Full Then
+    begin
     Result:=Name+' = '+Result;
+    ProcessHints(False,Result);
+    end;
 end;
 
 function TPasArrayType.IsPacked: Boolean;
@@ -1870,7 +1934,10 @@ begin
   If Assigned(Eltype) then
     Result:=Result+' of '+ElType.Name;
   If Full Then
+    begin
     Result:=Name+' = '+Result;
+    ProcessHints(False,Result);
+    end;
 end;
 
 Function IndentStrings(S : TStrings; indent : Integer) : string;
@@ -1914,6 +1981,8 @@ begin
       Result:=IndentStrings(S,Length(Name)+4)
     else
       Result:=IndentStrings(S,1);
+    if Full then
+      ProcessHints(False,Result);
   finally
     S.Free;
   end;
@@ -1948,6 +2017,8 @@ begin
     If Full then
       Result:=Name+' = '+Result;
     end;
+  If Full then
+    ProcessHints(False,Result);
 end;
 
 function TPasRecordType.GetDeclaration (full : boolean) : string;
@@ -2085,6 +2156,9 @@ function TPasVariable.GetDeclaration (full : boolean) : string;
 Const
  Seps : Array[Boolean] of Char = ('=',':');
 
+Var
+  H : TPasMemberHint;
+  B : Boolean;
 begin
   if (Value = '') and Assigned(Expr) then
     Value := Expr.GetDeclaration(full);
@@ -2101,7 +2175,10 @@ begin
   else
     Result:=Value;
   If Full then
+    begin
     Result:=Name+' '+Seps[Assigned(VarType)]+' '+Result;
+    Result:=Result+HintsString;
+    end;
 end;
 
 function TPasProperty.GetDeclaration (full : boolean) : string;

packages/fcl-passrc/src/pparser.pp

@@ -50,6 +50,7 @@ resourcestring
   SParserInvalidTypeDef = 'Invalid type definition';
   SParserExpectedIdentifier = 'Identifier expected';
   SParserNotAProcToken = 'Not a procedure or function token';
+  SRangeExpressionExpected = 'Range expression expected';
 
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
@@ -112,7 +113,7 @@ type
   TPasParser = class
   private
     FCurModule: TPasModule;
-    FFileResolver: TFileResolver;
+    FFileResolver: TBaseFileResolver;
     FLogEvents: TPParserLogEvents;
     FOnLog: TPasParserLogHandler;
     FOptions: TPOptions;
@@ -164,7 +165,7 @@ type
     procedure AddProcOrFunction(Decs: TPasDeclarations; AProc: TPasProcedure);
     function  CheckIfOverloaded(AParent: TPasElement; const AName: String): TPasElement;
   public
-    constructor Create(AScanner: TPascalScanner; AFileResolver: TFileResolver;  AEngine: TPasTreeContainer);
+    constructor Create(AScanner: TPascalScanner; AFileResolver: TBaseFileResolver;  AEngine: TPasTreeContainer);
     // General parsing routines
     function CurTokenName: String;
     function CurTokenText: String;
@@ -219,7 +220,7 @@ type
     procedure ParseProcedureOrFunctionHeader(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
     procedure ParseProcedureBody(Parent: TPasElement);
     // Properties for external access
-    property FileResolver: TFileResolver read FFileResolver;
+    property FileResolver: TBaseFileResolver read FFileResolver;
     property Scanner: TPascalScanner read FScanner;
     property Engine: TPasTreeContainer read FEngine;
     property CurToken: TToken read FCurToken;
@@ -231,7 +232,8 @@ type
   end;
 
 function ParseSource(AEngine: TPasTreeContainer;
-                     const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
+                     const FPCCommandLine, OSTarget, CPUTarget: String;
+                     UseStreams  : Boolean = False): TPasModule;
 Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean;
 Function IsModifier(S : String; Out Pm : TProcedureModifier) : Boolean;
 Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean;
@@ -320,7 +322,8 @@ begin
 end;
 
 function ParseSource(AEngine: TPasTreeContainer;
-  const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
+  const FPCCommandLine, OSTarget, CPUTarget: String;
+  UseStreams  : Boolean = False): TPasModule;
 var
   FileResolver: TFileResolver;
   Parser: TPasParser;
@@ -352,7 +355,6 @@ var
         'S': // -S mode
           if  (length(s)>2) and (s[3]='d') then
             begin // -Sd mode delphi
-              Scanner.Options:=Scanner.Options+[po_delphi];
               Parser.Options:=Parser.Options+[po_delphi];
             end;
       end;
@@ -372,6 +374,7 @@ begin
   Parser := nil;
   try
     FileResolver := TFileResolver.Create;
+    FileResolver.UseStreams:=UseStreams;
     Scanner := TPascalScanner.Create(FileResolver);
     Scanner.Defines.Append('FPK');
     Scanner.Defines.Append('FPC');
@@ -504,7 +507,7 @@ begin
 end;
 
 constructor TPasParser.Create(AScanner: TPascalScanner;
-  AFileResolver: TFileResolver; AEngine: TPasTreeContainer);
+  AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer);
 begin
   inherited Create;
   FScanner := AScanner;
@@ -903,7 +906,7 @@ begin
       tkRecord: Result := ParseRecordDecl(Parent,TypeName,PM);
     else
       UngetToken;
-      Result:=ParseRangeType(Parent,'');
+      Result:=ParseRangeType(Parent,TypeName);
     end;
     if CH then
       CheckHint(Result,True);
@@ -2013,7 +2016,9 @@ begin
   Result := TPasResString(CreateElement(TPasResString, CurTokenString, Parent));
   try
     ExpectToken(tkEqual);
-    Result.Value := ParseExpression(Result);
+    NextToken; // skip tkEqual
+    Result.Expr:=DoParseConstValueExpression(Result);
+    UngetToken;
     CheckHint(Result,True);
   except
     Result.Free;
@@ -2041,13 +2046,23 @@ end;
 // Starts after the type name
 Function TPasParser.ParseRangeType(AParent : TPasElement; Const TypeName : String) : TPasRangeType;
 
+Var
+  PE : TPasExpr;
+
 begin
   Result := TPasRangeType(CreateElement(TPasRangeType, TypeName, AParent));
   try
-    TPasRangeType(Result).RangeStart := ParseExpression(Result);
-    ExpectToken(tkDotDot);
-    TPasRangeType(Result).RangeEnd := ParseExpression(Result);
-    // CheckHint(Result,True);
+    If not (CurToken=tkEqual) then
+      ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkEqual]]));
+    NextToken;
+    PE:=DoParseExpression(Result,Nil);
+    if not ((PE is TBinaryExpr) and (TBinaryExpr(PE).Kind=pekRange)) then
+      begin
+      FreeAndNil(PE);
+      ParseExc(SRangeExpressionExpected);
+      end;
+    Result.RangeExpr:=PE as TBinaryExpr;
+    UngetToken;
   except
     FreeAndNil(Result);
     raise;
@@ -3463,7 +3478,8 @@ begin
     ExpectIdentifier;
     UngetToken;                // Only names are allowed as following type
     TPasClassOfType(Result).DestType := ParseType(Result);
-    ExpectToken(tkSemicolon);
+    CheckHint(Result,true);
+//    ExpectToken(tkSemicolon);
     exit;
   end;