Browse Source

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

git-svn-id: trunk@14663 -
paul 15 years ago
parent
commit
74cc1e0bab
5 changed files with 30 additions and 7 deletions
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/htypechk.pas
  3. 5 5
      compiler/nadd.pas
  4. 1 1
      compiler/ncnv.pas
  5. 22 0
      tests/webtbs/tw15530.pp

+ 1 - 0
.gitattributes

@@ -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

+ 1 - 1
compiler/htypechk.pas

@@ -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;

+ 5 - 5
compiler/nadd.pas

@@ -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)

+ 1 - 1
compiler/ncnv.pas

@@ -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 - 0
tests/webtbs/tw15530.pp

@@ -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.