paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 09:19:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix #39876: correctly Read(Str) enum types which have a size smaller than 4 Byte

Browse Source 
+ added tests
This commit is contained in:
Sven/Sarah Barth 2022-08-26 17:16:29 +02:00
parent 717d38f060
commit 8595c927a8
5 changed files with 129 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/ninl.pas
View File

@ -801,7 +801,30 @@ implementation
enumdef:
begin
name:=procprefixes[do_read]+'enum';
readfunctype:=s32inttype;
if do_read then
{ read is done with a var parameter so we need the correct
size for that }
case para.left.resultdef.size of
1:
begin
name:=name+'_shortint';
readfunctype:=s8inttype;
end;
2:
begin
name:=name+'_smallint';
readfunctype:=s16inttype;
end;
4:
begin
name:=name+'_longint';
readfunctype:=s32inttype;
end;
else
internalerror(2022082601);
end
else
readfunctype:=s32inttype;
end;
orddef :
begin
@ -1008,7 +1031,7 @@ implementation
Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_str2ord)
),nil);
{Insert a type conversion to to convert the enum to longint.}
para.left:=Ctypeconvnode.create_internal(para.left,s32inttype);
para.left:=Ctypeconvnode.create_internal(para.left,readfunctype);
typecheckpass(para.left);
end;
{ special handling of reading small numbers, because the helpers }

6
rtl/inc/compproc.inc
View File

@ -567,7 +567,13 @@ Procedure fpc_Read_Text_UInt_Iso(var f : Text; out u : ValUInt); compilerproc;
Procedure fpc_Read_Text_Float(var f : Text; out v :ValReal); compilerproc;
Procedure fpc_Read_Text_Float_Iso(var f : Text; out v : ValReal); compilerproc;
{$endif}
{$ifdef VER3_2}
procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); compilerproc;
{$else VER3_2}
procedure fpc_read_text_enum_longint(str2ordindex:pointer;var t:text;out ordinal:longint); compilerproc;
procedure fpc_read_text_enum_smallint(str2ordindex:pointer;var t:text;out ordinal:smallint); compilerproc;
procedure fpc_read_text_enum_shortint(str2ordindex:pointer;var t:text;out ordinal:shortint); compilerproc;
{$endif VER3_2}
procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); compilerproc;
procedure fpc_Read_Text_Currency_Iso(var f : Text; out v : Currency); compilerproc;
{$ifndef CPU64}

48
rtl/inc/text.inc
View File

@ -2109,7 +2109,11 @@ begin
end;
{$endif}
{$ifdef VER3_2}
procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); iocheck;compilerproc;
{$else VER3_2}
procedure fpc_read_text_enum_longint(str2ordindex:pointer;var t:text;out ordinal:longint); iocheck;compilerproc;
{$endif VER3_2}
var s:string;
code:valsint;
@ -2130,6 +2134,50 @@ begin
InOutRes:=106;
end;
{$ifndef VER3_2}
procedure fpc_read_text_enum_smallint(str2ordindex:pointer;var t:text;out ordinal:smallint); iocheck;compilerproc;
var s:string;
code:valsint;
begin
if not checkread(t) then
exit;
s:='';
if ignorespaces(t) then
begin
{ When spaces were found and we are now at EOF, then we return 0 }
if (TextRec(t).BufPos>=TextRec(t).BufEnd) then
exit;
ReadNumeric(t,s);
end;
ordinal:=smallint(fpc_val_enum_shortstr(str2ordindex,s,code));
if code<>0 then
InOutRes:=106;
end;
procedure fpc_read_text_enum_shortint(str2ordindex:pointer;var t:text;out ordinal:shortint); iocheck;compilerproc;
var s:string;
code:valsint;
begin
if not checkread(t) then
exit;
s:='';
if ignorespaces(t) then
begin
{ When spaces were found and we are now at EOF, then we return 0 }
if (TextRec(t).BufPos>=TextRec(t).BufEnd) then
exit;
ReadNumeric(t,s);
end;
ordinal:=shortint(fpc_val_enum_shortstr(str2ordindex,s,code));
if code<>0 then
InOutRes:=106;
end;
{$endif VER3_2}
procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); iocheck; compilerproc;
var
hs : string;

19
tests/webtbs/tw39876a.pp Normal file
View File

@ -0,0 +1,19 @@
{ %NORUN }
program tw39876a;
{$mode delphi}
type
TInputTypes = (itText, itPassWord, itRadio, itCheckbox, itHidden, itTel,
itNumber, itUrl, itEmail, itRrange, itDate, itMonth, itWeek);
var
ts: string;
anIT: TInputTypes;
begin
ts := 'itradio, tuesday, 3';
ReadStr(ts, anIT); // <== this is not compiled ...
end.

31
tests/webtbs/tw39876b.pp Normal file
View File

@ -0,0 +1,31 @@
{ %NORUN }
program tw39876b;
{$mode objfpc}
{$scopedenums on}
type
{$minenumsize 1}
TEnum1 = (teOne, teTwo, teThree);
{$minenumsize 2}
TEnum2 = (teOne, teTwo, teThree);
{$minenumsize 4}
TEnum4 = (teOne, teTwo, teThree);
var
te1: TEnum1;
te2: TEnum2;
te4: TEnum4;
s: String;
begin
s := 'teTwo';
ReadStr(s, te1);
ReadStr(s, te2);
ReadStr(s, te4);
end.