Browse Source

* Parse codepage strings

Michaël Van Canneyt 3 years ago
parent
commit
56ab410705

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

@@ -538,6 +538,7 @@ type
     DestType: TPasType;
     SubType: TPasType;
     Expr: TPasExpr;
+    CodepageExpr: TPasExpr;
   end;
 
   { TPasPointerType - todo: change it TPasAliasType }
@@ -935,6 +936,7 @@ type
   TPasStringType = class(TPasUnresolvedTypeRef)
   public
     LengthExpr : String;
+    CodePageExpr : String;
     function ElementTypeName: string; override;
   end;
 
@@ -3396,6 +3398,7 @@ begin
   ReleaseAndNil(TPasElement(SubType){$IFDEF CheckPasTreeRefCount},'TPasAliasType.SubType'{$ENDIF});
   ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
   ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'TPasAliasType.Expr'{$ENDIF});
+  ReleaseAndNil(TPasElement(CodepageExpr){$IFDEF CheckPasTreeRefCount},'TPasAliasType.Expr'{$ENDIF});
   inherited Destroy;
 end;
 

+ 16 - 4
packages/fcl-passrc/src/pparser.pp

@@ -1505,10 +1505,10 @@ function TPasParser.ParseStringType(Parent: TPasElement;
   const NamePos: TPasSourcePos; const TypeName: String): TPasAliasType;
 
 Var
-  LengthAsText : String;
+  CodePageAsText,LengthAsText : String;
   ok: Boolean;
   Params: TParamsExpr;
-  LengthExpr: TPasExpr;
+  CodePageExpr,LengthExpr: TPasExpr;
 
 begin
   Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent, NamePos));
@@ -1532,10 +1532,19 @@ begin
       CheckToken(tkSquaredBraceClose);
       LengthAsText:=ExprToText(LengthExpr);
       end
+    else if CurToken=tkBraceOpen then
+      begin
+      CodePageAsText:='';
+      NextToken;
+      CodePageExpr:=DoParseExpression(Result,nil,false);
+      CheckToken(tkBraceClose);
+      CodePageAsText:=ExprToText(CodePageExpr);
+      end
     else
       UngetToken;
     Result.DestType:=TPasStringType(CreateElement(TPasStringType,'string',Result));
     TPasStringType(Result.DestType).LengthExpr:=LengthAsText;
+    TPasStringType(Result.DestType).CodePageExpr:=CodePageAsText;
     ok:=true;
   finally
     if not ok then
@@ -1608,9 +1617,12 @@ begin
       ok:=true;
       exit;
       end
-    else if (CurToken in [tkBraceOpen,tkDotDot]) then // A: B..C;
+    else if (CurToken in [tkBraceOpen,tkDotDot])  then // A: B..C or A: string(CP);
       begin
-      K:=stkRange;
+      if not (LowerCase(Name)='string') then
+        K:=stkRange
+      else
+        K:=stkString;
       UnGetToken;
       end
     else

+ 34 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -93,6 +93,11 @@ type
     Procedure TestSimpleTypeStringSizeWrong;
     Procedure TestSimpleTypeStringSizeDeprecated;
     Procedure TestSimpleTypeStringSizePlatform;
+    procedure TestSimpleTypeStringCodePage;
+    procedure TestSimpleTypeStringCodePageIncomplete;
+    procedure TestSimpleTypeStringCodePageWrong;
+    procedure TestSimpleTypeStringCodePageDeprecated;
+    procedure TestSimpleTypeStringCodePagePlatform;
     Procedure TestSimpleTypeWord;
     Procedure TestSimpleTypeWordDeprecated;
     Procedure TestSimpleTypeWordPlatform;
@@ -3221,8 +3226,37 @@ end;
 procedure TTestTypeParser.TestSimpleTypeStringSize;
 begin
   DoTestStringType('String[10]','');
+  AssertEquals('Correct length', '10', TPasStringType(TPasAliasType(TheType).DestType).LengthExpr);
 end;
 
+procedure TTestTypeParser.TestSimpleTypeStringCodePage;
+
+begin
+  DoTestStringType('String(10)','');
+  AssertEquals('Correct length', '10', TPasStringType(TPasAliasType(TheType).DestType).CodePageExpr);
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringCodePageIncomplete;
+begin
+  DoTypeError('Incomplete string: missing )','string(10');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringCodePageWrong;
+begin
+  DoTypeError('Incomplete string, ] instead of (','string(10]');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringCodePageDeprecated;
+begin
+  DoTestStringType('String(10)','deprecated');
+end;
+
+procedure TTestTypeParser.TestSimpleTypeStringCodePagePlatform;
+begin
+  DoTestStringType('String(10)','Platform');
+end;
+
+
 procedure TTestTypeParser.TestSimpleTypeStringSizeIncomplete;
 begin
   DoTypeError('Incomplete string: missing ]','string[10');