paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 20:29:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: filer: generic proc type

Browse Source 
git-svn-id: trunk@47241 -
(cherry picked from commit 42e48d016b)
This commit is contained in:
Mattias Gaertner 2020-10-28 19:07:22 +00:00 committed by Florian Klämpfl
parent 5ac2d9ebc8
commit 8e04dc11dd
2 changed files with 58 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
packages/pastojs/src/pas2jsfiler.pp
View File

@ -857,6 +857,7 @@ type
procedure WriteClassType(Obj: TJSONObject; El: TPasClassType; aContext: TPCUWriterContext); virtual;
procedure WriteArgument(Obj: TJSONObject; El: TPasArgument; aContext: TPCUWriterContext); virtual;
procedure WriteProcTypeModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TProcTypeModifiers); virtual;
procedure WriteProcTypeScope(Obj: TJSONObject; Scope: TPas2JSProcTypeScope; aContext: TPCUWriterContext); virtual;
procedure WriteProcedureType(Obj: TJSONObject; El: TPasProcedureType; aContext: TPCUWriterContext); virtual;
procedure WriteResultElement(Obj: TJSONObject; El: TPasResultElement; aContext: TPCUWriterContext); virtual;
procedure WriteFunctionType(Obj: TJSONObject; El: TPasFunctionType; aContext: TPCUWriterContext); virtual;
@ -1172,6 +1173,7 @@ type
procedure ReadArgument(Obj: TJSONObject; El: TPasArgument; aContext: TPCUReaderContext); virtual;
function ReadProcTypeModifiers(Obj: TJSONObject; El: TPasElement;
const PropName: string; const DefaultValue: TProcTypeModifiers): TProcTypeModifiers; virtual;
procedure ReadProcTypeScope(Obj: TJSONObject; Scope: TPas2JSProcTypeScope; aContext: TPCUReaderContext); virtual;
procedure ReadProcedureType(Obj: TJSONObject; El: TPasProcedureType; aContext: TPCUReaderContext); virtual;
procedure ReadResultElement(Obj: TJSONObject; El: TPasResultElement; aContext: TPCUReaderContext); virtual;
procedure ReadFunctionType(Obj: TJSONObject; El: TPasFunctionType; aContext: TPCUReaderContext); virtual;
@ -4334,6 +4336,12 @@ begin
AddArrayFlag(Obj,Arr,PropName,PCUProcTypeModifierNames[f],f in Value);
end;
procedure TPCUWriter.WriteProcTypeScope(Obj: TJSONObject;
Scope: TPas2JSProcTypeScope; aContext: TPCUWriterContext);
begin
WriteIdentifierScope(Obj,Scope,aContext);
end;
procedure TPCUWriter.WriteProcedureType(Obj: TJSONObject;
El: TPasProcedureType; aContext: TPCUWriterContext);
begin
@ -4343,6 +4351,8 @@ begin
if El.CallingConvention<>ccDefault then
Obj.Add('Call',PCUCallingConventionNames[El.CallingConvention]);
WriteProcTypeModifiers(Obj,'Modifiers',El.Modifiers,GetDefaultProcTypeModifiers(El));
if El.CustomData is TPas2JSProcTypeScope then
WriteProcTypeScope(Obj,TPas2JSProcTypeScope(El.CustomData),aContext);
end;
procedure TPCUWriter.WriteResultElement(Obj: TJSONObject;
@ -8870,12 +8880,20 @@ begin
end;
end;
procedure TPCUReader.ReadProcTypeScope(Obj: TJSONObject;
Scope: TPas2JSProcTypeScope; aContext: TPCUReaderContext);
begin
ReadIdentifierScope(Obj,Scope,aContext);
Scope.GenericStep:=psgsImplementationParsed;
end;
procedure TPCUReader.ReadProcedureType(Obj: TJSONObject; El: TPasProcedureType;
aContext: TPCUReaderContext);
var
s: string;
Found: Boolean;
c: TCallingConvention;
Scope: TPas2JSProcTypeScope;
begin
ReadPasElement(Obj,El,aContext);
ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
@ -8898,6 +8916,13 @@ begin
end;
El.Modifiers:=ReadProcTypeModifiers(Obj,El,'Modifiers',GetDefaultProcTypeModifiers(El));
if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
begin
Scope:=TPas2JSProcTypeScope(Resolver.CreateScope(El,TPas2JSProcTypeScope));
El.CustomData:=Scope;
ReadProcTypeScope(Obj,Scope,aContext);
end;
ReadSpecializations(Obj,El);
end;

33
packages/pastojs/tests/tcfiler.pas
View File

@ -227,6 +227,7 @@ type
procedure TestPC_Specialize_ClassForward;
procedure TestPC_InlineSpecialize_LocalTypeInUnit;
procedure TestPC_Specialize_Array;
procedure TestPC_Specialize_ProcType;
// ToDo: specialize extern generic type in unit interface
// ToDo: specialize extern generic type in unit implementation
// ToDo: specialize extern generic type in proc decl
@ -3474,6 +3475,38 @@ begin
WriteReadUnit;
end;
procedure TTestPrecompile.TestPC_Specialize_ProcType;
begin
StartUnit(false);
Add([
'{$mode delphi}',
'interface',
'type',
' TFunc<R,P> = function(a: P): R;',
'var',
' a: TFunc<word,double>;',
'procedure Fly;',
'implementation',
'var b: TFunc<byte,word>;',
'procedure Run;',
'var',
' c: TFunc<shortint,string>;',
'begin',
' a(3.3);',
' b(4);',
' c(''abc'');',
'end;',
'procedure Fly;',
'var d: TFunc<longint,boolean>;',
'begin',
' d(true);',
' Run;',
'end;',
'begin',
'']);
WriteReadUnit;
end;
procedure TTestPrecompile.TestPC_UseUnit;
begin
AddModuleWithIntfImplSrc('unit2.pp',