* fixes widestring range checking, resolves #10013

git-svn-id: trunk@8971 -

.gitattributes

@@ -7598,6 +7598,7 @@ tests/webtbs/tw0961.pp svneol=native#text/plain
 tests/webtbs/tw0965.pp svneol=native#text/plain
 tests/webtbs/tw0966.pp svneol=native#text/plain
 tests/webtbs/tw0976.pp svneol=native#text/plain
+tests/webtbs/tw10013.pp svneol=native#text/plain
 tests/webtbs/tw1021.pp svneol=native#text/plain
 tests/webtbs/tw1023.pp svneol=native#text/plain
 tests/webtbs/tw1041.pp svneol=native#text/plain

rtl/inc/wstrings.inc

@@ -1055,7 +1055,7 @@ end;
 
 Procedure fpc_WideStr_CheckRange(len,index : SizeInt);[Public,Alias : 'FPC_WIDESTR_RANGECHECK']; compilerproc;
 begin
-  if (index>len) or (Index<1) then
+  if (index>len div 2) or (Index<1) then
     HandleErrorFrame(201,get_frame);
 end;
 

tests/webtbs/tw10013.pp

@@ -0,0 +1,51 @@
+program rcerror;
+
+{$MODE DELPHI} {$H+} {$R+}
+
+uses SysUtils;
+
+var
+  ws: WideString;
+  //wc: WideChar;
+  i: Integer;
+
+begin
+  ws := UTF8Decode('something');
+
+  WriteLn;
+  WriteLn('str: "', UTF8Encode(ws), '"');
+  WriteLn('len (must be 9) : ', Length(ws));
+  WriteLn;
+
+  for i := 1 to Length(ws) * 2 + 1 do
+  begin
+
+    Write('Try to access ws[', i, ']');
+
+    try
+
+      ws[i] := ws[i];
+      //wc := ws[i];
+      //ws[i] := wc;
+
+      if i > Length(ws) then
+        begin
+          writeln(' FAULT');
+          halt(1);
+        end
+      else
+        WriteLn(' OK');
+
+    except
+
+      on e : Exception do
+      begin
+        if (e is ERangeError) and (i > Length(ws)) then
+          WriteLn(' OK (got a range-check error as expected)');
+      end;
+
+    end;
+
+  end;
+end.
+