fcl-passrc: removed modeswitch ignoreinterfaces

git-svn-id: trunk@38698 -

packages/fcl-passrc/src/pasresolver.pp

@@ -4552,7 +4552,6 @@ begin
 end;
 
 procedure TPasResolver.FinishClassType(El: TPasClassType);
-{$IFDEF EnableInterfaces}
 type
   TMethResolution = record
     InterfaceIndex: integer;
@@ -4577,9 +4576,7 @@ var
   ResolvedEl: TPasResolverResult;
   ProcName, IntfProcName: String;
   Expr: TPasExpr;
-{$ENDIF}
 begin
-  {$IFDEF EnableInterfaces}
   Resolutions:=nil;
   if El.CustomData is TPasClassScope then
     begin
@@ -4698,7 +4695,6 @@ begin
         end;
       end;
     end;
-  {$ENDIF}
 
   if TopScope.Element=El then
     PopScope;
@@ -5450,7 +5446,6 @@ var
       end;
   end;
 
-  {$IFDEF EnableInterfaces}
   procedure CheckImplements;
   var
     i, j: Integer;
@@ -5536,7 +5531,6 @@ var
         ClassScope.Interfaces[j]:=PropEl;
       end;
   end;
-  {$ENDIF}
 
   procedure CheckStoredAccessor(Expr: TPasExpr; const IndexVal: TResEvalValue;
     const IndexResolved: TPasResolverResult);
@@ -5824,10 +5818,8 @@ begin
         RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),PropEl.WriteAccessor);
       end;
 
-    {$IFDEF EnableInterfaces}
     if length(PropEl.Implements)>0 then
       CheckImplements;
-    {$ENDIF}
 
     if PropEl.StoredAccessor<>nil then
       begin
@@ -5902,11 +5894,9 @@ var
   CanonicalSelf: TPasClassOfType;
   ParentDecls: TPasDeclarations;
   Decl: TPasElement;
-  {$IFDEF EnableInterfaces}
   j: integer;
   IntfType, IntfTypeRes: TPasType;
   ResIntfList: TFPList;
-  {$ENDIF}
 begin
   if aClass.IsForward then
     begin
@@ -5923,7 +5913,6 @@ begin
     exit;
     end;
 
-  {$IFDEF EnableInterfaces}
   case aClass.ObjKind of
   okClass:
     begin
@@ -5939,8 +5928,6 @@ begin
     end;
   okInterface:
     begin
-    if (msIgnoreInterfaces in CurrentParser.CurrentModeswitches) then
-      exit;
     if aClass.IsExternal then
       RaiseMsg(20180321115831,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
     if not (aClass.InterfaceType in [citCom,citCorba]) then
@@ -5950,7 +5937,6 @@ begin
   else
     RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
   end;
-  {$ENDIF}
 
   IsSealed:=false;
   for i:=0 to aClass.Modifiers.Count-1 do
@@ -5992,7 +5978,6 @@ begin
       end;
     okInterface:
       begin
-      {$IFDEF EnableInterfaces}
       if aClass.InterfaceType=citCom then
         begin
         if msDelphi in CurrentParser.CurrentModeswitches then
@@ -6010,7 +5995,6 @@ begin
               GetElementTypeName(AncestorClassEl),aClass);
           end;
         end;
-      {$ENDIF}
       end;
     end;
     end
@@ -6097,7 +6081,6 @@ begin
     end;
 
   // check interfaces
-  {$IFDEF EnableInterfaces}
   if aClass.Interfaces.Count>0 then
     begin
     if not (aClass.ObjKind in [okClass]) then
@@ -6133,7 +6116,6 @@ begin
     ClassScope.Interfaces:=TFPList.Create;
     ClassScope.Interfaces.Count:=aClass.Interfaces.Count;
     end;
-  {$ENDIF}
 end;
 
 procedure TPasResolver.FinishMethodResolution(El: TPasMethodResolution);
@@ -17540,28 +17522,8 @@ begin
 end;
 
 function TPasResolver.IsElementSkipped(El: TPasElement): boolean;
-{$IFNDEF EnableInterfaces}
-var
-  C: TClass;
-  aClass: TPasClassType;
-{$ENDIF}
 begin
-  {$IFDEF EnableInterfaces}
   Result:=El=nil;
-  {$ELSE}
-  while El<>nil do
-    begin
-    C:=El.ClassType;
-    if C.ClassType=TPasClassType then
-      begin
-      aClass:=TPasClassType(El);
-      if aClass.ObjKind=okInterface then
-        exit(true);
-      end;
-    El:=El.Parent;
-    end;
-  {$ENDIF}
-  Result:=false;
 end;
 
 function TPasResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;

packages/fcl-passrc/src/pscanner.pp

@@ -264,7 +264,6 @@ type
     msISOLikeMod,          { mod operation as it is required by an iso compatible compiler }
     msExternalClass,       { Allow external class definitions }
     msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
-    msIgnoreInterfaces,    { workaround til resolver/converter supports interfaces }
     msIgnoreAttributes     { workaround til resolver/converter supports attributes }
   );
   TModeSwitches = Set of TModeSwitch;
@@ -935,7 +934,6 @@ const
     'ISOMOD',
     'EXTERNALCLASS',
     'PREFIXEDATTRIBUTES',
-    'IGNOREINTERFACES',
     'IGNOREATTRIBUTES'
     );
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -371,9 +371,7 @@ type
     Procedure TestProcOverloadWithClassTypes;
     Procedure TestProcOverloadWithInhClassTypes;
     Procedure TestProcOverloadWithInhAliasClassTypes;
-    {$IFDEF EnableInterfaces}
     Procedure TestProcOverloadWithInterfaces;
-    {$ENDIF}
     Procedure TestProcOverloadBaseTypeOtherUnit;
     Procedure TestProcOverloadBaseProcNoHint;
     Procedure TestProcOverload_UnitOrderFail;
@@ -600,7 +598,6 @@ type
     Procedure TestMissingDefaultProperty;
 
     // class interfaces
-    {$IFDEF EnableInterfaces}
     Procedure TestClassInterface;
     Procedure TestClassInterfaceForward;
     Procedure TestClassInterfaceVarFail;
@@ -632,13 +629,6 @@ type
     Procedure TestClassInterface_Enumerator;
     Procedure TestClassInterface_PassTypecastClassToIntfAsVarParamFail;
     Procedure TestClassInterface_PassTypecastIntfToClassAsVarParamFail;
-    {$ELSE}
-    Procedure TestIgnoreInterfaces;
-    Procedure TestIgnoreInterfaceVarFail;
-    Procedure TestIgnoreInterfaceVar2Fail;
-    Procedure TestIgnoreInterfaceArgFail;
-    Procedure TestIgnoreInterfaceFunctionResultFail;
-    {$ENDIF}
 
     // with
     Procedure TestWithBlock1;
@@ -5569,7 +5559,6 @@ begin
   ParseProgram;
 end;
 
-{$ifdef EnableInterfaces}
 procedure TTestResolver.TestProcOverloadWithInterfaces;
 begin
   StartProgram(false);
@@ -5593,7 +5582,6 @@ begin
   '']);
   ParseProgram;
 end;
-{$ENDIF}
 
 procedure TTestResolver.TestProcOverloadBaseTypeOtherUnit;
 begin
@@ -10062,7 +10050,6 @@ begin
     nIllegalQualifierAfter);
 end;
 
-{$IFDEF EnableInterfaces}
 procedure TTestResolver.TestClassInterface;
 begin
   StartProgram(false);
@@ -10668,99 +10655,6 @@ begin
   CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
 end;
 
-{$ELSE}
-procedure TTestResolver.TestIgnoreInterfaces;
-begin
-  StartProgram(false);
-  Add([
-  '{$modeswitch ignoreinterfaces}',
-  'type',
-  '  TGUID = record end;',
-  '  IUnknown = interface;',
-  '  IUnknown = interface',
-  '    [''{00000000-0000-0000-C000-000000000046}'']',
-  '    function QueryInterface(const iid : tguid;out obj) : longint;',
-  '    function _AddRef : longint; cdecl;',
-  '    function _Release : longint; stdcall;',
-  '  end;',
-  '  IInterface = IUnknown;',
-  '  TObject = class',
-  '    ClassName: string;',
-  '  end;',
-  '  TInterfacedObject = class(TObject,IUnknown)',
-  '    RefCount : longint;',
-  '  end;',
-  'var i: TInterfacedObject;',
-  'begin',
-  '  i.ClassName:=''a'';',
-  '  i.RefCount:=3;',
-  '']);
-  ParseProgram;
-end;
-
-procedure TTestResolver.TestIgnoreInterfaceVarFail;
-begin
-  StartProgram(false);
-  Add([
-  '{$modeswitch ignoreinterfaces}',
-  'type',
-  '  IUnknown = interface',
-  '  end;',
-  'var i: IUnknown;',
-  'begin',
-  '']);
-  CheckResolverException('not yet implemented: IUnknown:TPasClassType',nNotYetImplemented);
-end;
-
-procedure TTestResolver.TestIgnoreInterfaceVar2Fail;
-begin
-  AddModuleWithIntfImplSrc('unit1.pas',
-    LinesToStr([
-    '{$modeswitch ignoreinterfaces}',
-    'type',
-    '  IUnknown = interface',
-    '  end;',
-    '']),
-    '');
-
-  StartProgram(true);
-  Add([
-  'uses unit1;',
-  'var i: IUnknown;',
-  'begin',
-  '']);
-  CheckResolverException('not yet implemented: IUnknown:TPasClassType',nNotYetImplemented);
-end;
-
-procedure TTestResolver.TestIgnoreInterfaceArgFail;
-begin
-  StartProgram(false);
-  Add([
-  '{$modeswitch ignoreinterfaces}',
-  'type',
-  '  IUnknown = interface',
-  '  end;',
-  'procedure DoIt(i: IUnknown); begin end;',
-  'begin',
-  '']);
-  CheckResolverException('not yet implemented: IUnknown:TPasClassType',nNotYetImplemented);
-end;
-
-procedure TTestResolver.TestIgnoreInterfaceFunctionResultFail;
-begin
-  StartProgram(false);
-  Add([
-  '{$modeswitch ignoreinterfaces}',
-  'type',
-  '  IUnknown = interface',
-  '  end;',
-  'function DoIt: IUnknown; begin end;',
-  'begin',
-  '']);
-  CheckResolverException('not yet implemented: IUnknown:TPasClassType',nNotYetImplemented);
-end;
-{$ENDIF}
-
 procedure TTestResolver.TestPropertyAssign;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -77,15 +77,11 @@ type
     procedure TestM_Class_PropertyOverride;
     procedure TestM_Class_MethodOverride;
     procedure TestM_Class_MethodOverride2;
-    {$IFDEF EnableInterfaces}
     procedure TestM_ClassInterface_Corba;
     procedure TestM_ClassInterface_NoHintsForMethod;
     procedure TestM_ClassInterface_NoHintsForImpl;
     procedure TestM_ClassInterface_Delegation;
     procedure TestM_ClassInterface_COM;
-    {$ELSE}
-    procedure TestM_ClassInterface_Ignore;
-    {$ENDIF}
     procedure TestM_TryExceptStatement;
 
     // single module hints
@@ -151,9 +147,9 @@ type
     procedure TestWP_ForInClass;
     procedure TestWP_AssertSysUtils;
     procedure TestWP_RangeErrorSysUtils;
-    {$IFDEF EnableInterfaces}
     procedure TestWP_ClassInterface;
-    {$ENDIF}
+    procedure TestWP_ClassInterface_Delegation;
+    procedure TestWP_ClassInterface_COM;
 
     // scope references
     procedure TestSR_Proc_UnitVar;
@@ -1057,7 +1053,6 @@ begin
   AnalyzeProgram;
 end;
 
-{$IFDEF EnableInterfaces}
 procedure TTestUseAnalyzer.TestM_ClassInterface_Corba;
 begin
   StartProgram(false);
@@ -1074,7 +1069,7 @@ begin
   '  strict private',
   '    procedure IUnknown.Run = Fly;',
   '    procedure {#tbird_fly_used}Fly; virtual; abstract;',
-  '    procedure {#tbird_walk_notused}Walk; virtual; abstract;',
+  '    procedure {#tbird_walk_used}Walk; virtual; abstract;',
   '  end;',
   '  {#teagle_used}TEagle = class(TBird)',
   '  strict private',
@@ -1156,7 +1151,7 @@ begin
   '  strict private',
   '    procedure IUnknown.Run = Fly;',
   '    procedure {#tbird_fly_used}Fly;',
-  '    procedure {#tbird_walk_notused}Walk;',
+  '    procedure {#tbird_walk_used}Walk;',
   '  end;',
   '  {#teagle_used}TEagle = class(TObject,IUnknown)',
   '  strict private',
@@ -1196,7 +1191,7 @@ begin
   '    function {#tbird_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
   '    function {#tbird_addref_used}_AddRef: Integer;',
   '    function {#tbird_release_used}_Release: Integer;',
-  '    procedure {#tbird_doit_notused}DoIt;',
+  '    procedure {#tbird_doit_used}DoIt;',
   '  end;',
   '  {#teagle_used}TEagle = class(TBird)',
   '  end;',
@@ -1217,41 +1212,9 @@ begin
   '']);
   AnalyzeProgram;
   CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "DoIt" not used');
-  CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,'Private method "TBird.DoIt" is never used');
   CheckUseAnalyzerUnexpectedHints;
 end;
 
-{$ELSE}
-procedure TTestUseAnalyzer.TestM_ClassInterface_Ignore;
-begin
-  StartProgram(false);
-  Add([
-  '{$modeswitch ignoreinterfaces}',
-  'type',
-  '  TGUID = record end;',
-  '  IUnknown = interface;',
-  '  IUnknown = interface',
-  '    [''{00000000-0000-0000-C000-000000000046}'']',
-  '    function QueryInterface(const iid : tguid;out obj) : longint;',
-  '    function _AddRef : longint; cdecl;',
-  '    function _Release : longint; stdcall;',
-  '  end;',
-  '  IInterface = IUnknown;',
-  '  TObject = class',
-  '    ClassName: string;',
-  '  end;',
-  '  TInterfacedObject = class(TObject,IUnknown)',
-  '    RefCount : longint;',
-  '  end;',
-  'var i: TInterfacedObject;',
-  'begin',
-  '  i.ClassName:=''a'';',
-  '  i.RefCount:=3;',
-  '']);
-  AnalyzeProgram;
-end;
-{$ENDIF}
-
 procedure TTestUseAnalyzer.TestM_TryExceptStatement;
 begin
   StartProgram(false);
@@ -2555,7 +2518,6 @@ begin
   AnalyzeWholeProgram;
 end;
 
-{$IFDEF EnableInterfaces}
 procedure TTestUseAnalyzer.TestWP_ClassInterface;
 begin
   StartProgram(false);
@@ -2590,7 +2552,84 @@ begin
   '']);
   AnalyzeWholeProgram;
 end;
-{$ENDIF}
+
+procedure TTestUseAnalyzer.TestWP_ClassInterface_Delegation;
+begin
+  StartProgram(false);
+  Add([
+  '{$interfaces corba}',
+  'type',
+  '  {#iunknown_used}IUnknown = interface',
+  '    procedure {#iunknown_run_used}Run;',
+  '    procedure {#iunknown_walk_notused}Walk;',
+  '  end;',
+  '  {#tobject_used}TObject = class',
+  '  end;',
+  '  {#tbird_used}TBird = class(TObject,IUnknown)',
+  '  strict private',
+  '    procedure IUnknown.Run = Fly;',
+  '    procedure {#tbird_fly_used}Fly;',
+  '    procedure {#tbird_walk_notused}Walk;',
+  '  end;',
+  '  {#teagle_used}TEagle = class(TObject,IUnknown)',
+  '  strict private',
+  '    {#teagle_fbird_used}FBird: TBird;',
+  '    property {#teagle_bird_used}Bird: TBird read FBird implements IUnknown;',
+  '  end;',
+  'procedure TBird.Fly; begin end;',
+  'procedure TBird.Walk; begin end;',
+  'var',
+  '  e: TEagle;',
+  '  i: IUnknown;',
+  'begin',
+  '  i:=e;',
+  '  i.Run;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_ClassInterface_COM;
+begin
+  StartProgram(false);
+  Add([
+  '{$interfaces com}',
+  'type',
+  '  {#tguid_used}TGuid = string;',
+  '  {#integer_used}integer = longint;',
+  '  {#iunknown_used}IUnknown = interface',
+  '    function {#iunknown_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
+  '    function {#iunknown_addref_used}_AddRef: Integer;',
+  '    function {#iunknown_release_used}_Release: Integer;',
+  '    procedure {#iunknown_doit_notused}DoIt;',
+  '  end;',
+  '  {#tobject_used}TObject = class',
+  '  end;',
+  '  {#tbird_used}TBird = class(TObject,IUnknown)',
+  '  strict private',
+  '    function {#tbird_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
+  '    function {#tbird_addref_used}_AddRef: Integer;',
+  '    function {#tbird_release_used}_Release: Integer;',
+  '    procedure {#tbird_doit_notused}DoIt;',
+  '  end;',
+  '  {#teagle_used}TEagle = class(TBird)',
+  '  end;',
+  'function TBird.QueryInterface(const iid: TGuid; out obj): Integer;',
+  'begin',
+  '  if iid='''' then obj:=nil;',
+  '  Result:=0;',
+  'end;',
+  'function TBird._AddRef: Integer; begin Result:=1; end;',
+  'function TBird._Release: Integer; begin Result:=2; end;',
+  'procedure TBird.DoIt; begin end;',
+  'var',
+  '  e: TEagle;',
+  '  i: IUnknown;',
+  'begin',
+  '  i:=e;',
+  '  if i=nil then ;',
+  '']);
+  AnalyzeWholeProgram;
+end;
 
 procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
 begin