paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 20:30:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* removed special-purpose code for constant chars while parsing typed string

Browse Source 
constants: it did not properly handle ansistring code pages, and was just a
    hack to speed things up a bit (mantis #29153)

git-svn-id: trunk@32636 -
This commit is contained in:
Jonas Maebe 2015-12-11 15:33:28 +00:00
parent e43f767cbf
commit 092a0af0ec
3 changed files with 35 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -14894,6 +14894,7 @@ tests/webtbs/tw29096.pp svneol=native#text/plain
tests/webtbs/tw2911.pp svneol=native#text/plain
tests/webtbs/tw2912.pp svneol=native#text/plain
tests/webtbs/tw2913.pp svneol=native#text/plain
tests/webtbs/tw29153.pp svneol=native#text/plain
tests/webtbs/tw2916.pp svneol=native#text/plain
tests/webtbs/tw2920.pp svneol=native#text/plain
tests/webtbs/tw2923.pp svneol=native#text/plain

12
compiler/ngtcon.pas
View File

@ -461,7 +461,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
var
strlength : aint;
strval : pchar;
strch : char;
ll : tasmlabofs;
ca : pchar;
winlike : boolean;
@ -470,7 +469,8 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
strval:='';
{ load strval and strlength of the constant tree }
if (node.nodetype=stringconstn) or is_wide_or_unicode_string(def) or is_constwidecharnode(node) or
((node.nodetype=typen) and is_interfacecorba(ttypenode(node).typedef)) then
((node.nodetype=typen) and is_interfacecorba(ttypenode(node).typedef)) or
is_constcharnode(node) then
begin
{ convert to the expected string type so that
for widestrings strval is a pcompilerwidestring }
@ -497,14 +497,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
CGMessage(parser_e_widestring_to_ansi_compile_time);
end;
end
else if is_constcharnode(node) then
begin
{ strval:=pchar(@tordconstnode(node).value);
THIS FAIL on BIG_ENDIAN MACHINES PM }
strch:=chr(tordconstnode(node).value.svalue and $ff);
strval:=@strch;
strlength:=1
end
else if is_constresourcestringnode(node) then
begin
hsym:=tconstsym(tloadnode(node).symtableentry);

32
tests/webtbs/tw29153.pp Normal file
View File

@ -0,0 +1,32 @@
program bug;
{$IFDEF FPC}
{$CODEPAGE UTF8}
{$ENDIF}
const
c1: RawByteString = 'a';
c2: RawByteString = 'aa';
c3: RawByteString = 'aaa';
begin
writeln(StringCodePage(c1));
writeln(StringCodePage(c2));
writeln(StringCodePage(c3));
if stringcodepage(c1)<>CP_UTF8 then
halt(1);
if stringcodepage(c2)<>CP_UTF8 then
halt(2);
if stringcodepage(c3)<>CP_UTF8 then
halt(3);
c1:='a';
c2:='aa';
c3:='aaa';
writeln(StringCodePage(c1));
writeln(StringCodePage(c2));
writeln(StringCodePage(c3));
if stringcodepage(c1)<>CP_UTF8 then
halt(4);
if stringcodepage(c2)<>CP_UTF8 then
halt(5);
if stringcodepage(c3)<>CP_UTF8 then
halt(6);
end.