Browse Source

* fixed unicodestring <-> variant handling
* fixed unicodestring property reading

git-svn-id: branches/unicodestring@11737 -

florian 17 years ago
parent
commit
fd41b41b91
4 changed files with 43 additions and 12 deletions
  1. 8 4
      compiler/htypechk.pas
  2. 1 1
      compiler/symconst.pas
  3. 28 1
      rtl/objpas/classes/classes.inc
  4. 6 6
      rtl/objpas/classes/reader.inc

+ 8 - 4
compiler/htypechk.pas

@@ -2238,7 +2238,7 @@ implementation
           (tve_single,tve_dblcurrency,tve_extended,
           (tve_single,tve_dblcurrency,tve_extended,
            tve_dblcurrency,tve_dblcurrency,tve_extended);
            tve_dblcurrency,tve_dblcurrency,tve_extended);
         variantstringdef_cl: array[tstringtype] of tvariantequaltype =
         variantstringdef_cl: array[tstringtype] of tvariantequaltype =
-          (tve_sstring,tve_astring,tve_astring,tve_wstring,tve_unicodestring);
+          (tve_sstring,tve_astring,tve_astring,tve_wstring,tve_ustring);
       begin
       begin
         case def.typ of
         case def.typ of
           orddef:
           orddef:
@@ -2437,9 +2437,9 @@ implementation
         else if (currvcl=tve_boolformal) or
         else if (currvcl=tve_boolformal) or
                 (bestvcl=tve_boolformal) then
                 (bestvcl=tve_boolformal) then
           if (currvcl=tve_boolformal) then
           if (currvcl=tve_boolformal) then
-            result:=ord(bestvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring])
+            result:=ord(bestvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring,tve_ustring])
           else
           else
-            result:=-ord(currvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring])
+            result:=-ord(currvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring,tve_ustring])
         { byte is better than everything else (we assume both aren't byte, }
         { byte is better than everything else (we assume both aren't byte, }
         { since there's only one parameter and that one can't be the same) }
         { since there's only one parameter and that one can't be the same) }
         else if (currvcl=tve_byte) or
         else if (currvcl=tve_byte) or
@@ -2497,7 +2497,11 @@ implementation
         { widestring is better than everything left }
         { widestring is better than everything left }
         else if (currvcl=tve_wstring) or
         else if (currvcl=tve_wstring) or
                 (bestvcl=tve_wstring) then
                 (bestvcl=tve_wstring) then
-          result:=1-2*ord(bestvcl=tve_wstring);
+          result:=1-2*ord(bestvcl=tve_wstring)
+        { unicodestring is better than everything left }
+        else if (currvcl=tve_ustring) or
+                (bestvcl=tve_ustring) then
+          result:=1-2*ord(bestvcl=tve_ustring);
 
 
         { all possibilities should have been checked now }
         { all possibilities should have been checked now }
         if (result=-5) then
         if (result=-5) then

+ 1 - 1
compiler/symconst.pas

@@ -448,7 +448,7 @@ type
   tvariantequaltype = (
   tvariantequaltype = (
     tve_incompatible,
     tve_incompatible,
     tve_chari64,
     tve_chari64,
-    tve_unicodestring,
+    tve_ustring,
     tve_wstring,
     tve_wstring,
     tve_astring,
     tve_astring,
     tve_sstring,
     tve_sstring,

+ 28 - 1
rtl/objpas/classes/classes.inc

@@ -893,13 +893,16 @@ procedure ObjectBinaryToText(Input, Output: TStream);
   end;
   end;
 
 
   procedure OutString(s: String);
   procedure OutString(s: String);
-
   begin
   begin
     OutChars(Pointer(S),PChar(S)+Length(S),@CharToOrd);
     OutChars(Pointer(S),PChar(S)+Length(S),@CharToOrd);
   end;
   end;
 
 
   procedure OutWString(W: WideString);
   procedure OutWString(W: WideString);
+  begin
+    OutChars(Pointer(W),pwidechar(W)+Length(W),@WideCharToOrd);
+  end;
 
 
+  procedure OutUString(W: UnicodeString);
   begin
   begin
     OutChars(Pointer(W),pwidechar(W)+Length(W),@WideCharToOrd);
     OutChars(Pointer(W),pwidechar(W)+Length(W),@WideCharToOrd);
   end;
   end;
@@ -1043,6 +1046,25 @@ procedure ObjectBinaryToText(Input, Output: TStream);
     end;
     end;
   end;
   end;
 
 
+  function ReadUStr: UnicodeString;
+  var
+    len: DWord;
+  {$IFDEF ENDIAN_BIG}
+    i : integer;
+  {$ENDIF}
+  begin
+    len := ReadDWord;
+    SetLength(Result, len);
+    if (len > 0) then
+    begin
+      Input.ReadBuffer(Pointer(@Result[1])^, len*2);
+      {$IFDEF ENDIAN_BIG}
+      for i:=1 to len do
+        Result[i]:=widechar(SwapEndian(word(Result[i])));
+      {$ENDIF}
+    end;
+  end;
+
   procedure ReadPropList(indent: String);
   procedure ReadPropList(indent: String);
 
 
     procedure ProcessValue(ValueType: TValueType; Indent: String);
     procedure ProcessValue(ValueType: TValueType; Indent: String);
@@ -1134,6 +1156,11 @@ procedure ObjectBinaryToText(Input, Output: TStream);
           OutWString(ReadWStr);
           OutWString(ReadWStr);
           OutLn('');
           OutLn('');
           end;
           end;
+        vaUString:
+          begin
+          OutWString(ReadWStr);
+          OutLn('');
+          end;
         vaNil:
         vaNil:
           OutLn('nil');
           OutLn('nil');
         vaCollection: begin
         vaCollection: begin

+ 6 - 6
rtl/objpas/classes/reader.inc

@@ -1248,12 +1248,12 @@ begin
         end;
         end;
       end;
       end;
     tkSString, tkLString, tkAString:
     tkSString, tkLString, tkAString:
-    begin
-      TmpStr:=ReadString;
-      if Assigned(FOnReadStringProperty) then
-        FOnReadStringProperty(Self,Instance,PropInfo,TmpStr);
-      SetStrProp(Instance, PropInfo, TmpStr);
-    end;
+      begin
+        TmpStr:=ReadString;
+        if Assigned(FOnReadStringProperty) then
+          FOnReadStringProperty(Self,Instance,PropInfo,TmpStr);
+        SetStrProp(Instance, PropInfo, TmpStr);
+      end;
     tkUstring:
     tkUstring:
       SetUnicodeStrProp(Instance,PropInfo,ReadUnicodeString);
       SetUnicodeStrProp(Instance,PropInfo,ReadUnicodeString);
     tkWString:
     tkWString: