diff --git a/compiler/packages/fcl-passrc/src/pasresolver.pp b/compiler/packages/fcl-passrc/src/pasresolver.pp index 5a48063..2d97413 100644 --- a/compiler/packages/fcl-passrc/src/pasresolver.pp +++ b/compiler/packages/fcl-passrc/src/pasresolver.pp @@ -4637,6 +4637,7 @@ var Proc: TPasProcedure; Store, SameScope: Boolean; ProcScope: TPasProcedureScope; + CurResolver: TPasResolver; procedure CountProcInSameModule; begin @@ -4667,28 +4668,35 @@ begin exit; // no hint end; case Data^.Kind of - fpkProc: - // proc hides a non proc - if (Data^.Proc.GetModule=El.GetModule) then - // forbidden within same module - RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier, - [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType) - else + fpkProc: + // proc hides a non proc + if (Data^.Proc.GetModule=El.GetModule) then + // forbidden within same module + RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier, + [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType) + else + begin + // give a hint + if Data^.Proc.Parent is TPasMembersType then begin - // give a hint - if Data^.Proc.Parent is TPasMembersType then - begin - if El.Visibility=visStrictPrivate then - else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then - else - LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier, - [GetElementSourcePosStr(El)],Data^.Proc.ProcType); - end; + if El.Visibility=visStrictPrivate then + else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then + else + LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier, + [GetElementSourcePosStr(El)],Data^.Proc.ProcType); end; - fpkMethod: - // method hides a non proc + end; + fpkMethod: + // method hides a non proc + begin + ProcScope:=TPasProcedureScope(Data^.Proc.CustomData); + CurResolver:=ProcScope.Owner as TPasResolver; + if msDelphi in CurResolver.CurrentParser.CurrentModeswitches then + // ok in delphi + else RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier, [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType); + end; end; exit; end; @@ -4911,8 +4919,12 @@ var C: TClass; i: Integer; OtherScope: TPasIdentifierScope; + IsDelphi: Boolean; begin if aName='' then exit(nil); + + IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches; + if Scope is TPasGroupScope then begin Group:=TPasGroupScope(Scope); @@ -4932,7 +4944,8 @@ begin RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El); end; - if (Kind=pikSimple) and (Group<>nil) and (El.ClassType<>TPasProperty) then + if (Kind=pikSimple) and (Group<>nil) and (El.ClassType<>TPasProperty) + and not IsDelphi then begin // check duplicate in ancestors and helpers for i:=1 to Group.Count-1 do diff --git a/compiler/packages/fcl-passrc/tests/tcresolver.pas b/compiler/packages/fcl-passrc/tests/tcresolver.pas index 3dc488a..acba75b 100644 --- a/compiler/packages/fcl-passrc/tests/tcresolver.pas +++ b/compiler/packages/fcl-passrc/tests/tcresolver.pas @@ -606,7 +606,8 @@ type Procedure TestClass_SubObject; Procedure TestClass_WithDoClassInstance; Procedure TestClass_ProcedureExternal; - Procedure TestClass_ReintroducePublicVarFail; + Procedure TestClass_ReintroducePublicVarObjFPCFail; + Procedure TestClass_ReintroducePublicVarDelphi; Procedure TestClass_ReintroducePrivateVar; Procedure TestClass_ReintroduceProc; Procedure TestClass_UntypedParam_TypeCast; @@ -10752,22 +10753,59 @@ begin ParseProgram; end; -procedure TTestResolver.TestClass_ReintroducePublicVarFail; +procedure TTestResolver.TestClass_ReintroducePublicVarObjFPCFail; begin StartProgram(false); - Add('type'); - Add(' TObject = class'); - Add(' public'); - Add(' Some: longint;'); - Add(' end;'); - Add(' TCar = class(tobject)'); - Add(' public'); - Add(' Some: longint;'); - Add(' end;'); - Add('begin'); + Add([ + 'type', + ' TObject = class', + ' public', + ' Some: longint;', + ' end;', + ' TCar = class(tobject)', + ' public', + ' Some: longint;', + ' end;', + 'begin']); CheckResolverException('Duplicate identifier "Some" at afile.pp(5,5)',nDuplicateIdentifier); end; +procedure TTestResolver.TestClass_ReintroducePublicVarDelphi; +begin + StartProgram(false); + Add([ + '{$mode delphi}', + 'type', + ' TObject = class', + ' public', + ' {#Obj_Some}Some: longint;', + ' {#Obj_Foo}Foo: word;', + ' function {#Obj_Bar}Bar: string;', + ' end;', + ' TCar = class(tobject)', + ' public', + ' {#Car_Some}Some: double;', + ' function {#Car_Foo}Foo: boolean;', + ' {#Car_Bar}Bar: single;', + ' end;', + 'function TObject.Bar: string;', + 'begin', + 'end;', + 'function TCar.Foo: boolean;', + 'begin', + ' {@Car_Some}Some:=3.3;', + ' {@Car_Bar}Bar:=4.3;', + ' inherited {@Obj_Bar}Bar;', + ' inherited {@Obj_Bar}Bar();', + ' inherited {@Obj_Foo}Foo := 4;', + ' if inherited {@Obj_Some}Some = 5 then ;', + 'end;', + 'var C: TCar;', + 'begin', + ' C.Some:=1.3;']); + ParseProgram; +end; + procedure TTestResolver.TestClass_ReintroducePrivateVar; begin StartProgram(false); diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index 046c0b4..4e217e2 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -520,6 +520,7 @@ type Procedure TestClass_OverloadsAncestor; Procedure TestClass_OverloadConstructor; Procedure TestClass_OverloadDelphiOverride; + Procedure TestClass_ReintroduceVarDelphi; Procedure TestClass_ReintroducedVar; Procedure TestClass_RaiseDescendant; Procedure TestClass_ExternalMethod; @@ -13681,6 +13682,94 @@ begin ''])); end; +procedure TTestModule.TestClass_ReintroduceVarDelphi; +begin + StartProgram(false); + Add([ + '{$mode delphi}', + 'type', + ' TObject = class end;', + ' TAnimal = class', + ' public', + ' {#animal_a}A: longint;', + ' function {#animal_b}B: longint;', + ' end;', + ' TBird = class(TAnimal)', + ' public', + ' {#bird_a}A: double;', + ' {#bird_b}B: boolean;', + ' end;', + ' TEagle = class(TBird)', + ' public', + ' function {#eagle_a}A: boolean;', + ' {#eagle_b}B: double;', + ' end;', + 'function TAnimal.B: longint;', + 'begin', + 'end;', + 'function TEagle.A: boolean;', + 'begin', + ' {@eagle_b}B:=3.3;', + ' {@eagle_a}A();', + ' TBird(Self).{@bird_b}B:=true;', + ' TAnimal(Self).{@animal_a}A:=17;', + ' inherited {@bird_b}B:=inherited {bird_a}A>1;', // Delphi allows only inherited + 'end;', + 'var', + ' e: TEagle;', + 'begin', + ' e.{@eagle_b}B:=5.3;', + ' if e.{@eagle_a}A then ;', + '']); + ConvertProgram; + CheckSource('TestClass_ReintroduceVarDelphi', + LinesToStr([ // statements + 'rtl.createClass($mod, "TObject", null, function () {', + ' this.$init = function () {', + ' };', + ' this.$final = function () {', + ' };', + '});', + 'rtl.createClass($mod, "TAnimal", $mod.TObject, function () {', + ' this.$init = function () {', + ' $mod.TObject.$init.call(this);', + ' this.A = 0;', + ' };', + ' this.B = function () {', + ' var Result = 0;', + ' return Result;', + ' };', + '});', + 'rtl.createClass($mod, "TBird", $mod.TAnimal, function () {', + ' this.$init = function () {', + ' $mod.TAnimal.$init.call(this);', + ' this.A$1 = 0.0;', + ' this.B$1 = false;', + ' };', + '});', + 'rtl.createClass($mod, "TEagle", $mod.TBird, function () {', + ' this.$init = function () {', + ' $mod.TBird.$init.call(this);', + ' this.B$2 = 0.0;', + ' };', + ' this.A$2 = function () {', + ' var Result = false;', + ' this.B$2 = 3.3;', + ' this.A$2();', + ' this.B$1 = true;', + ' this.A = 17;', + ' this.B$1 = this.A$1 > 1;', + ' return Result;', + ' };', + '});', + 'this.e = null;', + '']), + LinesToStr([ // $mod.$main + '$mod.e.B$2 = 5.3;', + 'if ($mod.e.A$2()) ;', + ''])); +end; + procedure TTestModule.TestClass_ReintroducedVar; begin StartProgram(false);