Quellcode durchsuchen

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

Sven/Sarah Barth vor 2 Jahren
Ursprung
Commit
8595c927a8
5 geänderte Dateien mit 129 neuen und 2 gelöschten Zeilen
  1. 25 2
      compiler/ninl.pas
  2. 6 0
      rtl/inc/compproc.inc
  3. 48 0
      rtl/inc/text.inc
  4. 19 0
      tests/webtbs/tw39876a.pp
  5. 31 0
      tests/webtbs/tw39876b.pp

+ 25 - 2
compiler/ninl.pas

@@ -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 - 0
rtl/inc/compproc.inc

@@ -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 - 0
rtl/inc/text.inc

@@ -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 - 0
tests/webtbs/tw39876a.pp

@@ -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 - 0
tests/webtbs/tw39876b.pp

@@ -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.
+