paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 13:19:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

compiler: allow 'as' for dispinterface, allow comparisons of dispinterface and pointers (issue #0015530, issue #0015529)

Browse Source 
git-svn-id: trunk@14663 -
This commit is contained in:
paul 2010-01-16 11:37:25 +00:00
parent c9eea4ff5e
commit 74cc1e0bab
5 changed files with 30 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10223,6 +10223,7 @@ tests/webtbs/tw15446.pp svneol=native#text/plain
tests/webtbs/tw15453a.pp svneol=native#text/plain
tests/webtbs/tw15467.pp svneol=native#text/pascal
tests/webtbs/tw15504.pp svneol=native#text/plain
tests/webtbs/tw15530.pp svneol=native#text/pascal
tests/webtbs/tw1567.pp svneol=native#text/plain
tests/webtbs/tw1573.pp svneol=native#text/plain
tests/webtbs/tw1592.pp svneol=native#text/plain

2
compiler/htypechk.pas
View File

@ -281,7 +281,7 @@ implementation
begin
{ <> and = are defined for classes }
if (treetyp in [equaln,unequaln]) and
is_class_or_interface_or_objc(ld) then
is_class_or_interface_or_dispinterface_or_objc(ld) then
begin
allowed:=false;
exit;

10
compiler/nadd.pas
View File

@ -1564,18 +1564,18 @@ implementation
end
{ class or interface equation }
else if is_class_or_interface_or_objc(rd) or is_class_or_interface_or_objc(ld) then
else if is_class_or_interface_or_dispinterface_or_objc(rd) or is_class_or_interface_or_dispinterface_or_objc(ld) then
begin
if (nodetype in [equaln,unequaln]) then
begin
if is_class_or_interface_or_objc(rd) and is_class_or_interface_or_objc(ld) then
if is_class_or_interface_or_dispinterface_or_objc(rd) and is_class_or_interface_or_dispinterface_or_objc(ld) then
begin
if tobjectdef(rd).is_related(tobjectdef(ld)) then
inserttypeconv(right,left.resultdef)
else
inserttypeconv(left,right.resultdef);
end
else if is_class_or_interface_or_objc(rd) then
else if is_class_or_interface_or_dispinterface_or_objc(rd) then
inserttypeconv(left,right.resultdef)
else
inserttypeconv(right,left.resultdef);
@ -1599,7 +1599,7 @@ implementation
end
{ allows comperasion with nil pointer }
else if is_class_or_interface_or_objc(rd) or (rd.typ=classrefdef) then
else if is_class_or_interface_or_dispinterface_or_objc(rd) or (rd.typ=classrefdef) then
begin
if (nodetype in [equaln,unequaln]) then
inserttypeconv(left,right.resultdef)
@ -1607,7 +1607,7 @@ implementation
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
end
else if is_class_or_interface_or_objc(ld) or (ld.typ=classrefdef) then
else if is_class_or_interface_or_dispinterface_or_objc(ld) or (ld.typ=classrefdef) then
begin
if (nodetype in [equaln,unequaln]) then
inserttypeconv(right,left.resultdef)

2
compiler/ncnv.pas
View File

@ -3373,7 +3373,7 @@ implementation
CGMessage1(type_e_class_type_expected,left.resultdef.typename);
resultdef:=tclassrefdef(right.resultdef).pointeddef;
end
else if is_interface(right.resultdef) then
else if is_interface(right.resultdef) or is_dispinterface(right.resultdef) then
begin
{ left is a class }
if not(is_class(left.resultdef) or

22
tests/webtbs/tw15530.pp Normal file
View File

@ -0,0 +1,22 @@
{ %TARGET=win32}
program tw15530;
{$mode objfpc}
uses
ComObj;
type
IIE = dispinterface
['{0002DF05-0000-0000-C000-000000000046}']
property Visible: wordbool dispid 402;
end;
var
II: IIE;
begin
II := CreateOleObject('InternetExplorer.Application') as IIE;
if II <> nil then
;
end.