ソースを参照

* fixed storing/loading widestring constant nodes into/from ppu files
(mantis #15909)
* fixed storing/loading widestring constants into/from token streams
* made storing/loading widestring constant nodes into/from ppu files
endian safe

git-svn-id: trunk@15017 -

Jonas Maebe 15 年 前
コミット
45d25bbe77
6 ファイル変更68 行追加8 行削除
  1. 2 0
      .gitattributes
  2. 14 2
      compiler/ncon.pas
  3. 0 1
      compiler/symsym.pas
  4. 11 5
      compiler/widestr.pas
  5. 10 0
      tests/webtbs/tw15909.pp
  6. 31 0
      tests/webtbs/uw15909.pp

+ 2 - 0
.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

+ 14 - 2
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);

+ 0 - 1
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
                }

+ 11 - 5
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

+ 10 - 0
tests/webtbs/tw15909.pp

@@ -0,0 +1,10 @@
+{ %recompile }
+
+{$inline on}
+
+uses
+  uw15909;
+
+begin
+  foo('abc',5);
+end.

+ 31 - 0
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.