paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-05 22:10:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed string constant length when going from utf-8 to single-byte code page

Browse Source 
(mantis #33666, patch by engkin)

git-svn-id: trunk@40637 -
This commit is contained in:
Jonas Maebe 2018-12-24 22:21:40 +00:00
parent c9a7afe053
commit 70cadc7694
3 changed files with 20 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -16408,6 +16408,7 @@ tests/webtbs/tw33607.pp svneol=native#text/plain
tests/webtbs/tw33635.pp svneol=native#text/pascal
tests/webtbs/tw3364.pp svneol=native#text/plain
tests/webtbs/tw3366.pp svneol=native#text/plain
tests/webtbs/tw33666.pp svneol=native#text/plain
tests/webtbs/tw33696.pp svneol=native#text/pascal
tests/webtbs/tw33700.pp svneol=native#text/pascal
tests/webtbs/tw33706.pp svneol=native#text/plain

3
compiler/ncon.pas
View File

@ -982,6 +982,7 @@ implementation
Message1(option_code_page_not_available,IntToStr(cp1));
initwidestring(pw);
setlengthwidestring(pw,len);
{ returns room for terminating 0 }
l:=Utf8ToUnicode(PUnicodeChar(pw^.data),len,value_str,len);
if (l<>getlengthwidestring(pw)) then
begin
@ -989,6 +990,7 @@ implementation
ReAllocMem(value_str,l);
end;
unicode2ascii(pw,value_str,cp1);
len:=l-1;
donewidestring(pw);
end
else
@ -1000,6 +1002,7 @@ implementation
initwidestring(pw);
setlengthwidestring(pw,len);
ascii2unicode(value_str,len,cp2,pw);
{ returns room for terminating 0 }
l:=UnicodeToUtf8(nil,0,PUnicodeChar(pw^.data),len);
if l<>len then
ReAllocMem(value_str,l);

16
tests/webtbs/tw33666.pp Normal file
View File

@ -0,0 +1,16 @@
program Project1;
{$mode objfpc}{$H+}
{$Codepage UTF8}
type
CP437String = type ansistring(437);
var
s_cp437_1: CP437String;
begin
s_cp437_1 := '║'; //<--- buggy
if (length(s_cp437_1)<> 1) or
(ord(s_cp437_1[1])<> 186) then
halt(1);
end.