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

* make widestrings compatible with COM BSTR, the length is now the number

Browse Source 
of bytes allocated instead of the number of widechars

git-svn-id: trunk@1467 -
This commit is contained in:
peter 2005-10-18 09:45:13 +00:00
parent 867aaef744
commit ea6dadb7be
6 changed files with 38 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6315,6 +6315,7 @@ tests/webtbs/tw4260.pp svneol=native#text/plain
tests/webtbs/tw4266.pp -text
tests/webtbs/tw4272.pp svneol=native#text/plain
tests/webtbs/tw4277.pp svneol=native#text/plain
tests/webtbs/tw4290.pp svneol=native#text/plain
tests/webtbs/tw4294.pp svneol=native#text/plain
tests/webtbs/tw4308.pp svneol=native#text/plain
tests/webtbs/tw4336.pp svneol=native#text/plain

2
compiler/ncgcon.pas
View File

@ -425,7 +425,7 @@ implementation
{ at least for now }
{ Consts.concat(Tai_const.Create_8bit(2)); }
asmlist[al_typedconsts].concat(Tai_const.Create_aint(-1));
asmlist[al_typedconsts].concat(Tai_const.Create_aint(len));
asmlist[al_typedconsts].concat(Tai_const.Create_aint(len*cwidechartype.def.size));
asmlist[al_typedconsts].concat(Tai_label.Create(l1));
for i:=0 to len-1 do
asmlist[al_typedconsts].concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i]));

2
compiler/ncginl.pas
View File

@ -350,6 +350,8 @@ implementation
reference_reset_base(href,left.location.register,-sizeof(aint));
hregister:=cg.makeregsize(exprasmlist,left.location.register,OS_INT);
cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,href,hregister);
if is_widestring(left.resulttype.def) then
cg.a_op_const_reg(exprasmlist,OP_IDIV,OS_INT,cwidechartype.def.size,hregister);
cg.a_label(exprasmlist,lengthlab);
location_reset(location,LOC_REGISTER,OS_INT);
location.register:=hregister;

2
compiler/ptconst.pas
View File

@ -633,7 +633,7 @@ implementation
asmlist[cural].concat(Tai_const.Create_sym(ll));
asmlist[al_const].concat(tai_align.create(const_align(sizeof(aint))));
asmlist[al_const].concat(Tai_const.Create_aint(-1));
asmlist[al_const].concat(Tai_const.Create_aint(strlength));
asmlist[al_const].concat(Tai_const.Create_aint(strlength*cwidechartype.def.size));
asmlist[al_const].concat(Tai_label.Create(ll));
for i:=0 to strlength-1 do
asmlist[al_const].concat(Tai_const.Create_16bit(pcompilerwidestring(strval)^.data[i]));

14
rtl/inc/wstrings.inc
View File

@ -21,7 +21,9 @@
a pwidechar that points to :
@-8 : SizeInt for reference count;
@-4 : SizeInt for size;
@-4 : SizeInt for size; size=number of bytes, not the number of chars. Divide or multiply
with sizeof(WideChar) to convert. This is needed to be compatible with Delphi and
Windows COM BSTR.
@ : String + Terminating #0;
Pwidechar(Widestring) is a valid typecast.
So WS[i] is converted to the address @WS+i-1.
@ -657,7 +659,7 @@ begin
end;
{ Force nil termination in case it gets shorter }
PWord(Pointer(S)+l*sizeof(WideChar))^:=0;
PWideRec(Pointer(S)-FirstOff)^.Len:=l;
PWideRec(Pointer(S)-FirstOff)^.Len:=l*sizeof(WideChar);
end
else
begin
@ -729,10 +731,10 @@ begin
exit;
if PWideRec(Pointer(S)-WideFirstOff)^.Ref<>1 then
begin
L:=PWideRec(Pointer(S)-WideFirstOff)^.len;
L:=PWideRec(Pointer(S)-WideFirstOff)^.len div sizeof(WideChar);
SNew:=NewWideString (L);
Move (PWideChar(S)^,SNew^,(L+1)*sizeof(WideChar));
PWideRec(SNew-WideFirstOff)^.len:=L;
PWideRec(SNew-WideFirstOff)^.len:=L * sizeof(WideChar);
fpc_widestr_decr_ref (Pointer(S)); { Thread safe }
pointer(S):=SNew;
pointer(result):=SNew;
@ -761,7 +763,7 @@ begin
if ResultAddress<>Nil then
begin
Move (PWideChar(S)[Index],ResultAddress^,Size*sizeof(WideChar));
PWideRec(ResultAddress-WideFirstOff)^.Len:=Size;
PWideRec(ResultAddress-WideFirstOff)^.Len:=Size*sizeof(WideChar);
PWideChar(ResultAddress+Size*sizeof(WideChar))^:=#0;
end;
end;
@ -885,7 +887,7 @@ begin
exit;
if index<=0 then
exit;
LS:=PWideRec(Pointer(S)-WideFirstOff)^.Len;
LS:=PWideRec(Pointer(S)-WideFirstOff)^.Len div sizeof(WideChar);
if (Index<=LS) and (Size>0) then
begin
UniqueString (S);

25
tests/webtbs/tw4290.pp Normal file
View File

@ -0,0 +1,25 @@
{ %target=win32 }
{ Source provided for Free Pascal Bug Report 4290 }
{ Submitted by "rimga" on 2005-08-18 }
{ e-mail: rimga@ktl.mii.lt }
function SysAllocStringLen(psz:pointer;len:dword):pointer;stdcall;
external 'oleaut32.dll' name 'SysAllocStringLen';
procedure SysFreeString(bstr:pointer);stdcall;
external 'oleaut32.dll' name 'SysFreeString';
var
s: PWideChar;
w: widestring;
begin
setlength(w, 7);;
s:= SysAllocStringLen(nil, 7);
WriteLn(plongint(pointer(s)-4)^);
WriteLn(plongint(pointer(w)-4)^);
if plongint(pointer(s)-4)^ <> plongint(pointer(w)-4)^ then
Writeln('Not equal: problem (widestring not compatible to COM BSTR)')
else
Writeln('OK');
SysFreeString(s);
end.