mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 09:39:09 +02:00
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:
parent
4d863aff03
commit
2499b5514f
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10180,6 +10180,7 @@ tests/test/tcpstr17.pp svneol=native#text/pascal
|
|||||||
tests/test/tcpstr18.pp svneol=native#text/pascal
|
tests/test/tcpstr18.pp svneol=native#text/pascal
|
||||||
tests/test/tcpstr19.pp svneol=native#text/pascal
|
tests/test/tcpstr19.pp svneol=native#text/pascal
|
||||||
tests/test/tcpstr2.pp svneol=native#text/plain
|
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/tcpstr2a.pp svneol=native#text/plain
|
||||||
tests/test/tcpstr3.pp svneol=native#text/plain
|
tests/test/tcpstr3.pp svneol=native#text/plain
|
||||||
tests/test/tcpstr4.pp svneol=native#text/plain
|
tests/test/tcpstr4.pp svneol=native#text/plain
|
||||||
|
@ -481,11 +481,30 @@ implementation
|
|||||||
orddef :
|
orddef :
|
||||||
begin
|
begin
|
||||||
{ char to string}
|
{ char to string}
|
||||||
if is_char(def_from) or
|
if is_char(def_from) then
|
||||||
is_widechar(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
|
begin
|
||||||
doconv:=tc_char_2_string;
|
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;
|
||||||
end;
|
end;
|
||||||
arraydef :
|
arraydef :
|
||||||
|
@ -1677,19 +1677,6 @@ implementation
|
|||||||
if (p.resultdef.typ=stringdef) and
|
if (p.resultdef.typ=stringdef) and
|
||||||
(tstringdef(def_to).stringtype=tstringdef(p.resultdef).stringtype) then
|
(tstringdef(def_to).stringtype=tstringdef(p.resultdef).stringtype) then
|
||||||
eq:=te_equal
|
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;
|
end;
|
||||||
setdef :
|
setdef :
|
||||||
begin
|
begin
|
||||||
|
110
tests/test/tcpstr20.pp
Normal file
110
tests/test/tcpstr20.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user