소스 검색

* misc patches from mantis 17058, which fixes 70% of the fpdoc errors.

git-svn-id: trunk@15676 -
marco 15 년 전
부모
커밋
443b4ad8dc
3개의 변경된 파일159개의 추가작업 그리고 7개의 파일을 삭제
  1. 91 3
      packages/fcl-passrc/src/pastree.pp
  2. 67 3
      packages/fcl-passrc/src/pparser.pp
  3. 1 1
      packages/fcl-passrc/src/pscanner.pp

+ 91 - 3
packages/fcl-passrc/src/pastree.pp

@@ -67,8 +67,8 @@ resourcestring
   SPasTreeDestructorImpl = 'destructor implementation';
   SPasTreeDestructorImpl = 'destructor implementation';
 
 
 type
 type
-  TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekRange,
-     pekUnary, pekBinary, pekFuncParams, pekArrayParams);
+  TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekBoolConst, pekRange,
+     pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp);
 
 
   TExprOpCode = (eopNone,
   TExprOpCode = (eopNone,
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
@@ -77,7 +77,8 @@ type
                  eopEqual, eopNotEqual,  // Logical
                  eopEqual, eopNotEqual,  // Logical
                  eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
                  eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
                  eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
                  eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
-                 eopAddress);
+                 eopAddress,
+                 eopSubIdent); // SomeRec.A, A is subIdent of SomeRec
   
   
   { TPasExpr }
   { TPasExpr }
 
 
@@ -107,6 +108,11 @@ type
     Value     : AnsiString;
     Value     : AnsiString;
     constructor Create(AKind: TPasExprKind; const AValue : Ansistring);
     constructor Create(AKind: TPasExprKind; const AValue : Ansistring);
   end;
   end;
+  
+  TBoolConstExpr = class(TPasExpr)
+    Value     : Boolean;
+    constructor Create(AKind: TPasExprKind; const ABoolValue : Boolean);
+  end;
 
 
   { TParamsExpr }
   { TParamsExpr }
 
 
@@ -119,6 +125,30 @@ type
     procedure AddParam(xp: TPasExpr);
     procedure AddParam(xp: TPasExpr);
   end;
   end;
 
 
+  { TRecordValues }
+
+  TRecordValuesItem = record
+    Name      : AnsiString;
+    ValueExp  : TPasExpr;
+  end;
+
+  TRecordValues = class(TPasExpr)
+    Fields    : array of TRecordValuesItem;
+    constructor Create;
+    destructor Destroy; override;
+    procedure AddField(const Name: AnsiString; Value: TPasExpr);
+  end;
+
+  { TArrayValues }
+
+  TArrayValues = class(TPasExpr)
+    Values    : array of TPasExpr;
+    constructor Create;
+    destructor Destroy; override;
+    procedure AddValues(AValue: TPasExpr);
+  end;
+
+
   // Visitor pattern.
   // Visitor pattern.
   TPassTreeVisitor = class;
   TPassTreeVisitor = class;
 
 
@@ -2352,6 +2382,15 @@ begin
   Value:=AValue;
   Value:=AValue;
 end;
 end;
 
 
+{ TBoolConstExpr }
+
+constructor TBoolConstExpr.Create(AKind: TPasExprKind; const ABoolValue : Boolean);
+begin
+  inherited Create(AKind, eopNone);
+  Value:=ABoolValue;
+end;
+
+
 { TUnaryExpr }
 { TUnaryExpr }
 
 
 constructor TUnaryExpr.Create(AOperand: TPasExpr; AOpCode: TExprOpCode);
 constructor TUnaryExpr.Create(AOperand: TPasExpr; AOpCode: TExprOpCode);
@@ -2412,4 +2451,53 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
+{ TRecordValues }
+
+constructor TRecordValues.Create;
+begin
+  inherited Create(pekListOfExp, eopNone);
+end;
+
+destructor TRecordValues.Destroy;
+var
+  i : Integer;
+begin
+  for i:=0 to length(Fields)-1 do Fields[i].ValueExp.Free;
+  inherited Destroy;
+end;
+
+procedure TRecordValues.AddField(const Name:AnsiString;Value:TPasExpr);
+var
+  i : Integer;
+begin
+  i:=length(Fields);
+  SetLength(Fields, i+1);
+  Fields[i].Name:=Name;
+  Fields[i].ValueExp:=Value;
+end;
+
+{ TArrayValues }
+
+constructor TArrayValues.Create;
+begin
+  inherited Create(pekListOfExp, eopNone)
+end;
+
+destructor TArrayValues.Destroy;
+var
+  i : Integer;
+begin
+  for i:=0 to length(Values)-1 do Values[i].Free;
+  inherited Destroy;
+end;
+
+procedure TArrayValues.AddValues(AValue:TPasExpr);
+var
+  i : Integer;
+begin
+  i:=length(Values);
+  SetLength(Values, i+1);
+  Values[i]:=AValue;
+end;
+
 end.
 end.

+ 67 - 3
packages/fcl-passrc/src/pparser.pp

@@ -144,6 +144,7 @@ type
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseArrayType(Element: TPasArrayType);
     procedure ParseFileType(Element: TPasFileType);
     procedure ParseFileType(Element: TPasFileType);
     function DoParseExpression: TPasExpr;
     function DoParseExpression: TPasExpr;
+    function DoParseConstValueExpression: TPasExpr;
     function ParseExpression: String;
     function ParseExpression: String;
     function ParseCommand: String; // single, not compound command like begin..end
     function ParseCommand: String; // single, not compound command like begin..end
     procedure AddProcOrFunction(Declarations: TPasDeclarations; AProc: TPasProcedure);
     procedure AddProcOrFunction(Declarations: TPasDeclarations; AProc: TPasProcedure);
@@ -642,7 +643,7 @@ end;
 
 
 const
 const
   EndExprToken = [
   EndExprToken = [
-    tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma,
+    tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
     tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
     tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
   ];
   ];
 
 
@@ -719,6 +720,7 @@ begin
     tkDiv                   : Result:=eopDiv;
     tkDiv                   : Result:=eopDiv;
     tkNot                   : Result:=eopNot;
     tkNot                   : Result:=eopNot;
     tkIn                    : Result:=eopIn;
     tkIn                    : Result:=eopIn;
+    tkDot                   : Result:=eopSubIdent;
   else
   else
     ParseExc(format('Not an operand: (%d : %s)',[AToken,TokenInfos[AToken]]));
     ParseExc(format('Not an operand: (%d : %s)',[AToken,TokenInfos[AToken]]));
   end;
   end;
@@ -730,6 +732,7 @@ var
   prm     : TParamsExpr;
   prm     : TParamsExpr;
   u       : TUnaryExpr;
   u       : TUnaryExpr;
   b       : TBinaryExpr;
   b       : TBinaryExpr;
+  optk    : TToken;
 begin
 begin
   Result:=nil;
   Result:=nil;
   case CurToken of
   case CurToken of
@@ -737,6 +740,7 @@ begin
     tkChar:             x:=TPrimitiveExpr.Create(pekString, CurTokenText);
     tkChar:             x:=TPrimitiveExpr.Create(pekString, CurTokenText);
     tkNumber:           x:=TPrimitiveExpr.Create(pekNumber, CurTokenString);
     tkNumber:           x:=TPrimitiveExpr.Create(pekNumber, CurTokenString);
     tkIdentifier:       x:=TPrimitiveExpr.Create(pekIdent, CurTokenText);
     tkIdentifier:       x:=TPrimitiveExpr.Create(pekIdent, CurTokenText);
+    tkfalse, tktrue:    x:=TBoolConstExpr.Create(pekBoolConst, CurToken=tktrue);
     tkSquaredBraceOpen: x:=ParseParams(pekSet);
     tkSquaredBraceOpen: x:=ParseParams(pekSet);
   else
   else
     ParseExc(SParserExpectedIdentifier);
     ParseExc(SParserExpectedIdentifier);
@@ -768,8 +772,9 @@ begin
         end;
         end;
 
 
       if CurToken in [tkDot, tkas] then begin
       if CurToken in [tkDot, tkas] then begin
+        optk:=CurToken;
         NextToken;
         NextToken;
-        b:=TBinaryExpr.Create(x, ParseExpIdent, TokenToExprOp(CurToken));
+        b:=TBinaryExpr.Create(x, ParseExpIdent(), TokenToExprOp(optk));
         if not Assigned(b.right) then Exit; // error
         if not Assigned(b.right) then Exit; // error
         x:=b;
         x:=b;
       end;
       end;
@@ -963,6 +968,65 @@ begin
   UngetToken;
   UngetToken;
 end;
 end;
 
 
+function GetExprIdent(p: TPasExpr): String;
+begin
+  if Assigned(p) and (p is TPrimitiveExpr) and (p.Kind=pekIdent) then
+    Result:=TPrimitiveExpr(p).Value
+  else
+    Result:='';
+end;
+
+function TPasParser.DoParseConstValueExpression: TPasExpr;
+var
+  x : TPasExpr;
+  n : AnsiString;
+  r : TRecordValues;
+  a : TArrayValues;
+begin
+  if CurToken <> tkBraceOpen then
+    Result:=DoParseExpression
+  else begin
+    NextToken;
+    x:=DoParseConstValueExpression();
+    case CurToken of
+      tkComma: // array of values (a,b,c);
+        begin
+          a:=TArrayValues.Create;
+          a.AddValues(x);
+          repeat
+            NextToken;
+            x:=DoParseConstValueExpression();
+            a.AddValues(x);
+          until CurToken<>tkComma;
+          Result:=a;
+        end;
+
+      tkColon: // record field (a:xxx;b:yyy;c:zzz);
+        begin
+          n:=GetExprIdent(x);
+          x.Free;
+          r:=TRecordValues.Create;
+          NextToken;
+          x:=DoParseConstValueExpression();
+          r.AddField(n, x);
+          if CurToken=tkSemicolon then
+            repeat
+              n:=ExpectIdentifier;
+              ExpectToken(tkColon);
+              NextToken;
+              x:=DoParseConstValueExpression();
+              r.AddField(n, x)
+            until CurToken<>tkSemicolon;
+          Result:=r;
+        end;
+    else
+      Result:=x;
+    end;
+    if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
+    NextToken;
+  end;
+end;
+
 function TPasParser.ParseCommand: String;
 function TPasParser.ParseCommand: String;
 var
 var
   BracketLevel: Integer;
   BracketLevel: Integer;
@@ -1443,7 +1507,7 @@ begin
 
 
     // using new expression parser!
     // using new expression parser!
     NextToken; // skip tkEqual
     NextToken; // skip tkEqual
-    Result.Expr:=DoParseExpression;
+    Result.Expr:=DoParseConstValueExpression;
 
 
     // must unget for the check to be peformed fine!
     // must unget for the check to be peformed fine!
     UngetToken;
     UngetToken;

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

@@ -661,7 +661,7 @@ begin
         TokenStart := TokenStr;
         TokenStart := TokenStr;
         repeat
         repeat
           Inc(TokenStr);
           Inc(TokenStr);
-        until not (TokenStr[0] in ['0'..'9', 'A'..'F', 'a'..'F']);
+        until not (TokenStr[0] in ['0'..'9', 'A'..'F', 'a'..'f']);
         SectionLength := TokenStr - TokenStart;
         SectionLength := TokenStr - TokenStart;
         SetLength(FCurTokenString, SectionLength);
         SetLength(FCurTokenString, SectionLength);
         if SectionLength > 0 then
         if SectionLength > 0 then