* do not search variant operators when looking for an overloaded

operator for a non-variant type (was already intended that way,
    but checks didn't work) (mantis #7070) + tests
  * some tab->spaces in defcmp.pas

git-svn-id: trunk@7359 -
This commit is contained in:
Jonas Maebe 2007-05-16 13:59:35 +00:00
parent fdc813db9a
commit 6555f37cff
5 changed files with 91 additions and 20 deletions

3
.gitattributes vendored
View File

@ -7285,6 +7285,7 @@ tests/webtbf/tw6686.pp svneol=native#text/plain
tests/webtbf/tw6796.pp svneol=native#text/plain tests/webtbf/tw6796.pp svneol=native#text/plain
tests/webtbf/tw6922.pp svneol=native#text/plain tests/webtbf/tw6922.pp svneol=native#text/plain
tests/webtbf/tw6970.pp svneol=native#text/plain tests/webtbf/tw6970.pp svneol=native#text/plain
tests/webtbf/tw7070.pp svneol=native#text/plain
tests/webtbf/tw7322.pp svneol=native#text/plain tests/webtbf/tw7322.pp svneol=native#text/plain
tests/webtbf/tw7438.pp svneol=native#text/plain tests/webtbf/tw7438.pp svneol=native#text/plain
tests/webtbf/tw7438a.pp svneol=native#text/plain tests/webtbf/tw7438a.pp svneol=native#text/plain
@ -8115,6 +8116,8 @@ tests/webtbs/tw6977.pp svneol=native#text/plain
tests/webtbs/tw6980.pp svneol=native#text/plain tests/webtbs/tw6980.pp svneol=native#text/plain
tests/webtbs/tw6989.pp svneol=native#text/plain tests/webtbs/tw6989.pp svneol=native#text/plain
tests/webtbs/tw7006.pp svneol=native#text/plain tests/webtbs/tw7006.pp svneol=native#text/plain
tests/webtbs/tw7070a.pp svneol=native#text/plain
tests/webtbs/tw7070b.pp svneol=native#text/plain
tests/webtbs/tw7071.pp svneol=native#text/plain tests/webtbs/tw7071.pp svneol=native#text/plain
tests/webtbs/tw7100.pp svneol=native#text/plain tests/webtbs/tw7100.pp svneol=native#text/plain
tests/webtbs/tw7104.pp svneol=native#text/plain tests/webtbs/tw7104.pp svneol=native#text/plain

View File

@ -657,7 +657,8 @@ implementation
begin begin
subeq:=compare_defs_ext(tarraydef(def_from).elementdef, subeq:=compare_defs_ext(tarraydef(def_from).elementdef,
tarraydef(def_to).elementdef, tarraydef(def_to).elementdef,
arrayconstructorn,hct,hpd,[cdo_check_operator]); { reason for cdo_allow_variant: see webtbs/tw7070a and webtbs/tw7070b }
arrayconstructorn,hct,hpd,[cdo_check_operator,cdo_allow_variant]);
if (subeq>=te_equal) then if (subeq>=te_equal) then
begin begin
doconv:=tc_equal; doconv:=tc_equal;
@ -892,23 +893,23 @@ implementation
end; end;
end; end;
{ allow explicit typecasts from ordinals to pointer. { allow explicit typecasts from ordinals to pointer.
Support for delphi compatibility Support for delphi compatibility
Support constructs like pointer(cardinal-cardinal) or pointer(longint+cardinal) where Support constructs like pointer(cardinal-cardinal) or pointer(longint+cardinal) where
the result of the ordinal operation is int64 also on 32 bit platforms. the result of the ordinal operation is int64 also on 32 bit platforms.
It is also used by the compiler internally for inc(pointer,ordinal) } It is also used by the compiler internally for inc(pointer,ordinal) }
if (eq=te_incompatible) and if (eq=te_incompatible) and
not is_void(def_from) and not is_void(def_from) and
( (
( (
(cdo_explicit in cdoptions) and (cdo_explicit in cdoptions) and
( (
(m_delphi in current_settings.modeswitches) or (m_delphi in current_settings.modeswitches) or
{ Don't allow pchar(char) in fpc modes } { Don't allow pchar(char) in fpc modes }
is_integer(def_from) is_integer(def_from)
) )
) or ) or
(cdo_internal in cdoptions) (cdo_internal in cdoptions)
) then ) then
begin begin
doconv:=tc_int_2_int; doconv:=tc_int_2_int;
eq:=te_convert_l1; eq:=te_convert_l1;
@ -918,14 +919,14 @@ implementation
enumdef : enumdef :
begin begin
{ allow explicit typecasts from enums to pointer. { allow explicit typecasts from enums to pointer.
Support for delphi compatibility Support for delphi compatibility
} }
if (eq=te_incompatible) and if (eq=te_incompatible) and
(((cdo_explicit in cdoptions) and (((cdo_explicit in cdoptions) and
(m_delphi in current_settings.modeswitches) (m_delphi in current_settings.modeswitches)
) or ) or
(cdo_internal in cdoptions) (cdo_internal in cdoptions)
) then ) then
begin begin
doconv:=tc_int_2_int; doconv:=tc_int_2_int;
eq:=te_convert_l1; eq:=te_convert_l1;
@ -1332,6 +1333,13 @@ implementation
{ if we didn't find an appropriate type conversion yet { if we didn't find an appropriate type conversion yet
then we search also the := operator } then we search also the := operator }
if (eq=te_incompatible) and if (eq=te_incompatible) and
{ make sure there is not a single variant if variants }
{ are not allowed (otherwise if only cdo_check_operator }
{ and e.g. fromdef=stringdef and todef=variantdef, then }
{ the test will still succeed }
((cdo_allow_variant in cdoptions) or
((def_from.typ<>variantdef) and (def_to.typ<>variantdef))
) and
( (
{ Check for variants? } { Check for variants? }
( (
@ -1341,8 +1349,8 @@ implementation
{ Check for operators? } { Check for operators? }
( (
(cdo_check_operator in cdoptions) and (cdo_check_operator in cdoptions) and
((def_from.typ in [objectdef,recorddef,arraydef,stringdef,variantdef]) or ((def_from.typ in [objectdef,recorddef,arraydef,stringdef]) or
(def_to.typ in [objectdef,recorddef,arraydef,stringdef,variantdef])) (def_to.typ in [objectdef,recorddef,arraydef,stringdef]))
) )
) then ) then
begin begin

18
tests/webtbf/tw7070.pp Normal file
View File

@ -0,0 +1,18 @@
{ %fail }
program varistr;
{$ifdef fpc}
{$mode delphi}
{$h+}
{$endif}
var
str: string;
begin
str := 'something';
if not str = 'hello' then
writeln('test')
end.

21
tests/webtbs/tw7070a.pp Normal file
View File

@ -0,0 +1,21 @@
{ %norun }
{$ifdef fpc}
{$mode delphi}
{$h+}
{$endif}
uses
Variants;
procedure test(const a: array of string);
begin
end;
var
a,b: variant;
begin
a:=1;
b:=2;
test([a,b]);
end.

21
tests/webtbs/tw7070b.pp Normal file
View File

@ -0,0 +1,21 @@
{ %norun }
{$ifdef fpc}
{$mode delphi}
{$h+}
{$endif}
uses
Variants;
procedure test(const a: array of variant);
begin
end;
var
a,b: longint;
begin
a:=1;
b:=2;
test([a,b]);
end.