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

of bytes allocated instead of the number of widechars

git-svn-id: trunk@1467 -

.gitattributes

@@ -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

compiler/ncgcon.pas

@@ -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]));

compiler/ncginl.pas

@@ -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;

compiler/ptconst.pas

@@ -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]));

rtl/inc/wstrings.inc

@@ -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);

tests/webtbs/tw4290.pp

@@ -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.