From 4151bca8e4b9c7325486346ba01e86088cf4d694 Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 22 Oct 2017 19:51:14 +0000 Subject: [PATCH] codetools: test write string, widestring, unicodestring git-svn-id: trunk@56147 - --- .../tests/testcompreaderwriterpas.pas | 569 ++++++++++++++---- 1 file changed, 468 insertions(+), 101 deletions(-) diff --git a/components/codetools/tests/testcompreaderwriterpas.pas b/components/codetools/tests/testcompreaderwriterpas.pas index 3afee0692b..5847b91370 100644 --- a/components/codetools/tests/testcompreaderwriterpas.pas +++ b/components/codetools/tests/testcompreaderwriterpas.pas @@ -4,7 +4,6 @@ ./runtests --format=plain --suite=TTestCompReaderWriterPas.TestWriteProperties ToDo: -- root properties - base types - UTF-8 string - unicodestring @@ -31,11 +30,11 @@ unit TestCompReaderWriterPas; interface uses - Classes, SysUtils, typinfo, RtlConsts, LazLoggerBase, fpcunit, + Classes, SysUtils, typinfo, RtlConsts, LazLoggerBase, LazUTF8, fpcunit, testregistry, CodeToolManager, LinkScanner, TestStdCodetools; const - CWPDefaultSignature = '// Pascal writer V1.0'; + CWPDefaultSignature = '// component writer V1.0'; type TDummyComp = class(TComponent); // to access TComponent protected members TCWPFindAncestorEvent = procedure(Sender: TObject; Component: TComponent; @@ -46,7 +45,7 @@ type TCWPOption = ( cwpoNoSignature, cwpoSetParentFirst, // add "Parent:=" before properties - cwpoWideStringAsUTF8 + cwpoSrcCodepageUTF8 ); TCWPOptions = set of TCWPOption; @@ -79,6 +78,7 @@ type procedure WriteProperty(Instance: TPersistent; PropInfo: PPropInfo); procedure WriteProperties(Instance: TComponent); function GetStringLiteral(const s: string): string; + function GetWStringLiteral(p: PWideChar; Count: integer): string; function GetFloatLiteral(const e: Extended): string; public constructor Create(AStream: TStream); @@ -113,8 +113,8 @@ type // Tests ======================================================================= const - MinSafeIntCurrency = -922337203685477; - MaxSafeIntCurrency = 922337203685477; + MinSafeIntCurrency = Low(Int64) div 10000; + MaxSafeIntCurrency = High(Int64) div 10000; MinSafeIntSingle = -16777216; MaxSafeIntSingle = 16777216; MaskUIntSingle = $3fffff; @@ -311,17 +311,94 @@ type { TTestCompReaderWriterPas } TTestCompReaderWriterPas = class(TCustomTestCTStdCodetools) + private + FStream: TMemoryStream; + FWriter: TCompWriterPas; protected + procedure SetUp; override; + procedure TearDown; override; function WriteDescendant(Component: TComponent; Ancestor: TComponent = nil): string; procedure TestWriteDescendant(Msg: string; Component: TComponent; Ancestor: TComponent; const Expected: array of string); + property Writer: TCompWriterPas read FWriter write FWriter; published procedure TestBaseTypesSkipDefaultValue; + procedure TestBaseTypesZeroes; procedure TestBaseTypesMinValues; + procedure TestBaseTypesMaxValues; + procedure TestStringASCII; + procedure TestStringUTF8; + procedure TestWideString_SrcCodePageSystem; + procedure TestWideString_SrcCodePageUTF8; end; implementation +function IsValidUTF8(p: PChar): integer; +var + c: Char; +begin + c:=p^; + if ord(c)<%10000000 then begin + // regular single byte ASCII character (#0 is a character, this is Pascal ;) + Result:=1; + end else if ord(c)<=%11000001 then begin + // single byte character, between valid UTF-8 encodings + // %11000000 and %11000001 map 2 byte to #0..#128, which is invalid and used for XSS attacks + Result:=0; + end else if ord(c)<=%11011111 then begin + // could be 2 byte character (%110xxxxx %10xxxxxx) + if ((ord(p[1]) and %11000000) = %10000000) then + Result:=2 + else + Result:=0; // missing following bytes + end + else if ord(c)<=%11101111 then begin + // could be 3 byte character (%1110xxxx %10xxxxxx %10xxxxxx) + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) then begin + if (ord(c)=%11100000) and (ord(p[1])<=%10011111) then + Result:=0; // XSS attack: 3 bytes are mapped to the 1 or 2 byte codes + Result:=3; + end else + Result:=0; // missing following bytes + end + else if ord(c)<=%11110111 then begin + // could be 4 byte character (%11110xxx %10xxxxxx %10xxxxxx %10xxxxxx) + if ((ord(p[1]) and %11000000) = %10000000) + and ((ord(p[2]) and %11000000) = %10000000) + and ((ord(p[3]) and %11000000) = %10000000) then begin + if (ord(c)=%11110000) and (ord(p[1])<=%10001111) then + Result:=0; // XSS attack: 4 bytes are mapped to the 1-3 byte codes + Result:=4; + end else + Result:=0; // missing following bytes + end + else begin + Result:=0; + end; +end; + +function IsValidUTF16(p: PWideChar): integer; +var + c: WideChar; +begin + c:=p^; + if c<=#$DC7F then + exit(1) + else if c<=#$DBFF then begin + c:=p[1]; + if (c>=#$DC00) and (c<=#$DFFF) then + exit(2) + else + exit(0); + end else if c<=#$Dfff then begin + exit(0); + end else + exit(1); +end; + + Type { TPosComponent } @@ -332,6 +409,14 @@ Type constructor Create(APos: Integer; AComponent: TComponent); end; +{ TPosComponent } + +constructor TPosComponent.Create(APos: Integer; AComponent: TComponent); +begin + FPos:=APos; + FComponent:=AComponent; +end; + { TCompBaseTypesCustomStored } function TCompBaseTypesCustomStored.ABooleanIsStored: Boolean; @@ -469,14 +554,6 @@ begin inherited Create(AOwner); end; -{ TPosComponent } - -constructor TPosComponent.Create(APos: Integer; AComponent: TComponent); -begin - FPos:=APos; - FComponent:=AComponent; -end; - { TCompWriterPas } procedure TCompWriterPas.DetermineAncestor(Component: TComponent); @@ -569,6 +646,7 @@ var WStrValue, WDefStrValue: WideString; UStrValue, UDefStrValue: UnicodeString; VarValue, DefVarValue: tvardata; + aTypeData: PTypeData; begin // do not stream properties without getter if not Assigned(PropInfo^.GetProc) then @@ -612,9 +690,14 @@ begin // Integer with a custom identifier // ToDo: check if this is an actual Pascal constant and remember the unit WriteAssign(PropName,Ident) - else + else begin // Integer has to be written just as number - WriteAssign(PropName,IntToStr(Int32Value)); + aTypeData:=GetTypeData(PropInfo^.PropType); + if aTypeData^.MinValue>=0 then + WriteAssign(PropName,IntToStr(longword(Int32Value))) + else + WriteAssign(PropName,IntToStr(Int32Value)); + end; end; tkChar: case Int32Value of @@ -630,8 +713,8 @@ begin 0..31,127..255,$D800..$DFFF: WriteAssign(PropName,'#'+IntToStr(Int32Value)); else - if cwpoWideStringAsUTF8 in Options then - WriteAssign(PropName,''''+UTF8Encode(WideChar(Int32Value))+'''') + if cwpoSrcCodepageUTF8 in Options then + WriteAssign(PropName,''''+UTF16ToUTF8(WideChar(Int32Value))+'''') else WriteAssign(PropName,'#'+IntToStr(Int32Value)); end; @@ -734,13 +817,8 @@ begin else WDefStrValue := ''; - if WStrValue <> WDefStrValue then begin - {$IFDEF VerboseCompWriterPas} - System.writeln('TCompWriterPas.WriteProperty Property="',PropName,'" Kind=',PropType^.Kind); - raise EWriteError.Create('proptype not supported: '+GetEnumName(TypeInfo(PropType^.Kind),ord(PropType^.Kind))); - {$ENDIF} - //ToDo: WriteAssign(PropName,GetWStringLiteral(WStrValue)); - end; + if WStrValue <> WDefStrValue then + WriteAssign(PropName,GetWStringLiteral(PWideChar(WStrValue),length(WStrValue))); end; tkUString: begin @@ -750,13 +828,8 @@ begin else SetLength(UDefStrValue, 0); - if UStrValue <> UDefStrValue then begin - {$IFDEF VerboseCompWriterPas} - System.writeln('TCompWriterPas.WriteProperty Property="',PropName,'" Kind=',PropType^.Kind); - raise EWriteError.Create('proptype not supported: '+GetEnumName(TypeInfo(PropType^.Kind),ord(PropType^.Kind))); - {$ENDIF} - // ToDo: WriteAssign(PropName,GetWStringLiteral(UStrValue)); - end; + if UStrValue <> UDefStrValue then + WriteAssign(PropName,GetWStringLiteral(PWideChar(UStrValue),length(UStrValue))); end; tkVariant: begin @@ -831,42 +904,121 @@ begin end; function TCompWriterPas.GetStringLiteral(const s: string): string; -const - SpecialChars = [#0..#31,#127..#192]; + + function IsSpecialChar(p: PChar): boolean; + const + SpecialChars = [#0..#31,#127,#255]; + begin + Result:=(p^ in SpecialChars) or (IsValidUTF8(p)=0); + end; + var - i, StartPos: Integer; InLit: Boolean; + p, StartP: PChar; + c: Char; begin Result:=''; + if s='' then exit; InLit:=false; - i:=1; - while i<=length(s) do begin - if s[i] in SpecialChars then + p:=PChar(s); + repeat + c:=p^; + if (c=#0) and (p-PChar(s)=length(s)) then + break + else if IsSpecialChar(p) then begin if InLit then begin InLit:=false; Result:=Result+''''; end; - Result:=Result+'#'+IntToStr(ord(s[i])); - inc(i); + Result:=Result+'#'+IntToStr(ord(c)); + inc(p); end else begin if not InLit then begin InLit:=true; Result:=Result+''''; end; - if s[i]='''' then begin + if c='''' then begin Result:=Result+''''''; - inc(i); + inc(p); end else begin - StartPos:=i; + StartP:=p; repeat - inc(i); - until (i>length(s)) or (s[i] in SpecialChars) or (s[i]=''''); - // ToDo: source codepage<>UTF-8 - Result:=Result+copy(s,StartPos,i-StartPos); + inc(p,IsValidUTF8(p)); + c:=p^; + until ((c=#0) and (p-PChar(s)=length(s))) or IsSpecialChar(p) or (c=''''); + Result:=Result+copy(s,StartP-PChar(s)+1,p-StartP); end; end; + until false; + if InLit then + Result:=Result+''''; +end; + +function TCompWriterPas.GetWStringLiteral(p: PWideChar; Count: integer): string; + + function IsSpecialChar(w: PWideChar): boolean; + const + SpecialChars = [#0..#31,#127]; + begin + if w^ in SpecialChars then exit(true); + if cwpoSrcCodepageUTF8 in FOptions then begin + Result:=IsValidUTF16(w)=0; + end else begin + Result:=w^>=#$7f; + end; end; + +var + InLit: Boolean; + c: WideChar; + FirstP, StartP: PWideChar; + AddLen: SizeUInt; + s: string; + OldLen: Integer; +begin + Result:=''; + if Count=0 then exit; + FirstP:=p; + InLit:=false; + s:=''; + repeat + c:=p^; + if (c=#0) and (p-FirstP=Count) then + break + else if IsSpecialChar(p) then + begin + if InLit then begin + InLit:=false; + Result:=Result+''''; + end; + Result:=Result+'#'+Format('%.4d',[ord(c)]); + inc(p); + end else begin + if not InLit then begin + InLit:=true; + Result:=Result+''''; + end; + if c='''' then begin + Result:=Result+''''''; + inc(p); + end else begin + StartP:=p; + repeat + inc(p,IsValidUTF16(p)); + c:=p^; + until ((c=#0) and (p-FirstP=Count)) or IsSpecialChar(p) or (c=''''); + AddLen:=p-StartP; + if length(s)p then - Delete(s,p+1,i-p); + if i=length(s) then + Delete(s,p,i-p+1) // delete whole exponent + else + Delete(s,p+1,i-p); // remove trailing 0 of base i:=p; while (i>2) and (s[i-1]='0') do dec(i); - if s[i-1] in ['+','-'] then inc(i); + if not (s[i-1] in ['0'..'9']) then inc(i); if i

'' then - aStream.Read(Result[1],length(Result)); - {$IFDEF VerboseCompWriterPas} - writeln('TTestCompReaderWriterPas.WriteDescendant "',Result,'"'); - {$ENDIF} - finally - Writer.Free; - aStream.Free; - end; + Writer.WriteDescendant(Component,Ancestor); + FStream.Position:=0; + SetLength(Result,FStream.size); + if Result<>'' then + FStream.Read(Result[1],length(Result)); + {$IFDEF VerboseCompWriterPas} + writeln('TTestCompReaderWriterPas.WriteDescendant "',Result,'"'); + {$ENDIF} end; procedure TTestCompReaderWriterPas.TestWriteDescendant(Msg: string; @@ -1086,6 +1247,60 @@ begin end; end; +procedure TTestCompReaderWriterPas.TestBaseTypesZeroes; +var + AComponent: TCompBaseTypesCustomStored; +begin + AComponent:=TCompBaseTypesCustomStored.Create(nil); + try + with AComponent do begin + Name:=AComponent.ClassName+'1'; + AByte:=0; + DefAByte:=AByte+1; + AShortInt:=0; + DefAShortInt:=AShortInt+1; + AWord:=0; + DefAWord:=AWord+1; + ASmallInt:=0; + DefASmallInt:=ASmallInt+1; + ALongWord:=0; + DefALongWord:=ALongWord+1; + ALongInt:=0; + DefALongInt:=ALongInt+1; + AQWord:=0; + DefAQWord:=AQWord+1; + AInt64:=0; + DefAInt64:=AInt64+1; + ACurrency:=0; + DefACurrency:=ACurrency+1; + ASingle:=0; + DefASingle:=ASingle+1; + ADouble:=0; + DefADouble:=ADouble+1; + AChar:=#0; + DefAChar:=succ(AChar); + AWideChar:=#0; + DefAWideChar:=succ(AWideChar); + // ToDo: extended + end; + TestWriteDescendant('TestBaseTypesZeroes',AComponent,nil,[ + 'AByte:=0;', + 'AShortInt:=0;', + 'AWord:=0;', + 'ASmallInt:=0;', + 'ALongWord:=0;', + 'ALongInt:=0;', + 'ACurrency:= 0.0;', + 'ASingle:= 0.0;', + 'ADouble:= 0.0;', + 'AChar:=#0;', + 'AWideChar:=#0;', + '']); + finally + AComponent.Free; + end; +end; + procedure TTestCompReaderWriterPas.TestBaseTypesMinValues; var AComponent: TCompBaseTypesCustomStored; @@ -1093,40 +1308,44 @@ begin AComponent:=TCompBaseTypesCustomStored.Create(nil); try with AComponent do begin - Name:=AComponent.ClassName+'1'; - ABoolean:=low(boolean); - DefABoolean:=not ABoolean; - AByteBool:=boolean(low(byte)); - DefAByteBool:=not AByteBool; - AWordBool:=boolean(low(word)); - DefAWordBool:=not AWordBool; - ALongBool:=boolean(low(longword)); - DefALongBool:=not ALongBool; - AByte:=low(byte); - DefAByte:=AByte+1; - AShortInt:=low(ShortInt); - DefAShortInt:=AShortInt+1; - AWord:=low(word); - DefAWord:=AWord+1; - ASmallInt:=low(SmallInt); - DefASmallInt:=ASmallInt+1; - ALongWord:=low(LongWord); - DefALongWord:=ALongWord+1; - ALongInt:=low(LongInt); - DefALongInt:=ALongInt+1; - AQWord:=low(qword); - DefAQWord:=AQWord+1; - AInt64:=low(Int64); - DefAInt64:=AInt64+1; - ACurrency:=MinSafeIntCurrency; - DefACurrency:=ACurrency+1; - ASingle:=MinSafeIntSingle; - DefASingle:=ASingle+1; - ADouble:=MinSafeIntDouble; - DefADouble:=ADouble+1; - // ToDo: extended + Name:=AComponent.ClassName+'1'; + ABoolean:=low(boolean); + DefABoolean:=not ABoolean; + AByteBool:=boolean(low(byte)); + DefAByteBool:=not AByteBool; + AWordBool:=boolean(low(word)); + DefAWordBool:=not AWordBool; + ALongBool:=boolean(low(longword)); + DefALongBool:=not ALongBool; + AByte:=low(byte); + DefAByte:=AByte+1; + AShortInt:=low(ShortInt); + DefAShortInt:=AShortInt+1; + AWord:=low(word); + DefAWord:=AWord+1; + ASmallInt:=low(SmallInt); + DefASmallInt:=ASmallInt+1; + ALongWord:=low(LongWord); + DefALongWord:=ALongWord+1; + ALongInt:=low(LongInt); + DefALongInt:=ALongInt+1; + AQWord:=low(qword); + DefAQWord:=AQWord+1; + AInt64:=low(Int64); + DefAInt64:=AInt64+1; + ACurrency:=MinSafeIntCurrency; + DefACurrency:=ACurrency+1; + ASingle:=MinSafeIntSingle; + DefASingle:=ASingle+1; + ADouble:=MinSafeIntDouble; + DefADouble:=ADouble+1; + AChar:=low(char); + DefAChar:=succ(AChar); + AWideChar:=low(WideChar); + DefAWideChar:=succ(AWideChar); + // ToDo: extended end; - TestWriteDescendant('TestBaseTypesSkipDefaultValue',AComponent,nil,[ + TestWriteDescendant('TestBaseTypesMinValues',AComponent,nil,[ 'ABoolean:=False;', 'AByteBool:=False;', 'AWordBool:=False;', @@ -1141,6 +1360,154 @@ begin 'ACurrency:=-9.22337203685477E14;', 'ASingle:=-1.6777216E7;', 'ADouble:=-4.503599627370496E15;', + 'AChar:=#0;', + 'AWideChar:=#0;', + '']); + finally + AComponent.Free; + end; +end; + +procedure TTestCompReaderWriterPas.TestBaseTypesMaxValues; +var + AComponent: TCompBaseTypesCustomStored; +begin + AComponent:=TCompBaseTypesCustomStored.Create(nil); + try + with AComponent do begin + Name:=AComponent.ClassName+'1'; + ABoolean:=high(boolean); + DefABoolean:=not ABoolean; + AByteBool:=boolean(high(byte)); + DefAByteBool:=not AByteBool; + AWordBool:=boolean(high(word)); + DefAWordBool:=not AWordBool; + ALongBool:=boolean(high(longword)); + DefALongBool:=not ALongBool; + AByte:=high(byte); + DefAByte:=AByte-1; + AShortInt:=high(ShortInt); + DefAShortInt:=AShortInt-1; + AWord:=high(word); + DefAWord:=AWord-1; + ASmallInt:=high(SmallInt); + DefASmallInt:=ASmallInt-1; + ALongWord:=high(LongWord); + DefALongWord:=ALongWord-1; + ALongInt:=high(LongInt); + DefALongInt:=ALongInt-1; + AQWord:=high(qword); + DefAQWord:=AQWord-1; + AInt64:=high(Int64); + DefAInt64:=AInt64-1; + ACurrency:=MaxSafeIntCurrency; + DefACurrency:=ACurrency-1; + ASingle:=MaxSafeIntSingle; + DefASingle:=ASingle-1; + ADouble:=MaxSafeIntDouble; + DefADouble:=ADouble-1; + AChar:=high(char); + DefAChar:=pred(AChar); + AWideChar:=high(WideChar); + DefAWideChar:=pred(AWideChar); + // ToDo: extended + end; + TestWriteDescendant('TestBaseTypesMaxValues',AComponent,nil,[ + 'ABoolean:=True;', + 'AByteBool:=True;', + 'AWordBool:=True;', + 'ALongBool:=True;', + 'AByte:=255;', + 'AShortInt:=127;', + 'AWord:=65535;', + 'ASmallInt:=32767;', + 'ALongWord:=4294967295;', + 'ALongInt:=2147483647;', + 'AQWord:=18446744073709551615;', + 'AInt64:=9223372036854775807;', + 'ACurrency:=9.22337203685477E14;', + 'ASingle:=1.6777216E7;', + 'ADouble:=4.503599627370495E15;', + 'AChar:=#255;', + 'AWideChar:=#65535;', + '']); + finally + AComponent.Free; + end; +end; + +procedure TTestCompReaderWriterPas.TestStringASCII; +var + AComponent: TCompBaseTypes; +begin + AComponent:=TCompBaseTypes.Create(nil); + try + with AComponent do begin + Name:=AComponent.ClassName+'1'; + AString:=#9'A'#13#10; + end; + TestWriteDescendant('TestStringASCII',AComponent,nil,[ + 'AString:=#9''A''#13#10;']); + finally + AComponent.Free; + end; +end; + +procedure TTestCompReaderWriterPas.TestStringUTF8; +var + AComponent: TCompBaseTypes; +begin + AComponent:=TCompBaseTypes.Create(nil); + try + with AComponent do begin + Name:=AComponent.ClassName+'1'; + AString:='äöü'; + AShortString:='äöü'; + end; + TestWriteDescendant('TestStringUTF8',AComponent,nil,[ + 'AString:=''äöü'';', + 'AShortString:=''äöü'';', + '']); + finally + AComponent.Free; + end; +end; + +procedure TTestCompReaderWriterPas.TestWideString_SrcCodePageSystem; +var + AComponent: TCompBaseTypes; +begin + AComponent:=TCompBaseTypes.Create(nil); + try + with AComponent do begin + Name:=AComponent.ClassName+'1'; + AWideString:=UTF8ToUTF16('äAöü'); + AUnicodeString:=UTF8ToUTF16('äöBCü'); + end; + TestWriteDescendant('TestWideString_SrcCodePageSystem',AComponent,nil,[ + 'AWideString:=#0228''A''#0246#0252;', + 'AUnicodeString:=#0228#0246''BC''#0252;', + '']); + finally + AComponent.Free; + end; +end; + +procedure TTestCompReaderWriterPas.TestWideString_SrcCodePageUTF8; +var + AComponent: TCompBaseTypes; +begin + Writer.Options:=Writer.Options+[cwpoSrcCodepageUTF8]; + AComponent:=TCompBaseTypes.Create(nil); + try + with AComponent do begin + Name:=AComponent.ClassName+'1'; + AWideString:=UTF8ToUTF16('äöü'); + AUnicodeString:=UTF8ToUTF16('äöü'); + end; + TestWriteDescendant('TestWideString_SrcCodePageUTF8',AComponent,nil,[ + 'AWideString:=''äöü'';', + 'AUnicodeString:=''äöü'';', '']); finally AComponent.Free;