Browse Source

pastojs: removed modeswitch ignoreinterfaces

git-svn-id: trunk@38699 -
Mattias Gaertner 7 years ago
parent
commit
abd1b66977

+ 0 - 15
packages/pastojs/src/fppas2js.pp

@@ -959,7 +959,6 @@ const
     msDelphi,msObjfpc,
     msHintDirective,msNestedComment,
     msExternalClass,
-    msIgnoreInterfaces,
     msIgnoreAttributes];
 
   msAllPas2jsBoolSwitches = [
@@ -2052,11 +2051,6 @@ begin
       begin
       ClassEl:=TPasClassType(El);
       if ClassEl.IsForward then continue;
-      {$IFDEF EnableInterfaces}
-      {$ELSE}
-      if ClassEl.ObjKind=okInterface then
-        continue;
-      {$ENDIF}
       ClassScope:=El.CustomData as TPas2JSClassScope;
       OldScopeCount:=FOverloadScopes.Count;
 
@@ -2352,11 +2346,9 @@ begin
 end;
 
 procedure TPas2JSResolver.FinishClassType(El: TPasClassType);
-{$IFDEF EnableInterfaces}
 var
   Scope, CurScope: TPas2JSClassScope;
   Value: TResEvalValue;
-{$ENDIF}
 begin
   inherited FinishClassType(El);
   if El.IsExternal then
@@ -2371,7 +2363,6 @@ begin
   if El.IsForward then
     exit;
 
-  {$IFDEF EnableInterfaces}
   //writeln('TPas2JSResolver.FinishClassType START ',GetObjName(El));
   Scope:=El.CustomData as TPas2JSClassScope;
   case El.ObjKind of
@@ -2412,7 +2403,6 @@ begin
     end;
   end;
   //writeln('TPas2JSResolver.FinishClassType END ',GetObjName(El));
-  {$ENDIF}
 end;
 
 procedure TPas2JSResolver.FinishArrayType(El: TPasArrayType);
@@ -9412,11 +9402,6 @@ var
   NeedInitFunction: Boolean;
 begin
   Result:=nil;
-  {$IFDEF EnableInterfaces}
-  {$ELSE}
-  if El.ObjKind=okInterface then
-    exit;
-  {$ENDIF}
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.ConvertClassType START ',GetObjName(El));
   {$ENDIF}

+ 2 - 8
packages/pastojs/src/pas2jsfiler.pp

@@ -72,6 +72,7 @@ const
     1: initial version
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
        - pcsfAncestorResolved
+       - removed msIgnoreInterfaces
   }
 
   BuiltInNodeName = 'BuiltIn';
@@ -161,7 +162,6 @@ const
     'ISOLikeMod',
     'ExternalClass',
     'PrefixedAttributes',
-    'IgnoreInterfaces',
     'IgnoreAttributes'
     );
 
@@ -1360,7 +1360,7 @@ begin
     msISOLikeMod: Result:=43;
     msExternalClass: Result:=44;
     msPrefixedAttributes: Result:=45;
-    msIgnoreInterfaces: Result:=46;
+    // msIgnoreInterfaces: Result:=46;
     msIgnoreAttributes: Result:=47;
   end;
 end;
@@ -3341,11 +3341,9 @@ var
   i: Integer;
   aClass: TPasClassType;
   CanonicalClassOf: TPasClassOfType;
-  {$IFDEF EnableInterfaces}
   ScopeIntf: TFPList;
   o: TObject;
   SubObj: TJSONObject;
-  {$ENDIF}
 begin
   WriteIdentifierScope(Obj,Scope,aContext);
   aClass:=Scope.Element as TPasClassType;
@@ -3383,7 +3381,6 @@ begin
       AddReferenceToArray(Arr,Scope.AbstractProcs[i]);
     end;
 
-  {$IFDEF EnableInterfaces}
   if Scope.GUID<>'' then
     Obj.Add('SGUID',Scope.GUID);
 
@@ -3411,7 +3408,6 @@ begin
         RaiseMsg(20180325111939,aClass,IntToStr(i)+':'+GetObjName(TObject(aClass.Interfaces[i]))+' '+GetObjName(o));
       end;
     end;
-  {$ENDIF}
 end;
 
 procedure TPCUWriter.WriteClassType(Obj: TJSONObject; El: TPasClassType;
@@ -6721,9 +6717,7 @@ begin
     end
   else if aClass.Interfaces.Count>0 then
     begin
-    {$IFDEF EnableInterfaces}
     RaiseMsg(20180325131248,aClass);
-    {$ENDIF}
     end;
 end;
 

+ 0 - 25
packages/pastojs/tests/tcfiler.pas

@@ -153,11 +153,7 @@ type
     procedure TestPC_ClassConstructor;
     procedure TestPC_Initialization;
     procedure TestPC_BoolSwitches;
-    {$IFDEF EnableInterfaces}
     procedure TestPC_ClassInterface;
-    {$ELSE}
-    procedure TestPC_IgnoreInterface;
-    {$ENDIF}
     procedure TestPC_IgnoreAttributes;
 
     procedure TestPC_UseUnit;
@@ -1960,7 +1956,6 @@ begin
   WriteReadUnit;
 end;
 
-{$IFDEF EnableInterfaces}
 procedure TTestPrecompile.TestPC_ClassInterface;
 begin
   StartUnit(false);
@@ -1997,26 +1992,6 @@ begin
   WriteReadUnit;
 end;
 
-{$ELSE}
-procedure TTestPrecompile.TestPC_IgnoreInterface;
-begin
-  StartUnit(false);
-  Add([
-  'interface',
-  '{$modeswitch ignoreinterfaces}',
-  'type',
-  '  TIntf = interface',
-  '    function GetItems(Index: longint): longint;',
-  '    procedure SetItems(Index: longint; Value: longint);',
-  '    property Items[Index: longint]: longint read GetItems write SetItems;',
-  '  end;',
-  'implementation',
-  'end.',
-  '']);
-  WriteReadUnit;
-end;
-{$ENDIF}
-
 procedure TTestPrecompile.TestPC_IgnoreAttributes;
 begin
   StartUnit(false);

+ 0 - 79
packages/pastojs/tests/tcmodules.pas

@@ -475,7 +475,6 @@ type
     Procedure TestExternalClass_BracketAccessor_Index;
 
     // class interfaces
-    {$IFDEF EnableInterfaces}
     Procedure TestClassInterface_Corba;
     Procedure TestClassInterface_ProcExternalFail;
     Procedure TestClassInterface_Overloads;
@@ -504,9 +503,6 @@ type
     Procedure TestClassInterface_COM_ArrayOfIntfFail;
     Procedure TestClassInterface_COM_RecordIntfFail;
     Procedure TestClassInterface_COM_UnitInitialization;
-    {$ELSE}
-    Procedure TestClassInterface_Ignore;
-    {$ENDIF}
 
     // proc types
     Procedure TestProcType;
@@ -598,10 +594,8 @@ type
     Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses2;
     Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses3;
     Procedure TestRTTI_TypeInfo_FunctionClassType;
-    {$IFDEF EnableInterfaces}
     Procedure TestRTTI_Interface_Corba;
     Procedure TestRTTI_Interface_COM;
-    {$ENDIF}
 
     // Resourcestring
     Procedure TestResourcestringProgram;
@@ -12009,9 +12003,7 @@ begin
   Add([
   '{$modeswitch externalclass}',
   'type',
-  {$IFDEF EnableInterfaces}
   '  IUnknown = interface end;',
-  {$ENDIF}
   '  TObject = class',
   '  end;',
   '  TChild = class',
@@ -12031,9 +12023,7 @@ begin
   '  ChildA: TExtChildA;',
   '  RootB: TExtRootB;',
   '  ChildB: TExtChildB;',
-  {$IFDEF EnableInterfaces}
   '  i: IUnknown;',
-  {$ENDIF}
   'begin',
   '  obj:=tobject(roota);',
   '  obj:=tobject(childa);',
@@ -12043,16 +12033,12 @@ begin
   '  roota:=textroota(rootb);',
   '  roota:=textroota(childb);',
   '  childa:=textchilda(textroota(obj));',
-  {$IFDEF EnableInterfaces}
   '  roota:=TExtRootA(i)',
-  {$ENDIF}
   '']);
   ConvertProgram;
   CheckSource('TestExternalClass_TypeCastToRootClass',
     LinesToStr([ // statements
-    {$IFDEF EnableInterfaces}
     'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E00-3000-8000-000000000000}", [], null);',
-    {$ENDIF}
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  };',
@@ -12067,9 +12053,7 @@ begin
     'this.ChildA = null;',
     'this.RootB = null;',
     'this.ChildB = null;',
-    {$IFDEF EnableInterfaces}
     'this.i = null;',
-    {$ENDIF}
     '']),
     LinesToStr([ // $mod.$main
     '$mod.Obj = $mod.RootA;',
@@ -12080,9 +12064,7 @@ begin
     '$mod.RootA = $mod.RootB;',
     '$mod.RootA = $mod.ChildB;',
     '$mod.ChildA = $mod.Obj;',
-    {$IFDEF EnableInterfaces}
     '$mod.RootA = $mod.i;',
-    {$ENDIF}
     '']));
 end;
 
@@ -12363,7 +12345,6 @@ begin
     '']));
 end;
 
-{$IFDEF EnableInterfaces}
 procedure TTestModule.TestClassInterface_Corba;
 begin
   StartProgram(false);
@@ -14074,63 +14055,6 @@ begin
     );
 end;
 
-{$ELSE}
-procedure TTestModule.TestClassInterface_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;',
-  '']);
-  ConvertProgram;
-  CheckSource('TestClassInterface_Ignore',
-    LinesToStr([ // statements
-    'this.TGUID = function (s) {',
-    '  this.$equal = function (b) {',
-    '    return true;',
-    '  };',
-    '};',
-    'rtl.createClass($mod, "TObject", null, function () {',
-    '  this.$init = function () {',
-    '    this.ClassName = "";',
-    '  };',
-    '  this.$final = function () {',
-    '  };',
-    '});',
-    'rtl.createClass($mod, "TInterfacedObject", $mod.TObject, function () {',
-    '  this.$init = function () {',
-    '    $mod.TObject.$init.call(this);',
-    '    this.RefCount = 0;',
-    '  };',
-    '});',
-    'this.i = null;',
-    '']),
-    LinesToStr([ // $mod.$main
-    '$mod.i.ClassName = "a";',
-    '$mod.i.RefCount = 3;',
-    '']));
-end;
-{$ENDIF}
-
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);
@@ -18436,7 +18360,6 @@ begin
     '']));
 end;
 
-{$IFDEF EnableInterfaces}
 procedure TTestModule.TestRTTI_Interface_Corba;
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
@@ -18563,8 +18486,6 @@ begin
     '']));
 end;
 
-{$ENDIF}
-
 procedure TTestModule.TestResourcestringProgram;
 begin
   StartProgram(false);

+ 0 - 39
packages/pastojs/tests/tcprecompile.pas

@@ -56,11 +56,7 @@ type
     procedure TestPCU_UnitCycle;
     procedure TestPCU_ClassForward;
     procedure TestPCU_ClassConstructor;
-    {$IFDEF EnableInterfaces}
     procedure TestPCU_ClassInterface;
-    {$ELSE}
-    procedure TestPCU_IgnoreInterface;
-    {$ENDIF}
   end;
 
 function LinesToList(const Lines: array of string): TStringList;
@@ -320,7 +316,6 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
-{$IFDEF EnableInterfaces}
 procedure TTestCLI_Precompile.TestPCU_ClassInterface;
 begin
   AddUnit('src/system.pp',[
@@ -388,40 +383,6 @@ begin
     'end.']);
   CheckPrecompile('test1.pas','src');
 end;
-{$ELSE}
-procedure TTestCLI_Precompile.TestPCU_IgnoreInterface;
-begin
-  AddUnit('src/system.pp',[
-    'type integer = longint;',
-    'procedure Writeln; varargs;'],
-    ['procedure Writeln; begin end;']);
-  AddUnit('src/unit1.pp',[
-    'type',
-    '  IIntf = interface',
-    '    function GetItems: longint;',
-    '    procedure SetItems(Index: longint; Value: longint);',
-    '    property Items[Index: longint]: longint read GetItems write SetItems;',
-    '  end;',
-    ''],[
-    '']);
-  AddUnit('src/unit2.pp',[
-    'uses unit1;',
-    'type',
-    '  IAlias = IIntf;',
-    '  TObject = class end;',
-    '  TBird = class(TObject,IIntf) end;',
-    ''],[
-    '']);
-  AddFile('test1.pas',[
-    'uses unit2;',
-    'type IAlias2 = IAlias;',
-    'var b: TBird;',
-    'begin',
-    '  if b=nil then ;',
-    'end.']);
-  CheckPrecompile('test1.pas','src');
-end;
-{$ENDIF}
 
 Initialization
   RegisterTests([TTestCLI_Precompile]);