compiler: change overload search for char constants (for delphi compatibility):

- for AnsiChar prefer ShortString, AnsiString, UnicodeString, WideString, ... (LongString?)
  - for WideChar prefer UnicodeString, WideString, AnsiString, ShortString, ... (LongString?)
  - remove old code from htypechk which made AnsiChar const = AnsiString,ShortString and WideChar const = WideString,UnicodeString - it is no longer needed since defcmp performs the required comparisons
  + test

git-svn-id: trunk@20348 -
This commit is contained in:
paul 2012-02-14 06:52:33 +00:00
parent 4d863aff03
commit 2499b5514f
4 changed files with 133 additions and 16 deletions

1
.gitattributes vendored
View File

@ -10180,6 +10180,7 @@ tests/test/tcpstr17.pp svneol=native#text/pascal
tests/test/tcpstr18.pp svneol=native#text/pascal
tests/test/tcpstr19.pp svneol=native#text/pascal
tests/test/tcpstr2.pp svneol=native#text/plain
tests/test/tcpstr20.pp svneol=native#text/pascal
tests/test/tcpstr2a.pp svneol=native#text/plain
tests/test/tcpstr3.pp svneol=native#text/plain
tests/test/tcpstr4.pp svneol=native#text/plain

View File

@ -481,11 +481,30 @@ implementation
orddef :
begin
{ char to string}
if is_char(def_from) or
is_widechar(def_from) then
if is_char(def_from) then
begin
doconv:=tc_char_2_string;
case tstringdef(def_to).stringtype of
st_shortstring: eq:=te_convert_l1;
st_ansistring: eq:=te_convert_l2;
st_unicodestring: eq:=te_convert_l3;
st_widestring: eq:=te_convert_l4;
else
eq:=te_convert_l5;
end;
end
else
if is_widechar(def_from) then
begin
doconv:=tc_char_2_string;
eq:=te_convert_l1;
case tstringdef(def_to).stringtype of
st_unicodestring: eq:=te_convert_l1;
st_widestring: eq:=te_convert_l2;
st_ansistring: eq:=te_convert_l3;
st_shortstring: eq:=te_convert_l4;
else
eq:=te_convert_l5;
end;
end;
end;
arraydef :

View File

@ -1677,19 +1677,6 @@ implementation
if (p.resultdef.typ=stringdef) and
(tstringdef(def_to).stringtype=tstringdef(p.resultdef).stringtype) then
eq:=te_equal
else
{ Passing a constant char to ansistring or shortstring or
a widechar to widestring then handle it as equal. }
if (p.left.nodetype=ordconstn) and
(
is_char(p.resultdef) and
(is_shortstring(def_to) or is_ansistring(def_to))
) or
(
is_widechar(p.resultdef) and
(is_widestring(def_to) or is_unicodestring(def_to))
) then
eq:=te_equal
end;
setdef :
begin

110
tests/test/tcpstr20.pp Normal file
View File

@ -0,0 +1,110 @@
program tcpstr20;
{$APPTYPE CONSOLE}
{$MODE Delphi}
// Test checks that preferred string type arguments
// for AnsiChar are: ShortString, AnsiString, UnicodeString, WideString
// for WideChar are: UnicodeString, WideString, AnsiString, ShortString
const
AC = AnsiChar(13);
WC = WideChar(13);
procedure Test(const I, Compare, ExitCode: Integer);
begin
if I <> Compare then
begin
WriteLn(I, ' <> ', Compare);
halt(ExitCode);
end;
end;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
function OverAll(const S: WideString): Integer; overload;
begin
Result := 1;
end;
{$endif}
function OverAll(const S: UnicodeString): Integer; overload;
begin
Result := 2;
end;
function OverAll(const S: RawByteString): Integer; overload;
begin
Result := 3;
end;
function OverAll(const S: ShortString): Integer; overload;
begin
Result := 4;
end;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
function OverWide(const S: WideString): Integer; overload;
begin
Result := 1;
end;
{$endif}
function OverWide(const S: UnicodeString): Integer; overload;
begin
Result := 2;
end;
function OverNonWide(const S: RawByteString): Integer; overload;
begin
Result := 3;
end;
function OverNonWide(const S: ShortString): Integer; overload;
begin
Result := 4;
end;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
function OverAllNoUni(const S: WideString): Integer; overload;
begin
Result := 1;
end;
function OverAllNoUni(const S: RawByteString): Integer; overload;
begin
Result := 3;
end;
function OverAllNoUni(const S: ShortString): Integer; overload;
begin
Result := 4;
end;
{$endif}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
function OverAllNoShort(const S: WideString): Integer; overload;
begin
Result := 1;
end;
{$endif}
function OverAllNoShort(const S: UnicodeString): Integer; overload;
begin
Result := 2;
end;
function OverAllNoShort(const S: RawByteString): Integer; overload;
begin
Result := 3;
end;
begin
Test(OverAll(AC), 4, 1);
Test(OverAll(WC), 2, 2);
Test(OverWide(AC), 2, 3);
Test(OverNonWide(WC), 3, 4);
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Test(OverAllNoUni(WC), 1, 5);
{$endif}
Test(OverAllNoShort(AC), 3, 6);
end.