diff --git a/.gitattributes b/.gitattributes index 6fca1772f3..b132c9c30f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -10311,6 +10311,7 @@ tests/webtbs/tw15777d.pp svneol=native#text/plain tests/webtbs/tw15777e.pp svneol=native#text/plain tests/webtbs/tw15777f.pp svneol=native#text/plain tests/webtbs/tw15812.pp svneol=native#text/plain +tests/webtbs/tw15909.pp svneol=native#text/plain tests/webtbs/tw1592.pp svneol=native#text/plain tests/webtbs/tw1617.pp svneol=native#text/plain tests/webtbs/tw1622.pp svneol=native#text/plain @@ -11178,6 +11179,7 @@ tests/webtbs/uw13345y.pp svneol=native#text/plain tests/webtbs/uw13583.pp svneol=native#text/plain tests/webtbs/uw14124.pp svneol=native#text/plain tests/webtbs/uw14958.pp svneol=native#text/plain +tests/webtbs/uw15909.pp svneol=native#text/plain tests/webtbs/uw2004.inc svneol=native#text/plain tests/webtbs/uw2040.pp svneol=native#text/plain tests/webtbs/uw2266a.inc svneol=native#text/plain diff --git a/compiler/ncon.pas b/compiler/ncon.pas index c2da57155f..0c89d9c6b9 100644 --- a/compiler/ncon.pas +++ b/compiler/ncon.pas @@ -822,6 +822,7 @@ implementation constructor tstringconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); var pw : pcompilerwidestring; + i : longint; begin inherited ppuload(t,ppufile); cst_type:=tconststringtype(ppufile.getbyte); @@ -830,7 +831,18 @@ implementation begin initwidestring(pw); setlengthwidestring(pw,len); - ppufile.getdata(pw^.data,pw^.len*sizeof(tcompilerwidechar)); + { don't use getdata, because the compilerwidechars may have to + be byteswapped + } +{$if sizeof(tcompilerwidechar) = 2} + for i:=0 to pw^.len-1 do + pw^.data[i]:=ppufile.getword; +{$elseif sizeof(tcompilerwidechar) = 4} + for i:=0 to pw^.len-1 do + pw^.data[i]:=cardinal(ppufile.getlongint); +{$else} + {$error Unsupported tcompilerwidechar size} +{$endif} pcompilerwidestring(value_str):=pw end else @@ -849,7 +861,7 @@ implementation ppufile.putbyte(byte(cst_type)); ppufile.putlongint(len); if cst_type in [cst_widestring,cst_unicodestring] then - ppufile.putdata(pcompilerwidestring(value_str)^.data,len*sizeof(tcompilerwidechar)) + ppufile.putdata(pcompilerwidestring(value_str)^.data^,len*sizeof(tcompilerwidechar)) else ppufile.putdata(value_str^,len); ppufile.putasmsymbol(lab_str); diff --git a/compiler/symsym.pas b/compiler/symsym.pas index ee0552a0a1..b388c55401 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -1641,7 +1641,6 @@ implementation begin initwidestring(pw); setlengthwidestring(pw,ppufile.getlongint); - pw^.len:=pw^.maxlen; { don't use getdata, because the compilerwidechars may have to be byteswapped } diff --git a/compiler/widestr.pas b/compiler/widestr.pas index 4747e655b6..b08c4ff91a 100644 --- a/compiler/widestr.pas +++ b/compiler/widestr.pas @@ -97,7 +97,7 @@ unit widestr; getlengthwidestring:=r^.len; end; - procedure setlengthwidestring(r : pcompilerwidestring;l : SizeInt); + procedure growwidestring(r : pcompilerwidestring;l : SizeInt); begin if r^.maxlen>=l then @@ -109,18 +109,26 @@ unit widestr; r^.maxlen:=l; end; + procedure setlengthwidestring(r : pcompilerwidestring;l : SizeInt); + + begin + r^.len:=l; + if l>r^.maxlen then + growwidestring(r,l); + end; + procedure concatwidestringchar(r : pcompilerwidestring;c : tcompilerwidechar); begin if r^.len>=r^.maxlen then - setlengthwidestring(r,r^.len+16); + growwidestring(r,r^.len+16); r^.data[r^.len]:=c; inc(r^.len); end; procedure concatwidestrings(s1,s2 : pcompilerwidestring); begin - setlengthwidestring(s1,s1^.len+s2^.len); + growwidestring(s1,s1^.len+s2^.len); move(s2^.data^,s1^.data[s1^.len],s2^.len*sizeof(tcompilerwidechar)); inc(s1^.len,s2^.len); end; @@ -129,7 +137,6 @@ unit widestr; begin setlengthwidestring(d,s^.len); - d^.len:=s^.len; move(s^.data^,d^.data^,s^.len*sizeof(tcompilerwidechar)); end; @@ -183,7 +190,6 @@ unit widestr; m:=getmap(current_settings.sourcecodepage); setlengthwidestring(r,l); source:=p; - r^.len:=l; dest:=tcompilerwidecharptr(r^.data); if (current_settings.sourcecodepage <> 'utf8') then begin diff --git a/tests/webtbs/tw15909.pp b/tests/webtbs/tw15909.pp new file mode 100644 index 0000000000..422d335176 --- /dev/null +++ b/tests/webtbs/tw15909.pp @@ -0,0 +1,10 @@ +{ %recompile } + +{$inline on} + +uses + uw15909; + +begin + foo('abc',5); +end. diff --git a/tests/webtbs/uw15909.pp b/tests/webtbs/uw15909.pp new file mode 100644 index 0000000000..f46ec21250 --- /dev/null +++ b/tests/webtbs/uw15909.pp @@ -0,0 +1,31 @@ +unit uw15909; +{$mode Delphi} + +{$inline on} + +interface + + procedure foo(const s: widestring; const n: integer); inline; + + function bar(const s, fmt: widestring): integer; + +implementation + +procedure foo(const s: widestring; const n: integer); +begin + bar(s, '%d') +end; + + + function bar(const s, fmt: widestring): integer; + begin + if (s<>'abc') or + (fmt<>'%d') then + begin + writeln('"',s,'"'); + halt(1); + end; + result:=0; + end; + +end.