From ec57271d5b90ba06eaad99dda26dc0af9bd2af71 Mon Sep 17 00:00:00 2001 From: Jens Geyer Date: Mon, 13 Jul 2020 21:15:31 +0200 Subject: THRIFT-5251 StringUtils.ToString() raises an exception for enum values outside range Client: Delphi Patch: Jens Geyer --- lib/delphi/src/Thrift.Utils.pas | 12 +++ lib/delphi/test/typeregistry/Test.EnumToString.pas | 93 +++++++++++++++++++++ lib/delphi/test/typeregistry/Test.TypeRegistry.pas | 94 ++++++++++++++++++++++ lib/delphi/test/typeregistry/TestTypeRegistry.dpr | 57 +++---------- 4 files changed, 209 insertions(+), 47 deletions(-) create mode 100644 lib/delphi/test/typeregistry/Test.EnumToString.pas create mode 100644 lib/delphi/test/typeregistry/Test.TypeRegistry.pas diff --git a/lib/delphi/src/Thrift.Utils.pas b/lib/delphi/src/Thrift.Utils.pas index bc9b4605b..bfd020e2a 100644 --- a/lib/delphi/src/Thrift.Utils.pas +++ b/lib/delphi/src/Thrift.Utils.pas @@ -313,6 +313,7 @@ begin pType := PTypeInfo(TypeInfo(T)); if Assigned(pType) then begin case pType^.Kind of + tkInterface : begin pIntf := PInterface(@value); if Supports( pIntf^, ISupportsToString, stos) then begin @@ -320,6 +321,17 @@ begin Exit; end; end; + + tkEnumeration : begin + case SizeOf(value) of + 1 : begin result := EnumUtils.ToString( PShortInt(@value)^); Exit; end; + 2 : begin result := EnumUtils.ToString( PSmallInt(@value)^); Exit; end; + 4 : begin result := EnumUtils.ToString( PLongInt(@value)^); Exit; end; + else + ASSERT(FALSE); // in theory, this should not happen + end; + end; + end; end; diff --git a/lib/delphi/test/typeregistry/Test.EnumToString.pas b/lib/delphi/test/typeregistry/Test.EnumToString.pas new file mode 100644 index 000000000..a3d095d0b --- /dev/null +++ b/lib/delphi/test/typeregistry/Test.EnumToString.pas @@ -0,0 +1,93 @@ +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) + +unit Test.EnumToString; + +interface + +uses + Classes, SysUtils, + Thrift.Utils, + DebugProtoTest; + + +procedure RunTest; + + +implementation + +{$SCOPEDENUMS ON} + +type + TIrregularEnum = ( // has gaps and/or does not start at zero + FiveHundretOne = 501, + FiveHundretTwo = 502, + FiveHundretFive = 505 + ); + + TRegularEnum = ( // starts at zero, no gaps, no duplicates + One, + Two, + Three + ); + + +procedure IrregularEnumToString; +// TIrregularEnum does not run from 0 to N, so we don't have RTTI for it +// Search for "E2134: Type has no typeinfo" message to get the details +// Unfortunately, this also means that StringUtils.ToString() does not work for enums w/o RTTI +var value : Integer; + sA,sB : string; +begin + for value := Pred(Ord(Low(TIrregularEnum))) to Succ(Ord(High(TIrregularEnum))) do begin + sA := EnumUtils.ToString(Ord(value)); // much more reliable + sB := StringUtils.ToString(TIrregularEnum(value)); // does not really work + WriteLn( '- TIrregularEnum('+IntToStr(value)+'): EnumUtils => ',sA,', StringUtils => ', sB); + end; +end; + + +procedure RegularEnumToString; +// Regular enums have RTTI and work like a charm +var value : Integer; + sA,sB : string; +begin + for value := Pred(Ord(Low(TRegularEnum))) to Succ(Ord(High(TRegularEnum))) do begin + sA := EnumUtils.ToString(Ord(value)); + sB := StringUtils.ToString(TRegularEnum(value)); + if sA = sB // both are expected to work with regular enums + then WriteLn( '- TRegularEnum('+IntToStr(value)+'): ',sA,' = ', sB) + else raise Exception.Create( 'Test failed: '+sA+' <> '+sB); + end; +end; + + +procedure RunTest; +begin + Writeln('Testing enum utils ...'); + + RegularEnumToString; + IrregularEnumToString; + + Writeln; +end; + + +end. + diff --git a/lib/delphi/test/typeregistry/Test.TypeRegistry.pas b/lib/delphi/test/typeregistry/Test.TypeRegistry.pas new file mode 100644 index 000000000..96e30d81c --- /dev/null +++ b/lib/delphi/test/typeregistry/Test.TypeRegistry.pas @@ -0,0 +1,94 @@ +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) + +unit Test.TypeRegistry; + +interface + +uses + Classes, SysUtils, TypInfo, + Thrift, + Thrift.TypeRegistry, + DebugProtoTest; + + +procedure RunTest; + + +implementation + + +type + Tester = class + public + class procedure Test; + end; + + + +class procedure Tester.Test; +var instance : T; + name : string; +begin + instance := TypeRegistry.Construct; + name := GetTypeName(TypeInfo(T)); + if instance <> nil + then Writeln( name, ' = ok') + else begin + Writeln( name, ' = failed'); + raise Exception.Create( 'Test with '+name+' failed!'); + end; +end; + + +procedure RunTest; +begin + Writeln('Testing type registry ...'); + + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + Tester.Test; + + Writeln; +end; + + +end. + diff --git a/lib/delphi/test/typeregistry/TestTypeRegistry.dpr b/lib/delphi/test/typeregistry/TestTypeRegistry.dpr index 31c0fb2f1..2896bbf9b 100644 --- a/lib/delphi/test/typeregistry/TestTypeRegistry.dpr +++ b/lib/delphi/test/typeregistry/TestTypeRegistry.dpr @@ -37,56 +37,19 @@ uses Thrift.Stream in '..\..\src\Thrift.Stream.pas', Thrift.WinHTTP in '..\..\src\Thrift.WinHTTP.pas', Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas', - DebugProtoTest; + Thrift.Test, // in 'gen-delphi\Thrift.Test.pas', + Test.TypeRegistry, + Test.EnumToString; -type - Tester = class - public - class procedure Test; - end; - -class procedure Tester.Test; -var instance : T; - name : string; -begin - instance := TypeRegistry.Construct; - name := GetTypeName(TypeInfo(T)); - if instance <> nil - then Writeln( name, ' = ok') - else begin - Writeln( name, ' = failed'); - raise Exception.Create( 'Test with '+name+' failed!'); - end; -end; begin - Writeln('Testing ...'); - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Tester.Test; - Writeln('Completed.'); - + try + Test.TypeRegistry.RunTest; + Test.EnumToString.RunTest; + Writeln('Completed.'); + except + on e:Exception do Writeln(e.ClassName,': ',e.Message); + end; end. -- cgit v1.2.1