paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-13 05:59:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed (intf as tobject).ClassType, issue 38805

Browse Source
This commit is contained in:
mattias 2021-04-26 21:20:14 +00:00
parent cc0be33602
commit 978399db4a
4 changed files with 86 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -25432,6 +25432,7 @@ function TPasResolver.ResolvedElIsClassOrRecordInstance(
const ResolvedEl: TPasResolverResult): boolean;
var
TypeEl: TPasType;
C: TClass;
begin
Result:=false;
if ResolvedEl.BaseType<>btContext then exit;
@ -25444,10 +25445,14 @@ begin
else if TypeEl.ClassType=TPasRecordType then
else
exit;
if (ResolvedEl.IdentEl is TPasVariable)
or (ResolvedEl.IdentEl.ClassType=TPasArgument)
or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
exit(true);
if ResolvedEl.IdentEl<>nil then
begin
C:=ResolvedEl.IdentEl.ClassType;
if C.InheritsFrom(TPasVariable)
or (C=TPasArgument)
or (C=TPasResultElement) then
exit(true);
end;
end;
function TPasResolver.GetResolver(El: TPasElement): TPasResolver;

1
compiler/packages/fcl-passrc/tests/tcresolvegenerics.pas
View File

@ -157,6 +157,7 @@ type
procedure TestGenProc_TypeParamCntOverloadNoParams;
procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
procedure TestGenProc_ParamSpecWithT;
// ToDo: TestGenProc_ParamSpecWithTNestedType function Fly<T>(a: TBird<T>.TEvent; aSender: T): Word;
// ToDo: NestedResultAssign
// generic function infer types

5
compiler/packages/pastojs/src/fppas2js.pp
View File

@ -4478,6 +4478,9 @@ begin
AddElevatedLocal(El);
end;
end
else if ParentC=TPasImplExceptOn then
// except on var
RaiseVarModifierNotSupported(LocalVarModifiersAllowed)
else if ParentC=TImplementationSection then
// implementation var
RaiseVarModifierNotSupported(ImplementationVarModifiersAllowed)
@ -4489,7 +4492,7 @@ begin
else
begin
{$IFDEF VerbosePas2JS}
writeln('TPas2JSResolver.FinishVariable ',GetObjName(El),' Parent=',GetObjName(El.Parent));
writeln('TPas2JSResolver.FinishVariable ',GetObjPath(El));
{$ENDIF}
RaiseNotYetImplemented(20170324151259,El);
end;

72
compiler/packages/pastojs/tests/tcgenerics.pas
View File

@ -62,6 +62,7 @@ type
Procedure TestGen_CallUnitImplProc;
Procedure TestGen_IntAssignTemplVar;
Procedure TestGen_TypeCastDotField;
Procedure TestGen_Except;
// generic helper
procedure TestGen_HelperForArray;
@ -1950,6 +1951,77 @@ begin
'']));
end;
procedure TTestGenerics.TestGen_Except;
begin
StartProgram(false);
Add([
'type',
' TObject = class end;',
' generic TBird<T> = class',
' Field: T;',
' procedure Fly;',
' end;',
' Exception = class',
' end;',
' generic EBird<T> = class(Exception)',
' Id: T;',
' end;',
'var',
' b: specialize TBird<word>;',
'procedure TBird.Fly;',
'begin',
' try',
' except',
' on E: Exception do Fly;',
' on EBird: specialize EBird<word> do EBird.Id:=3;',
' else',
' Fly;',
' end;',
'end;',
'begin',
'']);
ConvertProgram;
CheckSource('TestGen_Except',
LinesToStr([ // statements
'rtl.createClass(this, "TObject", null, function () {',
' this.$init = function () {',
' };',
' this.$final = function () {',
' };',
'});',
'rtl.createClass(this, "Exception", this.TObject, function () {',
'});',
'rtl.createClass(this, "TBird$G1", this.TObject, function () {',
' this.$init = function () {',
' $mod.TObject.$init.call(this);',
' this.Field = 0;',
' };',
' this.Fly = function () {',
' try {} catch ($e) {',
' if ($mod.Exception.isPrototypeOf($e)) {',
' var E = $e;',
' this.Fly();',
' } else if ($mod.EBird$G1.isPrototypeOf($e)) {',
' var EBird = $e;',
' EBird.Id = 3;',
' } else {',
' this.Fly();',
' }',
' };',
' };',
'}, "TBird<System.Word>");',
'this.b = null;',
'rtl.createClass(this, "EBird$G1", this.Exception, function () {',
' this.$init = function () {',
' $mod.Exception.$init.call(this);',
' this.Id = 0;',
' };',
'}, "EBird<System.Word>");',
'']),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestGenerics.TestGen_HelperForArray;
begin
StartProgram(false);