Browse Source

pastojs: filer: generic proc type

git-svn-id: trunk@47241 -
Mattias Gaertner 4 years ago
parent
commit
42e48d016b
2 changed files with 58 additions and 0 deletions
  1. 25 0
      packages/pastojs/src/pas2jsfiler.pp
  2. 33 0
      packages/pastojs/tests/tcfiler.pas

+ 25 - 0
packages/pastojs/src/pas2jsfiler.pp

@@ -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 - 0
packages/pastojs/tests/tcfiler.pas

@@ -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',