mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-29 12:40:25 +02:00
pastojs: removed modeswitch ignoreinterfaces
git-svn-id: trunk@38699 -
This commit is contained in:
Mattias Gaertner
parent
bebd127b91
commit
abd1b66977
@ -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}
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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]);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user