From 35b771e4210222a8c668b53db501798db63518bb Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Wed, 24 Jul 2013 09:39:34 +0000
Subject: [PATCH] * previously, we preferred pchar->shortstring to
pchar->ansistring in case of {$h-}. Now this is no longer done because it
caused pchar->ansistring and pchar->unicodestring to have the same
overload preference, which regularly caused problems with the added
unicodestring overloads in the RTL in the cpstrrtl branch. * fixed
tw3328.pp (it was missing a {$mode delphi}), which failed before this
patch but compiles new + extra variants of that test for the compiler
changes
git-svn-id: trunk@25164 -
---
.gitattributes | 2 ++
compiler/defcmp.pas | 20 ++++++++++++--------
tests/webtbs/tw3328.pp | 2 ++
tests/webtbs/tw3328a.pp | 29 +++++++++++++++++++++++++++++
tests/webtbs/tw3328b.pp | 27 +++++++++++++++++++++++++++
5 files changed, 72 insertions(+), 8 deletions(-)
create mode 100644 tests/webtbs/tw3328a.pp
create mode 100644 tests/webtbs/tw3328b.pp
diff --git a/.gitattributes b/.gitattributes
index 76613815c8..077a797d1e 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -13671,6 +13671,8 @@ tests/webtbs/tw3320.pp svneol=native#text/plain
tests/webtbs/tw3324.pp svneol=native#text/plain
tests/webtbs/tw3327.pp svneol=native#text/plain
tests/webtbs/tw3328.pp svneol=native#text/plain
+tests/webtbs/tw3328a.pp svneol=native#text/plain
+tests/webtbs/tw3328b.pp svneol=native#text/plain
tests/webtbs/tw3334.pp svneol=native#text/plain
tests/webtbs/tw3340.pp svneol=native#text/plain
tests/webtbs/tw3348.pp svneol=native#text/plain
diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
index e86f613691..6f618cebce 100644
--- a/compiler/defcmp.pas
+++ b/compiler/defcmp.pas
@@ -659,15 +659,17 @@ implementation
if is_pchar(def_from) then
begin
doconv:=tc_pchar_2_string;
- { prefer ansistrings because pchars can overflow shortstrings, }
- { but only if ansistrings are the default (JM) }
- if (is_shortstring(def_to) and
- not(cs_refcountedstrings in current_settings.localswitches)) or
- (is_ansistring(def_to) and
- (cs_refcountedstrings in current_settings.localswitches)) then
- eq:=te_convert_l1
+ { prefer ansistrings/unicodestrings because pchars
+ can overflow shortstrings; don't use l1/l2/l3
+ because then pchar -> ansistring has the same
+ preference as conststring -> pchar, and this
+ breaks webtbs/tw3328.pp }
+ if is_ansistring(def_to) then
+ eq:=te_convert_l2
+ else if is_wide_or_unicode_string(def_to) then
+ eq:=te_convert_l3
else
- eq:=te_convert_l2;
+ eq:=te_convert_l4
end
else if is_pwidechar(def_from) then
begin
@@ -675,6 +677,8 @@ implementation
if is_wide_or_unicode_string(def_to) then
eq:=te_convert_l1
else
+ { shortstring and ansistring can both result in
+ data loss, so don't prefer one over the other }
eq:=te_convert_l3;
end;
end;
diff --git a/tests/webtbs/tw3328.pp b/tests/webtbs/tw3328.pp
index f5743eeb19..c239be5656 100644
--- a/tests/webtbs/tw3328.pp
+++ b/tests/webtbs/tw3328.pp
@@ -3,6 +3,8 @@
{ e-mail: chrivers@iversen-net.dk }
program fpcdelphi;
+{$mode delphi}
+
var
err : boolean;
diff --git a/tests/webtbs/tw3328a.pp b/tests/webtbs/tw3328a.pp
new file mode 100644
index 0000000000..bdf5567559
--- /dev/null
+++ b/tests/webtbs/tw3328a.pp
@@ -0,0 +1,29 @@
+{ Source provided for Free Pascal Bug Report 3328 }
+{ Submitted by "Christian Iversen" on 2004-09-21 }
+{ e-mail: chrivers@iversen-net.dk }
+program fpcdelphi;
+
+{$mode delphi}
+
+var
+ err : boolean;
+
+Function A(Const S2: AnsiString): Integer; Overload;
+Begin
+ writeln('ansistring overload');
+ err:=false;
+End;
+
+Function A(Const S2: UnicodeString): Integer; Overload;
+Begin
+ writeln('unicodestring overload');
+End;
+
+Var
+ X : PAnsiChar;
+Begin
+ err:=true;
+ A(X);
+ if err then
+ halt(1);
+End.
diff --git a/tests/webtbs/tw3328b.pp b/tests/webtbs/tw3328b.pp
new file mode 100644
index 0000000000..28947b7a68
--- /dev/null
+++ b/tests/webtbs/tw3328b.pp
@@ -0,0 +1,27 @@
+{ Source provided for Free Pascal Bug Report 3328 }
+{ Submitted by "Christian Iversen" on 2004-09-21 }
+{ e-mail: chrivers@iversen-net.dk }
+program fpcdelphi;
+
+var
+ err : boolean;
+
+Function A(Const S2: AnsiString): Integer; Overload;
+Begin
+ writeln('ansistring overload');
+ err:=false;
+End;
+
+Function A(Const S2: UnicodeString): Integer; Overload;
+Begin
+ writeln('unicodestring overload');
+End;
+
+Var
+ X : PAnsiChar;
+Begin
+ err:=true;
+ A(X);
+ if err then
+ halt(1);
+End.