瀏覽代碼

* ncnv.pas, insert_varargstypeconv(): Do not cast a string literal to AnsiString if it has been already casted to Wide/UnicodeString, resolves #18266.

git-svn-id: trunk@16593 -
sergei 14 年之前
父節點
當前提交
331a72c8d6
共有 3 個文件被更改,包括 33 次插入1 次删除
  1. 1 0
      .gitattributes
  2. 3 1
      compiler/ncnv.pas
  3. 29 0
      tests/webtbs/tw18266.pp

+ 1 - 0
.gitattributes

@@ -10912,6 +10912,7 @@ tests/webtbs/tw18131.pp svneol=native#text/pascal
 tests/webtbs/tw1820.pp svneol=native#text/plain
 tests/webtbs/tw18222.pp svneol=native#text/pascal
 tests/webtbs/tw1825.pp svneol=native#text/plain
+tests/webtbs/tw18266.pp svneol=native#text/plain
 tests/webtbs/tw1850.pp svneol=native#text/plain
 tests/webtbs/tw1851.pp svneol=native#text/plain
 tests/webtbs/tw1856.pp svneol=native#text/plain

+ 3 - 1
compiler/ncnv.pas

@@ -591,7 +591,9 @@ implementation
         if not(iscvarargs) then
           maybe_call_procvar(p,true);
         if not(iscvarargs) and
-           (p.nodetype=stringconstn) then
+           (p.nodetype=stringconstn) and
+           { don't cast to AnsiString if already casted to Wide/UnicodeString, issue #18266 }
+           (tstringconstnode(p).cst_type in [cst_conststring,cst_shortstring,cst_longstring]) then
           p:=ctypeconvnode.create_internal(p,cansistringtype)
         else
           case p.resultdef.typ of

+ 29 - 0
tests/webtbs/tw18266.pp

@@ -0,0 +1,29 @@
+program WideVariant;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes;
+
+// A literal casted to Wide/UnicodeString is expected to be of type vtWideString.
+const
+  expected: array[0..3] of integer = (vtAnsiString, vtWideString, vtWideString, vtWideString);
+
+procedure variantfunc(vars: array of const);
+var
+  i: integer;
+begin
+  for i := Low(vars) to High(vars) do
+  begin
+    writeln('vars[i].VType=',ord(vars[i].VType));
+    if vars[i].VType <> expected[i] then
+      Halt(1);
+  end;  
+end;
+
+var
+  wstr: WideString;
+begin
+  variantfunc(['abc',WideString('def'),UnicodeString('123'),wstr]);
+end.
+