mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-08 20:57:24 +01:00
* allow exlicit type conversions from class/interface to enums in Delphi
mode (mantis #11859) * cleaned up some superfluous "eq=te_incompatible" checks (probably from copy/pasting conditions from elsewhere) git-svn-id: trunk@13050 -
This commit is contained in:
parent
25c5d2658c
commit
5b08047d1c
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8746,6 +8746,7 @@ tests/webtbs/tw11846b.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw11848.pp svneol=native#text/plain
|
tests/webtbs/tw11848.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11849.pp svneol=native#text/plain
|
tests/webtbs/tw11849.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11852.pp svneol=native#text/plain
|
tests/webtbs/tw11852.pp svneol=native#text/plain
|
||||||
|
tests/webtbs/tw11859.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11861.pp svneol=native#text/plain
|
tests/webtbs/tw11861.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11862.pp svneol=native#text/plain
|
tests/webtbs/tw11862.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11896.pp svneol=native#text/plain
|
tests/webtbs/tw11896.pp svneol=native#text/plain
|
||||||
|
|||||||
@ -614,8 +614,18 @@ implementation
|
|||||||
begin
|
begin
|
||||||
{ ugly, but delphi allows it }
|
{ ugly, but delphi allows it }
|
||||||
if (cdo_explicit in cdoptions) and
|
if (cdo_explicit in cdoptions) and
|
||||||
(m_delphi in current_settings.modeswitches) and
|
(m_delphi in current_settings.modeswitches) then
|
||||||
(eq=te_incompatible) then
|
begin
|
||||||
|
doconv:=tc_int_2_int;
|
||||||
|
eq:=te_convert_l1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
objectdef:
|
||||||
|
begin
|
||||||
|
{ ugly, but delphi allows it }
|
||||||
|
if (m_delphi in current_settings.modeswitches) and
|
||||||
|
is_class_or_interface_or_dispinterface(def_from) and
|
||||||
|
(cdo_explicit in cdoptions) then
|
||||||
begin
|
begin
|
||||||
doconv:=tc_int_2_int;
|
doconv:=tc_int_2_int;
|
||||||
eq:=te_convert_l1;
|
eq:=te_convert_l1;
|
||||||
@ -962,8 +972,7 @@ implementation
|
|||||||
{ 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 (((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)
|
||||||
@ -1263,8 +1272,7 @@ implementation
|
|||||||
eq:=te_convert_l2;
|
eq:=te_convert_l2;
|
||||||
end
|
end
|
||||||
{ ugly, but delphi allows it }
|
{ ugly, but delphi allows it }
|
||||||
else if (eq=te_incompatible) and
|
else if (def_from.typ in [orddef,enumdef]) and
|
||||||
(def_from.typ in [orddef,enumdef]) and
|
|
||||||
(m_delphi in current_settings.modeswitches) and
|
(m_delphi in current_settings.modeswitches) and
|
||||||
(cdo_explicit in cdoptions) then
|
(cdo_explicit in cdoptions) then
|
||||||
begin
|
begin
|
||||||
|
|||||||
20
tests/webtbs/tw11859.pp
Normal file
20
tests/webtbs/tw11859.pp
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
{$ifdef fpc}
|
||||||
|
{$mode delphi}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$z4}
|
||||||
|
type
|
||||||
|
tenum = (ea,eb,ec);
|
||||||
|
|
||||||
|
var
|
||||||
|
c1, c2: tobject;
|
||||||
|
e: tenum;
|
||||||
|
begin
|
||||||
|
{$r-}
|
||||||
|
c1:=tobject(pointer(12345));
|
||||||
|
e:=tenum(c1);
|
||||||
|
c2:=tobject(e);
|
||||||
|
if (c1<>c2) then
|
||||||
|
halt(1);
|
||||||
|
end.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user