mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-14 09:29:19 +02:00
pastojs: write/restore procedure references
git-svn-id: trunk@38306 -
This commit is contained in:
Mattias Gaertner
parent
df969336a9
commit
18c2f72314
@ -52,7 +52,7 @@ interface
|
||||
uses
|
||||
Classes, Types, SysUtils, contnrs, AVL_Tree, crc,
|
||||
fpjson, jsonparser, jsonscanner,
|
||||
PasTree, PScanner, PParser, PasResolveEval, PasResolver,
|
||||
PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer,
|
||||
Pas2jsFileUtils, FPPas2Js;
|
||||
|
||||
const
|
||||
@ -415,6 +415,16 @@ const
|
||||
'GrpOverload'
|
||||
);
|
||||
|
||||
PJUDefaultPSRefAccess = psraRead;
|
||||
PJUPSRefAccessNames: array[TPSRefAccess] of string = (
|
||||
'None',
|
||||
'Read',
|
||||
'Write',
|
||||
'ReadWrite',
|
||||
'WriteRead',
|
||||
'TypeInfo'
|
||||
);
|
||||
|
||||
PJUResolvedRefAccessNames: array[TResolvedRefAccess] of string = (
|
||||
'None',
|
||||
'Read',
|
||||
@ -580,17 +590,10 @@ type
|
||||
|
||||
TPJUWriter = class(TPJUFiler)
|
||||
private
|
||||
FAnalyzer: TPasAnalyzer;
|
||||
FElementIdCounter: integer;
|
||||
FSourceFilesSorted: TPJUSourceFileArray;
|
||||
FInImplementation: boolean;
|
||||
protected
|
||||
type
|
||||
TGatherRefs = class
|
||||
public
|
||||
ImplProc: TPasProcedure;
|
||||
DeclProc: TPasProcedure;
|
||||
Scope: TPas2JSProcedureScope;
|
||||
end;
|
||||
protected
|
||||
procedure RaiseMsg(Id: int64; const Msg: string = ''); override; overload;
|
||||
procedure ResolvePendingElRefs(Ref: TPJUFilerElementRef);
|
||||
@ -601,12 +604,6 @@ type
|
||||
procedure AddReferenceToObj(Obj: TJSONObject; const PropName: string;
|
||||
El: TPasElement; WriteNil: boolean = false); virtual;
|
||||
procedure CreateElReferenceId(Ref: TPJUFilerElementRef); virtual;
|
||||
function GatherRefs_Add(Refs: TGatherRefs; RefEl: TPasElement;
|
||||
Access: TResolvedRefAccess): TPasProcScopeReference;
|
||||
function GatherRefs_TypeInfo(Refs: TGatherRefs; RefEl: TPasElement): TPasProcScopeReference;
|
||||
procedure GatherRefsElList(Refs: TGatherRefs; Parent: TPasElement; ElList: TFPList);
|
||||
procedure GatherRefsEl(Refs: TGatherRefs; Parent, El: TPasElement;
|
||||
MustBeParent: boolean); virtual;
|
||||
protected
|
||||
procedure WriteHeaderMagic(Obj: TJSONObject); virtual;
|
||||
procedure WriteHeaderVersion(Obj: TJSONObject); virtual;
|
||||
@ -695,6 +692,7 @@ type
|
||||
InitFlags: TPJUInitialFlags): TJSONObject; virtual;
|
||||
function IndexOfSourceFile(const Filename: string): integer;
|
||||
property SourceFilesSorted: TPJUSourceFileArray read FSourceFilesSorted;
|
||||
property Analyzer: TPasAnalyzer read FAnalyzer;
|
||||
end;
|
||||
|
||||
{ TPJUReaderContext }
|
||||
@ -771,6 +769,7 @@ type
|
||||
function ReadBoolean(Obj: TJSONObject; const PropName: string; out b: boolean; El: TPasElement): boolean;
|
||||
function ReadArray(Obj: TJSONObject; const PropName: string; out Arr: TJSONArray; El: TPasElement): boolean;
|
||||
function ReadObject(Obj: TJSONObject; const PropName: string; out SubObj: TJSONObject; El: TPasElement): boolean;
|
||||
function GetElReference(Id: integer; ErrorEl: TPasElement): TPJUFilerElementRef; virtual;
|
||||
function AddElReference(Id: integer; ErrorEl: TPasElement; El: TPasElement): TPJUFilerElementRef; virtual;
|
||||
procedure PromiseSetElReference(Id: integer; const Setter: TOnSetElReference; Data: TObject; ErrorEl: TPasElement); virtual;
|
||||
procedure PromiseSetElListReference(Id: integer; List: TFPList; Index: integer; ErrorEl: TPasElement); virtual;
|
||||
@ -859,6 +858,7 @@ type
|
||||
function ReadProcScopeFlags(Obj: TJSONObject; El: TPasElement;
|
||||
const PropName: string; const DefaultValue: TPasProcedureScopeFlags): TPasProcedureScopeFlags; virtual;
|
||||
procedure ReadProcedureScope(Obj: TJSONObject; Scope: TPas2JSProcedureScope; aContext: TPJUReaderContext); virtual;
|
||||
procedure ReadProcScopeReferences(Obj: TJSONObject; ImplScope: TPas2JSProcedureScope); virtual;
|
||||
procedure ReadProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPJUReaderContext); virtual;
|
||||
procedure ReadOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPJUReaderContext); virtual;
|
||||
// ToDo: procedure ReadExternalReferences(ParentJSON: TJSONObject); virtual;
|
||||
@ -1551,321 +1551,6 @@ begin
|
||||
Ref.Obj.Add('Id',Ref.Id);
|
||||
end;
|
||||
|
||||
function TPJUWriter.GatherRefs_Add(Refs: TGatherRefs; RefEl: TPasElement;
|
||||
Access: TResolvedRefAccess): TPasProcScopeReference;
|
||||
begin
|
||||
if RefEl=nil then exit(nil);
|
||||
if RefEl.HasParent(Refs.ImplProc)
|
||||
or (RefEl=Refs.ImplProc)
|
||||
or (RefEl=Refs.DeclProc)
|
||||
then
|
||||
exit(nil); // ref inside the proc
|
||||
Result:=Refs.Scope.AddReference(RefEl,ResolvedToPSRefAccess[Access]);
|
||||
end;
|
||||
|
||||
function TPJUWriter.GatherRefs_TypeInfo(Refs: TGatherRefs; RefEl: TPasElement
|
||||
): TPasProcScopeReference;
|
||||
begin
|
||||
Result:=GatherRefs_Add(Refs,RefEl,rraRead);
|
||||
if Result=nil then exit;
|
||||
Result.NeedTypeInfo:=true;
|
||||
end;
|
||||
|
||||
procedure TPJUWriter.GatherRefsElList(Refs: TGatherRefs; Parent: TPasElement;
|
||||
ElList: TFPList);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to ElList.Count-1 do
|
||||
GatherRefsEl(Refs,Parent,TPasElement(ElList[i]),true);
|
||||
end;
|
||||
|
||||
procedure TPJUWriter.GatherRefsEl(Refs: TGatherRefs; Parent, El: TPasElement;
|
||||
MustBeParent: boolean);
|
||||
var
|
||||
C: TClass;
|
||||
Ref: TResolvedReference;
|
||||
i: Integer;
|
||||
MyEl, SubEl: TPasElement;
|
||||
ExprArr, Params: TPasExprArray;
|
||||
BuiltInProc: TResElDataBuiltInProc;
|
||||
ModScope: TPasModuleScope;
|
||||
ParamResolved: TPasResolverResult;
|
||||
CaseOf: TPasImplCaseOf;
|
||||
CaseSt: TPasImplCaseStatement;
|
||||
ForLoop: TPasImplForLoop;
|
||||
ForScope: TPasForLoopScope;
|
||||
WithDo: TPasImplWithDo;
|
||||
begin
|
||||
if El=nil then exit;
|
||||
|
||||
if El.Parent<>Parent then
|
||||
begin
|
||||
// reference created by parser
|
||||
if MustBeParent then
|
||||
RaiseMsg(20180219182028,El,GetObjName(Parent)+'<>'+GetObjName(El.Parent));
|
||||
|
||||
if El.CustomData is TResElDataBuiltInSymbol then
|
||||
begin
|
||||
// built-in symbol -> redirect to symbol of this module
|
||||
MyEl:=Resolver.FindLocalBuiltInSymbol(El);
|
||||
if MyEl=nil then
|
||||
RaiseMsg(20180219180838,El,GetObjName(El.CustomData));
|
||||
El:=MyEl as TPasUnresolvedSymbolRef;
|
||||
|
||||
if El.CustomData is TResElDataBuiltInProc then
|
||||
begin
|
||||
BuiltInProc:=TResElDataBuiltInProc(El.CustomData);
|
||||
case BuiltInProc.BuiltIn of
|
||||
bfTypeInfo:
|
||||
begin
|
||||
Params:=(El.Parent as TParamsExpr).Params;
|
||||
Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
|
||||
if ParamResolved.IdentEl is TPasFunction then
|
||||
GatherRefs_TypeInfo(Refs,TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType)
|
||||
else
|
||||
GatherRefs_TypeInfo(Refs,ParamResolved.IdentEl);
|
||||
end;
|
||||
bfAssert:
|
||||
begin
|
||||
ModScope:=Resolver.RootElement.CustomData as TPasModuleScope;
|
||||
if ModScope.AssertClass<>nil then
|
||||
GatherRefs_Add(Refs,ModScope.AssertClass,rraRead);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// store reference
|
||||
GatherRefs_Add(Refs,El,rraRead);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if El.CustomData is TResolvedReference then
|
||||
begin
|
||||
// reference created by resolver
|
||||
Ref:=TResolvedReference(El.CustomData);
|
||||
GatherRefs_Add(Refs,Ref.Declaration,Ref.Access);
|
||||
end;
|
||||
|
||||
C:=El.ClassType;
|
||||
if (C=TPasImplBlock)
|
||||
or (C=TPasImplBeginBlock) then
|
||||
GatherRefsElList(Refs,El,TPasImplBlock(El).Elements)
|
||||
else if C=TPasImplSimple then
|
||||
// simple expression
|
||||
GatherRefsEl(Refs,El,TPasImplSimple(El).Expr,true)
|
||||
else if C=TPasImplAssign then
|
||||
// a:=b
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TPasImplAssign(El).left,true);
|
||||
GatherRefsEl(Refs,El,TPasImplAssign(El).right,true);
|
||||
end
|
||||
else if C=TPasImplAsmStatement then
|
||||
// asm..end
|
||||
else if C=TPasImplCaseOf then
|
||||
begin
|
||||
// case-of
|
||||
CaseOf:=TPasImplCaseOf(El);
|
||||
GatherRefsEl(Refs,El,CaseOf.CaseExpr,true);
|
||||
for i:=0 to CaseOf.Elements.Count-1 do
|
||||
begin
|
||||
SubEl:=TPasElement(CaseOf.Elements[i]);
|
||||
if SubEl.ClassType=TPasImplCaseStatement then
|
||||
begin
|
||||
CaseSt:=TPasImplCaseStatement(SubEl);
|
||||
GatherRefsElList(Refs,El,CaseSt.Expressions);
|
||||
GatherRefsEl(Refs,El,CaseSt.Body,true);
|
||||
end
|
||||
else if SubEl.ClassType=TPasImplCaseElse then
|
||||
GatherRefsElList(Refs,El,TPasImplCaseElse(El).Elements)
|
||||
else
|
||||
RaiseMsg(20180219200924,SubEl,GetObjName(SubEl));
|
||||
end;
|
||||
end
|
||||
else if C=TPasImplForLoop then
|
||||
begin
|
||||
// for-loop
|
||||
ForLoop:=TPasImplForLoop(El);
|
||||
GatherRefsEl(Refs,El,ForLoop.VariableName,true);
|
||||
GatherRefsEl(Refs,El,ForLoop.StartExpr,true);
|
||||
GatherRefsEl(Refs,El,ForLoop.EndExpr,true);
|
||||
ForScope:=ForLoop.CustomData as TPasForLoopScope;
|
||||
GatherRefsEl(Refs,El,ForScope.GetEnumerator,false);
|
||||
GatherRefsEl(Refs,El,ForScope.MoveNext,false);
|
||||
GatherRefsEl(Refs,El,ForScope.Current,false);
|
||||
GatherRefsEl(Refs,El,ForLoop.Body,true);
|
||||
end
|
||||
else if C=TPasImplIfElse then
|
||||
begin
|
||||
// if-then-else
|
||||
GatherRefsEl(Refs,El,TPasImplIfElse(El).ConditionExpr,true);
|
||||
GatherRefsEl(Refs,El,TPasImplIfElse(El).IfBranch,true);
|
||||
GatherRefsEl(Refs,El,TPasImplIfElse(El).ElseBranch,true);
|
||||
end
|
||||
else if C=TPasImplLabelMark then
|
||||
// label mark
|
||||
else if C=TPasImplRepeatUntil then
|
||||
begin
|
||||
// repeat-until
|
||||
GatherRefsElList(Refs,El,TPasImplRepeatUntil(El).Elements);
|
||||
GatherRefsEl(Refs,El,TPasImplRepeatUntil(El).ConditionExpr,true);
|
||||
end
|
||||
else if C=TPasImplWhileDo then
|
||||
begin
|
||||
// while-do
|
||||
GatherRefsEl(Refs,El,TPasImplWhileDo(El).ConditionExpr,true);
|
||||
GatherRefsElList(Refs,El,TPasImplWhileDo(El).Elements);
|
||||
end
|
||||
else if C=TPasImplWithDo then
|
||||
begin
|
||||
// with-do
|
||||
WithDo:=TPasImplWithDo(El);
|
||||
GatherRefsElList(Refs,El,WithDo.Expressions);
|
||||
GatherRefsElList(Refs,El,WithDo.Elements);
|
||||
end
|
||||
else if C=TPasImplExceptOn then
|
||||
begin
|
||||
// except-on
|
||||
GatherRefsEl(Refs,El,TPasImplExceptOn(El).VarEl,true);
|
||||
GatherRefsEl(Refs,El,TPasImplExceptOn(El).TypeEl,false);
|
||||
GatherRefsEl(Refs,El,TPasImplExceptOn(El).Body,true);
|
||||
end
|
||||
else if C=TPasImplRaise then
|
||||
begin
|
||||
// raise
|
||||
GatherRefsEl(Refs,El,TPasImplRaise(El).ExceptObject,true);
|
||||
GatherRefsEl(Refs,El,TPasImplRaise(El).ExceptAddr,true);
|
||||
end
|
||||
else if C=TPasImplTry then
|
||||
begin
|
||||
// try..finally/except..else..end
|
||||
GatherRefsElList(Refs,El,TPasImplTry(El).Elements);
|
||||
GatherRefsEl(Refs,El,TPasImplTry(El).FinallyExcept,true);
|
||||
GatherRefsEl(Refs,El,TPasImplTry(El).ElseBranch,true);
|
||||
end
|
||||
else if C.InheritsFrom(TPasImplTryHandler) then
|
||||
// try..finally..except..else..
|
||||
GatherRefsElList(Refs,El,TPasImplTryHandler(El).Elements)
|
||||
else if (C=TPasAliasType)
|
||||
or (C=TPasTypeAliasType)
|
||||
or (C=TPasClassOfType) then
|
||||
GatherRefsEl(Refs,El,TPasAliasType(El).DestType,false)
|
||||
else if C=TPasArrayType then
|
||||
begin
|
||||
ExprArr:=TPasArrayType(El).Ranges;
|
||||
for i:=0 to length(ExprArr)-1 do
|
||||
GatherRefsEl(Refs,El,ExprArr[i],true);
|
||||
GatherRefsEl(Refs,El,TPasArrayType(El).ElType,false);
|
||||
end
|
||||
else if C=TPasRecordType then
|
||||
begin
|
||||
GatherRefsElList(Refs,El,TPasRecordType(El).Members);
|
||||
end
|
||||
else if C=TPasClassType then
|
||||
begin
|
||||
RaiseMsg(20180219183041,El,'local class not supported');
|
||||
end
|
||||
else if C=TPasEnumValue then
|
||||
GatherRefsEl(Refs,El,TPasEnumValue(El).Value,false)
|
||||
else if C=TPasEnumType then
|
||||
GatherRefsElList(Refs,El,TPasEnumType(El).Values)
|
||||
else if C=TPasPointerType then
|
||||
GatherRefsEl(Refs,El,TPasPointerType(El).DestType,false)
|
||||
else if C=TPasRangeType then
|
||||
GatherRefsEl(Refs,El,TPasRangeType(El).RangeExpr,true)
|
||||
else if C=TPasSetType then
|
||||
GatherRefsEl(Refs,El,TPasSetType(El).EnumType,false)
|
||||
else if C=TProcedureBody then
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TProcedureBody(El).Body,true);
|
||||
GatherRefsElList(Refs,El,TProcedureBody(El).Declarations);
|
||||
end
|
||||
else if C.InheritsFrom(TPasProcedureType) then
|
||||
begin
|
||||
GatherRefsElList(Refs,El,TPasProcedureType(El).Args);
|
||||
if El is TPasFunctionType then
|
||||
GatherRefsEl(Refs,El,TPasFunctionType(El).ResultEl.ResultType,false);
|
||||
end
|
||||
else if C=TPasArgument then
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TPasArgument(El).ArgType,true);
|
||||
GatherRefsEl(Refs,El,TPasArgument(El).ValueExpr,true);
|
||||
end
|
||||
else if C.InheritsFrom(TPasVariable) then
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TPasVariable(El).VarType,false);
|
||||
GatherRefsEl(Refs,El,TPasVariable(El).LibraryName,true);
|
||||
GatherRefsEl(Refs,El,TPasVariable(El).ExportName,true);
|
||||
GatherRefsEl(Refs,El,TPasVariable(El).AbsoluteExpr,true);
|
||||
GatherRefsEl(Refs,El,TPasVariable(El).Expr,true);
|
||||
if C=TPasConst then
|
||||
else if C=TPasProperty then
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TPasProperty(El).IndexExpr,true);
|
||||
GatherRefsEl(Refs,El,TPasProperty(El).ReadAccessor,true);
|
||||
GatherRefsEl(Refs,El,TPasProperty(El).WriteAccessor,true);
|
||||
GatherRefsEl(Refs,El,TPasProperty(El).ImplementsFunc,true);
|
||||
GatherRefsEl(Refs,El,TPasProperty(El).DispIDExpr,true);
|
||||
GatherRefsEl(Refs,El,TPasProperty(El).StoredAccessor,true);
|
||||
GatherRefsEl(Refs,El,TPasProperty(El).DefaultExpr,true);
|
||||
GatherRefsElList(Refs,El,TPasProperty(El).Args);
|
||||
end;
|
||||
end
|
||||
else if C=TPasResultElement then
|
||||
GatherRefsEl(Refs,El,TPasResultElement(El).ResultType,false)
|
||||
else if C=TPasResString then
|
||||
GatherRefsEl(Refs,El,TPasResString(El).Expr,true)
|
||||
else if C.InheritsFrom(TPasProcedure) then
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TPasProcedure(El).ProcType,true);
|
||||
GatherRefsEl(Refs,El,TPasProcedure(El).Body,true);
|
||||
if TPasProcedure(El).PublicName<>nil then
|
||||
RaiseMsg(20180219190331,El);
|
||||
if TPasProcedure(El).LibrarySymbolName<>nil then
|
||||
RaiseMsg(20180219190354,El);
|
||||
if TPasProcedure(El).LibraryExpr<>nil then
|
||||
RaiseMsg(20180219190402,El);
|
||||
if TPasProcedure(El).DispIDExpr<>nil then
|
||||
RaiseMsg(20180219190420,El);
|
||||
end
|
||||
else if C.InheritsFrom(TPasExpr) then
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TPasExpr(El).format1,true);
|
||||
GatherRefsEl(Refs,El,TPasExpr(El).format2,true);
|
||||
if (C=TPrimitiveExpr)
|
||||
or (C=TSelfExpr)
|
||||
or (C=TBoolConstExpr)
|
||||
or (C=TNilExpr) then
|
||||
else if C=TBinaryExpr then
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TBinaryExpr(El).left,true);
|
||||
GatherRefsEl(Refs,El,TBinaryExpr(El).right,true);
|
||||
end
|
||||
else if C=TUnaryExpr then
|
||||
GatherRefsEl(Refs,El,TUnaryExpr(El).Operand,true)
|
||||
else if C=TParamsExpr then
|
||||
begin
|
||||
GatherRefsEl(Refs,El,TParamsExpr(El).Value,true);
|
||||
ExprArr:=TParamsExpr(El).Params;
|
||||
for i:=0 to length(ExprArr)-1 do
|
||||
GatherRefsEl(Refs,El,ExprArr[i],true);
|
||||
end
|
||||
else if C=TArrayValues then
|
||||
begin
|
||||
ExprArr:=TArrayValues(El).Values;
|
||||
for i:=0 to length(ExprArr)-1 do
|
||||
GatherRefsEl(Refs,El,ExprArr[i],true);
|
||||
end
|
||||
else if C=TInheritedExpr then
|
||||
else
|
||||
RaiseMsg(20180219191705,El,GetObjName(El));
|
||||
end
|
||||
// ToDo: implblocks
|
||||
else
|
||||
RaiseMsg(20180219144250,El);
|
||||
end;
|
||||
|
||||
procedure TPJUWriter.WriteHeaderMagic(Obj: TJSONObject);
|
||||
begin
|
||||
Obj.Add('FileType',PJUMagic);
|
||||
@ -3172,7 +2857,14 @@ procedure TPJUWriter.WriteProcedure(Obj: TJSONObject; El: TPasProcedure;
|
||||
var
|
||||
DefProcMods: TProcedureModifiers;
|
||||
Scope: TPas2JSProcedureScope;
|
||||
Refs: TGatherRefs;
|
||||
List: TFPList;
|
||||
Arr: TJSONArray;
|
||||
i: Integer;
|
||||
PSRef: TPasProcScopeReference;
|
||||
SubObj: TJSONObject;
|
||||
DeclProc: TPasProcedure;
|
||||
DeclScope: TPasProcedureScope;
|
||||
Ref: TPJUFilerElementRef;
|
||||
begin
|
||||
WritePasElement(Obj,El,aContext);
|
||||
Scope:=El.CustomData as TPas2JSProcedureScope;
|
||||
@ -3202,18 +2894,40 @@ begin
|
||||
AddReferenceToObj(Obj,'DeclarationProc',Scope.DeclarationProc);
|
||||
end;
|
||||
|
||||
if El.Body<>nil then
|
||||
if (Scope.ImplProc=nil) and (El.Body<>nil) then
|
||||
begin
|
||||
if Scope.ImplProc<>nil then
|
||||
RaiseMsg(20180219145737,El);
|
||||
Refs:=TGatherRefs.Create;
|
||||
// Note: the References are stored in the declaration scope,
|
||||
// but in the JSON of the implementation scope, so that
|
||||
// all references can be resolved immediately by the reader
|
||||
DeclProc:=Scope.DeclarationProc;
|
||||
if DeclProc=nil then
|
||||
DeclProc:=El;
|
||||
DeclScope:=NoNil(DeclProc.CustomData) as TPasProcedureScope;
|
||||
// write references
|
||||
if DeclScope.References=nil then
|
||||
Analyzer.AnalyzeProcRefs(DeclProc);
|
||||
List:=DeclScope.GetReferences;
|
||||
try
|
||||
Refs.Scope:=Scope;
|
||||
Refs.DeclProc:=Scope.DeclarationProc;
|
||||
Refs.ImplProc:=El;
|
||||
GatherRefsEl(Refs,El,El.Body,true);
|
||||
if List.Count>0 then
|
||||
begin
|
||||
Arr:=TJSONArray.Create;
|
||||
Obj.Add('ProcRefs',Arr);
|
||||
for i:=0 to List.Count-1 do
|
||||
begin
|
||||
PSRef:=TPasProcScopeReference(List[i]);
|
||||
Ref:=GetElementReference(PSRef.Element);
|
||||
if (Ref.Id=0) and not (Ref.Element is TPasUnresolvedSymbolRef) then
|
||||
RaiseMsg(20180221170307,El,GetObjName(Ref.Element));
|
||||
SubObj:=TJSONObject.Create;
|
||||
Arr.Add(SubObj);
|
||||
if PSRef.Access<>PJUDefaultPSRefAccess then
|
||||
SubObj.Add('Access',PJUPSRefAccessNames[PSRef.Access]);
|
||||
AddReferenceToObj(SubObj,'Id',PSRef.Element);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Refs.Free;
|
||||
Analyzer.Clear;
|
||||
List.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -3292,10 +3006,12 @@ end;
|
||||
constructor TPJUWriter.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FAnalyzer:=TPasAnalyzer.Create;
|
||||
end;
|
||||
|
||||
destructor TPJUWriter.Destroy;
|
||||
begin
|
||||
FreeAndNil(FAnalyzer);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -3464,6 +3180,8 @@ begin
|
||||
aContext:=nil;
|
||||
Obj:=TJSONObject.Create;
|
||||
try
|
||||
Analyzer.Clear;
|
||||
Analyzer.Resolver:=aResolver;
|
||||
WriteHeaderMagic(Obj);
|
||||
WriteHeaderVersion(Obj);
|
||||
WriteInitialFlags(Obj);
|
||||
@ -3482,6 +3200,7 @@ begin
|
||||
aContext.Free;
|
||||
if Result=nil then
|
||||
Obj.Free;
|
||||
Analyzer.Clear;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -3912,6 +3631,16 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPJUReader.GetElReference(Id: integer; ErrorEl: TPasElement
|
||||
): TPJUFilerElementRef;
|
||||
begin
|
||||
if Id<=0 then
|
||||
RaiseMsg(20180221171721,ErrorEl);
|
||||
if Id>=length(FElementRefsArray) then
|
||||
RaiseMsg(20180221171741,ErrorEl);
|
||||
Result:=FElementRefsArray[Id];
|
||||
end;
|
||||
|
||||
function TPJUReader.AddElReference(Id: integer; ErrorEl: TPasElement;
|
||||
El: TPasElement): TPJUFilerElementRef;
|
||||
var
|
||||
@ -5096,8 +4825,8 @@ procedure TPJUReader.ReadIdentifierScopeArray(Arr: TJSONArray;
|
||||
function GetElRef(Id: integer; out DefKind: TPasIdentifierKind;
|
||||
out DefName: string): TPJUFilerElementRef;
|
||||
begin
|
||||
Result:=AddElReference(Id,Scope.Element,nil);
|
||||
if Result.Element=nil then
|
||||
Result:=GetElReference(Id,Scope.Element);
|
||||
if (Result=nil) or (Result.Element=nil) then
|
||||
RaiseMsg(20180207161358,Scope.Element,'Id not found: '+IntToStr(Id));
|
||||
GetDefaultsPasIdentifierProps(Result.Element,DefKind,DefName);
|
||||
end;
|
||||
@ -5597,8 +5326,8 @@ begin
|
||||
if Data is TJSONIntegerNumber then
|
||||
begin
|
||||
Id:=Data.AsInteger;
|
||||
Ref:=AddElReference(Id,Scope.Element,nil);
|
||||
if Ref.Element=nil then
|
||||
Ref:=GetElReference(Id,Scope.Element);
|
||||
if (Ref=nil) or (Ref.Element=nil) then
|
||||
RaiseMsg(20180214121727,Scope.Element,'['+IntToStr(i)+'] missing Id '+IntToStr(Id));
|
||||
if Ref.Element is TPasProcedure then
|
||||
Scope.AbstractProcs[i]:=TPasProcedure(Ref.Element)
|
||||
@ -5995,6 +5724,63 @@ begin
|
||||
ReadIdentifierScope(Obj,Scope,aContext);
|
||||
end;
|
||||
|
||||
procedure TPJUReader.ReadProcScopeReferences(Obj: TJSONObject;
|
||||
ImplScope: TPas2JSProcedureScope);
|
||||
var
|
||||
i, Id: Integer;
|
||||
Arr: TJSONArray;
|
||||
Data: TJSONData;
|
||||
SubObj: TJSONObject;
|
||||
DeclProc: TPasProcedure;
|
||||
Ref: TPJUFilerElementRef;
|
||||
Found: Boolean;
|
||||
Access: TPSRefAccess;
|
||||
s: string;
|
||||
DeclScope: TPasProcedureScope;
|
||||
begin
|
||||
// Note: the References are stored in the declaration scope,
|
||||
// and in the JSON of the implementation scope, so that
|
||||
// all references can be resolved immediately
|
||||
DeclProc:=ImplScope.DeclarationProc;
|
||||
if DeclProc=nil then
|
||||
DeclProc:=ImplScope.Element as TPasProcedure;
|
||||
DeclScope:=DeclProc.CustomData as TPasProcedureScope;
|
||||
if DeclScope.References<>nil then
|
||||
RaiseMsg(20180221172403,DeclProc);
|
||||
if not ReadArray(Obj,'ProcRefs',Arr,DeclProc) then exit;
|
||||
for i:=0 to Arr.Count-1 do
|
||||
begin
|
||||
Data:=Arr[i];
|
||||
if not (Data is TJSONObject) then
|
||||
RaiseMsg(20180221164800,DeclProc,GetObjName(Data));
|
||||
SubObj:=TJSONObject(Data);
|
||||
Data:=SubObj.Find('Id');
|
||||
if not (Data is TJSONIntegerNumber) then
|
||||
RaiseMsg(20180221171546,DeclProc,GetObjName(Data));
|
||||
Id:=Data.AsInteger;
|
||||
Ref:=GetElReference(Id,DeclProc);
|
||||
if Ref=nil then
|
||||
RaiseMsg(20180221171940,DeclProc,IntToStr(Id));
|
||||
if Ref.Element=nil then
|
||||
RaiseMsg(20180221171940,DeclProc,IntToStr(Id));
|
||||
if ReadString(SubObj,'Access',s,DeclProc) then
|
||||
begin
|
||||
Found:=false;
|
||||
for Access in TPSRefAccess do
|
||||
if s=PJUPSRefAccessNames[Access] then
|
||||
begin
|
||||
Found:=true;
|
||||
break;
|
||||
end;
|
||||
if not Found then
|
||||
RaiseMsg(20180221172333,DeclProc,'Access "'+s+'"');
|
||||
end
|
||||
else
|
||||
Access:=PJUDefaultPSRefAccess;
|
||||
DeclScope.AddReference(Ref.Element,Access);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPJUReader.ReadProcedure(Obj: TJSONObject; El: TPasProcedure;
|
||||
aContext: TPJUReaderContext);
|
||||
var
|
||||
@ -6015,8 +5801,8 @@ begin
|
||||
if ReadInteger(Obj,'DeclarationProc',DeclProcId,El) then
|
||||
begin
|
||||
// ImplProc
|
||||
Ref:=AddElReference(DeclProcId,El,nil);
|
||||
if Ref.Element=nil then
|
||||
Ref:=GetElReference(DeclProcId,El);
|
||||
if (Ref=nil) or (Ref.Element=nil) then
|
||||
RaiseMsg(20180219140423,El,'missing DeclarationProc '+IntToStr(DeclProcId));
|
||||
if not (Ref.Element is TPasProcedure) then
|
||||
RaiseMsg(20180219140547,El,'DeclarationProc='+GetObjName(Ref.Element));
|
||||
@ -6060,6 +5846,8 @@ begin
|
||||
ReadProcedureScope(Obj,Scope,aContext);
|
||||
end;
|
||||
|
||||
if Obj.Find('ImplProc')=nil then
|
||||
ReadProcScopeReferences(Obj,Scope);
|
||||
// ToDo: Body : TProcedureBody;
|
||||
end;
|
||||
|
||||
|
||||
@ -60,6 +60,7 @@ type
|
||||
procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPasRecordScope); virtual;
|
||||
procedure CheckRestoredClassScope(const Path: string; Orig, Rest: TPas2JSClassScope); virtual;
|
||||
procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope); virtual;
|
||||
procedure CheckRestoredProcScopeRefs(const Path: string; Orig, Rest: TPas2JSProcedureScope); virtual;
|
||||
procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope); virtual;
|
||||
procedure CheckRestoredResolvedReference(const Path: string; Orig, Rest: TResolvedReference); virtual;
|
||||
procedure CheckRestoredEvalValue(const Path: string; Orig, Rest: TResEvalValue); virtual;
|
||||
@ -127,8 +128,20 @@ type
|
||||
procedure TestPC_Class;
|
||||
end;
|
||||
|
||||
function CompareListOfProcScopeRef(Item1, Item2: Pointer): integer;
|
||||
|
||||
implementation
|
||||
|
||||
function CompareListOfProcScopeRef(Item1, Item2: Pointer): integer;
|
||||
var
|
||||
Ref1: TPasProcScopeReference absolute Item1;
|
||||
Ref2: TPasProcScopeReference absolute Item2;
|
||||
begin
|
||||
Result:=CompareText(Ref1.Element.Name,Ref2.Element.Name);
|
||||
if Result<>0 then exit;
|
||||
Result:=ComparePointer(Ref1.Element,Ref2.Element);
|
||||
end;
|
||||
|
||||
{ TCustomTestPrecompile }
|
||||
|
||||
procedure TCustomTestPrecompile.OnFilerGetSrc(Sender: TObject;
|
||||
@ -462,6 +475,7 @@ procedure TCustomTestPrecompile.CheckRestoredProcScope(const Path: string;
|
||||
begin
|
||||
CheckRestoredReference(Path+'.DeclarationProc',Orig.DeclarationProc,Rest.DeclarationProc);
|
||||
CheckRestoredReference(Path+'.ImplProc',Orig.ImplProc,Rest.ImplProc);
|
||||
CheckRestoredProcScopeRefs(Path+'.References',Orig,Rest);
|
||||
if Rest.DeclarationProc=nil then
|
||||
begin
|
||||
AssertEquals(Path+'.ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
|
||||
@ -480,8 +494,46 @@ begin
|
||||
else
|
||||
begin
|
||||
// ImplProc
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TCustomTestPrecompile.CheckRestoredProcScopeRefs(const Path: string;
|
||||
Orig, Rest: TPas2JSProcedureScope);
|
||||
var
|
||||
OrigList, RestList: TFPList;
|
||||
i: Integer;
|
||||
OrigRef, RestRef: TPasProcScopeReference;
|
||||
begin
|
||||
CheckRestoredObject(Path,Orig.References,Rest.References);
|
||||
OrigList:=nil;
|
||||
RestList:=nil;
|
||||
try
|
||||
OrigList:=Orig.GetReferences;
|
||||
RestList:=Rest.GetReferences;
|
||||
OrigList.Sort(@CompareListOfProcScopeRef);
|
||||
RestList.Sort(@CompareListOfProcScopeRef);
|
||||
for i:=0 to OrigList.Count-1 do
|
||||
begin
|
||||
OrigRef:=TPasProcScopeReference(OrigList[i]);
|
||||
if i>=RestList.Count then
|
||||
Fail(Path+'['+IntToStr(i)+'] Missing in Rest: "'+OrigRef.Element.Name+'"');
|
||||
RestRef:=TPasProcScopeReference(RestList[i]);
|
||||
CheckRestoredReference(Path+'['+IntToStr(i)+'].Name="'+OrigRef.Element.Name+'"',OrigRef.Element,RestRef.Element);
|
||||
if OrigRef.Access<>RestRef.Access then
|
||||
AssertEquals(Path+'['+IntToStr(i)+']"'+OrigRef.Element.Name+'".Access',
|
||||
PJUPSRefAccessNames[OrigRef.Access],PJUPSRefAccessNames[RestRef.Access]);
|
||||
end;
|
||||
if RestList.Count>OrigList.Count then
|
||||
begin
|
||||
i:=OrigList.Count;
|
||||
RestRef:=TPasProcScopeReference(RestList[i]);
|
||||
Fail(Path+'['+IntToStr(i)+'] Too many in Rest: "'+RestRef.Element.Name+'"');
|
||||
end;
|
||||
finally
|
||||
OrigList.Free;
|
||||
RestList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomTestPrecompile.CheckRestoredPropertyScope(const Path: string;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user