From 787b2a2e054fe2571fba482aaf05a1e27d0b22ac Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sat, 10 Mar 2018 10:17:33 +0000 Subject: [PATCH] pastojs: filer: class in other unit git-svn-id: trunk@38479 - --- packages/pastojs/src/pas2jsfiler.pp | 216 ++++++++++++++++++++------- packages/pastojs/tests/tcfiler.pas | 125 +++++++++++++++- packages/pastojs/tests/tcmodules.pas | 8 +- 3 files changed, 292 insertions(+), 57 deletions(-) diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp index 00798635b8..466f3665f2 100644 --- a/packages/pastojs/src/pas2jsfiler.pp +++ b/packages/pastojs/src/pas2jsfiler.pp @@ -58,6 +58,8 @@ const PJUMagic = 'Pas2JSCache'; PJUVersion = 1; + BuiltInNodeName = 'BuiltIn'; + PJUDefaultParserOptions: TPOptions = po_Pas2js; PJUBoolStr: array[boolean] of string = ( @@ -792,6 +794,7 @@ type procedure ReadSrcFiles(Data: TJSONData); virtual; function ReadMemberHints(Obj: TJSONObject; El: TPasElement; const DefaultValue: TPasMemberHints): TPasMemberHints; virtual; procedure ReadPasElement(Obj: TJSONObject; El: TPasElement; aContext: TPJUReaderContext); virtual; + procedure ReadExtRefs(Obj: TJSONObject; El: TPasElement); virtual; procedure ReadUsedUnits(Obj: TJSONObject; Section: TPasSection; aContext: TPJUReaderContext); virtual; procedure ReadSectionScope(Obj: TJSONObject; Scope: TPasSectionScope; aContext: TPJUReaderContext); virtual; procedure ReadSection(Obj: TJSONObject; Section: TPasSection; aContext: TPJUReaderContext); virtual; @@ -1216,7 +1219,7 @@ procedure TPJUFilerElementRef.Clear; var Ref, NextRef: TPJUFilerPendingElRef; begin - FreeAndNil(Elements); + Elements:=nil; Ref:=Pending; while Ref<>nil do begin @@ -1225,6 +1228,7 @@ begin Ref.Free; Ref:=NextRef; end; + Pending:=nil; end; destructor TPJUFilerElementRef.Destroy; @@ -1955,7 +1959,7 @@ procedure TPJUWriter.WriteSection(ParentJSON: TJSONObject; var Obj, SubObj: TJSONObject; Scope, UsesScope: TPasSectionScope; - i: Integer; + i, j: Integer; Arr: TJSONArray; UsesUnit: TPasUsesUnit; Name, InFilename: String; @@ -1976,16 +1980,28 @@ begin begin UsesUnit:=Section.UsesClause[i]; UsesScope:=TPasSectionScope(Scope.UsesScopes[i]); - if UsesScope.Element<>UsesUnit.Module then + if UsesScope.Element<>TPasModule(UsesUnit.Module).InterfaceSection then RaiseMsg(20180206122459,Section,'usesscope '+IntToStr(i)+' UsesScope.Element='+GetObjName(UsesScope.Element)+' Module='+GetObjName(Section.UsesClause[i].Module)); if Arr=nil then begin Arr:=TJSONArray.Create; - ParentJSON.Add('Uses',Arr); + Obj.Add('Uses',Arr); end; SubObj:=TJSONObject.Create; Arr.Add(SubObj); - Name:=DotExprToName(UsesUnit.Expr); + if UsesUnit.Expr<>nil then + Name:=DotExprToName(UsesUnit.Expr) + else + begin + // implicit unit, e.g. system + Name:=UsesUnit.Module.Name; + for j:=0 to Parser.ImplicitUses.Count-1 do + if CompareText(Parser.ImplicitUses[i],Name)=0 then + begin + Name:=Parser.ImplicitUses[i]; + break; + end; + end; if Name='' then RaiseMsg(20180307091654,UsesUnit.Expr); SubObj.Add('Name',Name); @@ -2008,7 +2024,7 @@ begin if Ref.Obj=nil then begin Ref.Obj:=TJSONObject.Create; - SubObj.Add('Refs',Ref.Obj); + SubObj.Add('Module',Ref.Obj); end; end; end; @@ -2477,7 +2493,6 @@ var Arr: TJSONArray; i: Integer; PSRef: TPasScopeReference; - Ref: TPJUFilerElementRef; SubObj: TJSONObject; begin if References=nil then exit; @@ -2490,9 +2505,6 @@ begin for i:=0 to Refs.Count-1 do begin PSRef:=TPasScopeReference(Refs[i]); - Ref:=GetElementReference(PSRef.Element); - if (Ref.Id=0) and not (Ref.Element is TPasUnresolvedSymbolRef) then - RaiseMsg(20180221170307,References.Scope.Element,GetObjName(Ref.Element)); SubObj:=TJSONObject.Create; Arr.Add(SubObj); if PSRef.Access<>PJUDefaultPSRefAccess then @@ -3030,6 +3042,21 @@ end; procedure TPJUWriter.WriteExternalReferences(ParentJSON: TJSONObject); + procedure WriteMemberIndex(Members: TFPList; Member: TPasElement; Obj: TJSONObject); + var + i, Index: Integer; + begin + for i:=0 to Members.Count-1 do + if TPasElement(Members[i])=Member then + begin + Index:=i; + break; + end; + if Index<0 then + RaiseMsg(20180309184111,Member); + Obj.Add('Index',Index); + end; + function WriteExternalRef(El: TPasElement): TPJUFilerElementRef; var ParentRef, Ref: TPJUFilerElementRef; @@ -3038,12 +3065,6 @@ procedure TPJUWriter.WriteExternalReferences(ParentJSON: TJSONObject); begin Result:=nil; if El=nil then exit; - if El.ClassType=TInterfaceSection then - begin - // skip to module - Result:=WriteExternalRef(El.GetModule); - exit; - end; // check if already written Ref:=GetElementReference(El); if Ref.Obj<>nil then @@ -3053,15 +3074,37 @@ procedure TPJUWriter.WriteExternalReferences(ParentJSON: TJSONObject); ParentRef:=WriteExternalRef(Parent); if ParentRef=nil then if not (El is TPasModule) then - RaiseMsg(20180308174440,GetObjName(El)); + RaiseMsg(20180308174440,El,GetObjName(El)); // check name Name:=El.Name; if Name='' then - RaiseMsg(20180308174850,GetObjName(El)); + if El is TInterfaceSection then + Name:='Interface' + else + RaiseMsg(20180308174850,El,GetObjName(El)); // write Ref.Obj:=TJSONObject.Create; + Ref.Obj.Add('Name',Name); if ParentRef<>nil then begin + // add member index + if Parent is TPasDeclarations then + WriteMemberIndex(TPasDeclarations(Parent).Declarations,El,Ref.Obj) + else if Parent is TPasClassType then + WriteMemberIndex(TPasClassType(Parent).Members,El,Ref.Obj) + else if Parent is TPasRecordType then + WriteMemberIndex(TPasRecordType(Parent).Members,El,Ref.Obj) + else if Parent is TPasEnumType then + WriteMemberIndex(TPasEnumType(Parent).Values,El,Ref.Obj) + else if Parent is TPasModule then + begin + if El is TInterfaceSection then + else + RaiseMsg(20180310104857,Parent,GetObjName(El)); + end + else + RaiseMsg(20180310104810,Parent,GetObjName(El)); + // add to parent if ParentRef.Elements=nil then begin ParentRef.Elements:=TJSONArray.Create; @@ -3069,7 +3112,7 @@ procedure TPJUWriter.WriteExternalReferences(ParentJSON: TJSONObject); end; ParentRef.Elements.Add(Ref.Obj); end; - Ref.Obj.Add('Name',Name); + Result:=Ref; end; var @@ -3092,13 +3135,13 @@ begin Data:=El.CustomData; if Data is TResElDataBuiltInSymbol then begin - // add built-in symbol to System array + // add built-in symbol to BuildIn array if El<>Resolver.FindLocalBuiltInSymbol(El) then RaiseMsg(20180207124914,El); if SystemArr=nil then begin SystemArr:=TJSONArray.Create; - ParentJSON.Add('System',SystemArr); + ParentJSON.Add(BuiltInNodeName,SystemArr); end; Obj:=TJSONObject.Create; SystemArr.Add(Obj); @@ -3116,9 +3159,8 @@ begin if Ref.Element.GetModule=Resolver.RootElement then RaiseMsg(20180207115645,Ref.Element); // an element of this module was not written // external element - if Ref.Obj<>nil then - continue; // already written - Ref:=WriteExternalRef(El); + if Ref.Obj=nil then + WriteExternalRef(El); // Ref.Id is written in ResolvePendingElRefs ResolvePendingElRefs(Ref); end; @@ -4307,19 +4349,97 @@ begin if aContext<>nil then ; end; +procedure TPJUReader.ReadExtRefs(Obj: TJSONObject; El: TPasElement); + + procedure ReadMembers(Arr: TJSONArray; Members: TFPList); + var + i, Index: Integer; + Data: TJSONData; + SubObj: TJSONObject; + Name: string; + ChildEl: TPasElement; + begin + for i:=0 to Arr.Count-1 do + begin + Data:=Arr[i]; + if not (Data is TJSONObject) then + RaiseMsg(20180309173351,El); + SubObj:=TJSONObject(Data); + // search element + if not ReadString(SubObj,'Name',Name,El) then + RaiseMsg(20180309180233,El,IntToStr(i)); + if not ReadInteger(SubObj,'Index',Index,El) then + RaiseMsg(20180309184629,El,IntToStr(i)); + if (Index<0) or (Index>=Members.Count) then + RaiseMsg(20180309184718,El,IntToStr(Index)+' out of bounds 0-'+IntToStr(Members.Count)); + ChildEl:=TPasElement(Members[Index]); + if ChildEl.Name<>Name then + RaiseMsg(20180309200800,El,'Expected="'+Name+'", but found "'+ChildEl.Name+'"'); + // read child declarations + ReadExtRefs(SubObj,ChildEl); + end; + end; + +var + Arr: TJSONArray; + Id: Integer; + Data: TJSONData; + SubObj: TJSONObject; + Intf: TInterfaceSection; + Name: string; +begin + {$IFDEF VerbosePJUFiler} + writeln('TPJUReader.ReadExtRefs ',GetObjName(El)); + {$ENDIF} + if ReadInteger(Obj,'Id',Id,El) then + AddElReference(Id,El,El); + if ReadArray(Obj,'El',Arr,El) then + begin + if El is TPasDeclarations then + ReadMembers(Arr,TPasDeclarations(El).Declarations) + else if El is TPasClassType then + ReadMembers(Arr,TPasClassType(El).Members) + else if El is TPasRecordType then + ReadMembers(Arr,TPasRecordType(El).Members) + else if El is TPasEnumType then + ReadMembers(Arr,TPasEnumType(El).Values) + else if El is TPasModule then + begin + // a Module has only the Interface as child + if Arr.Count<>1 then + RaiseMsg(20180309180715,El,IntToStr(Arr.Count)); + Data:=Arr[0]; + if not (Data is TJSONObject) then + RaiseMsg(20180309180745,El); + SubObj:=TJSONObject(Data); + if not ReadString(SubObj,'Name',Name,El) then + RaiseMsg(20180309180749,El); + if Name<>'Interface' then + RaiseMsg(20180309180806,El); + Intf:=TPasModule(El).InterfaceSection; + if Intf=nil then + RaiseMsg(20180309180856,El); + ReadExtRefs(SubObj,Intf); + end + else + RaiseMsg(20180309180610,El); + end; +end; + procedure TPJUReader.ReadUsedUnits(Obj: TJSONObject; Section: TPasSection; aContext: TPJUReaderContext); var Arr: TJSONArray; - i, p: Integer; + i, Id: Integer; Data: TJSONData; - SubObj: TJSONObject; - Name, CurName, InFilename, ModuleName: string; + UsesObj, ModuleObj: TJSONObject; + Name, InFilename, ModuleName: string; Use: TPasUsesUnit; - Prim: TPrimitiveExpr; Module: TPasModule; + Scope, UsedScope: TPasSectionScope; begin if not ReadArray(Obj,'Uses',Arr,Section) then exit; + Scope:=Section.CustomData as TPasSectionScope; SetLength(Section.UsesClause,Arr.Count); for i:=0 to length(Section.UsesClause)-1 do Section.UsesClause[i]:=nil; @@ -4328,42 +4448,34 @@ begin Data:=Arr[i]; if not (Data is TJSONObject) then RaiseMsg(20180307103518,Section,GetObjName(Data)); - SubObj:=TJSONObject(Data); - if not ReadString(SubObj,'Name',Name,Section) then + UsesObj:=TJSONObject(Data); + if not ReadString(UsesObj,'Name',Name,Section) then RaiseMsg(20180307103629,Section); if not IsValidIdent(Name,true,true) then RaiseMsg(20180307103937,Section,Name); - ReadString(SubObj,'In',InFilename,Section); - ReadString(SubObj,'UnitName',ModuleName,Section); + ReadString(UsesObj,'In',InFilename,Section); + ReadString(UsesObj,'UnitName',ModuleName,Section); + {$IFDEF VerbosePJUFiler} + writeln('TPJUReader.ReadUsedUnits ',i,' Name="',Name,'" In="',InFilename,'" ModuleName="',ModuleName,'"'); + {$ENDIF} Use:=TPasUsesUnit.Create(Name,Section); Section.UsesClause[i]:=Use; - while Name<>'' do - begin - p:=Pos('.',Name); - if p>0 then - begin - CurName:=LeftStr(Name,p-1); - Delete(Name,1,p) - end - else - begin - CurName:=Name; - Name:=''; - end; - Prim:=TPrimitiveExpr.Create(Use,pekString,CurName); - if Use.Expr=nil then - Use.Expr:=Prim - else - Use.Expr:=TBinaryExpr.Create(Use,Use.Expr,Prim,eopSubIdent); - end; + // Use.Expr is not needed if InFilename<>'' then Use.InFilename:=TPrimitiveExpr.Create(Use,pekString,InFilename); if ModuleName='' then ModuleName:=Name; Module:=Resolver.FindModule(Name,Use.Expr,Use.InFilename); if Module=nil then RaiseMsg(20180307231247,Use); + Use.Module:=Module; + UsedScope:=Module.InterfaceSection.CustomData as TPasSectionScope; + Scope.UsesScopes.Add(UsedScope); + if ReadInteger(UsesObj,'Id',Id,Use) then + AddElReference(Id,Use,Use); // Refs + if ReadObject(UsesObj,'Module',ModuleObj,Use) then + ReadExtRefs(ModuleObj,Module); end; Resolver.CheckPendingUsedInterface(Section); if aContext=nil then ; @@ -6210,7 +6322,7 @@ var bp: TResolverBuiltInProc; pbt: TPas2jsBaseType; begin - if not ReadArray(Obj,'System',Arr,ErrorEl) then exit; + if not ReadArray(Obj,BuiltInNodeName,Arr,ErrorEl) then exit; for i:=0 to Arr.Count-1 do begin Data:=Arr[i]; diff --git a/packages/pastojs/tests/tcfiler.pas b/packages/pastojs/tests/tcfiler.pas index ba2b5e03a1..bb0ee0f275 100644 --- a/packages/pastojs/tests/tcfiler.pas +++ b/packages/pastojs/tests/tcfiler.pas @@ -45,6 +45,7 @@ type function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean; function OnRestConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean; function OnRestConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean; + function OnRestResolverFindUnit(const aUnitName: String): TPasModule; protected procedure SetUp; override; procedure TearDown; override; @@ -144,6 +145,9 @@ type procedure TestPC_Proc_UTF8; procedure TestPC_Class; procedure TestPC_Initialization; + + procedure TestPC_UseUnit; + procedure TestPC_UseUnit_Class; end; function CompareListOfProcScopeRef(Item1, Item2: Pointer): integer; @@ -203,6 +207,55 @@ begin Result:=RestAnalyzer.IsTypeInfoUsed(El); end; +function TCustomTestPrecompile.OnRestResolverFindUnit(const aUnitName: String + ): TPasModule; + + function FindRestUnit(Name: string): TPasModule; + var + i: Integer; + CurEngine: TTestEnginePasResolver; + CurUnitName: String; + begin + for i:=0 to ResolverCount-1 do + begin + CurEngine:=Resolvers[i]; + CurUnitName:=ExtractFileUnitName(CurEngine.Filename); + {$IFDEF VerbosePJUFiler} + //writeln('TCustomTestPrecompile.FindRestUnit Checking ',i,'/',ResolverCount,' ',CurEngine.Filename,' ',CurUnitName); + {$ENDIF} + if CompareText(Name,CurUnitName)=0 then + begin + Result:=CurEngine.Module; + if Result<>nil then + begin + {$IFDEF VerbosePJUFiler} + //writeln('TCustomTestPrecompile.FindRestUnit Found parsed module: ',Result.Filename); + {$ENDIF} + exit; + end; + {$IFDEF VerbosePJUFiler} + writeln('TCustomTestPrecompile.FindRestUnit PARSING unit "',CurEngine.Filename,'"'); + {$ENDIF} + Fail('not parsed'); + end; + end; + end; + +var + DefNamespace: String; +begin + if (Pos('.',aUnitName)<1) then + begin + DefNamespace:=GetDefaultNamespace; + if DefNamespace<>'' then + begin + Result:=FindRestUnit(DefNamespace+'.'+aUnitName); + if Result<>nil then exit; + end; + end; + Result:=FindRestUnit(aUnitName); +end; + procedure TCustomTestPrecompile.SetUp; begin inherited SetUp; @@ -287,7 +340,7 @@ begin RestResolver:=TTestEnginePasResolver.Create; RestResolver.Filename:=Engine.Filename; RestResolver.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs); - //RestResolver.OnFindUnit:=@OnPasResolverFindUnit; + RestResolver.OnFindUnit:=@OnRestResolverFindUnit; RestParser:=TPasParser.Create(RestScanner,RestFileResolver,RestResolver); RestParser.Options:=po_tcmodules; RestResolver.CurrentParser:=RestParser; @@ -1666,6 +1719,76 @@ begin WriteReadUnit; end; +procedure TTestPrecompile.TestPC_UseUnit; +begin + AddModuleWithIntfImplSrc('unit2.pp', + LinesToStr([ + 'type', + ' TColor = longint;', + ' TRec = record h: TColor; end;', + ' TEnum = (red,green);', + 'var', + ' c: TColor;', + ' r: TRec;', + ' e: TEnum;']), + LinesToStr([ + ''])); + + StartUnit(true); + Add([ + 'interface', + 'uses unit2;', + 'var', + ' i: system.longint;', + ' e2: TEnum;', + 'implementation', + 'initialization', + ' c:=1;', + ' r.h:=2;', + ' e:=red;', + 'end.', + '']); + WriteReadUnit; +end; + +procedure TTestPrecompile.TestPC_UseUnit_Class; +begin + AddModuleWithIntfImplSrc('unit2.pp', + LinesToStr([ + 'type', + ' TObject = class', + ' private', + ' FA: longint;', + ' public', + ' type', + ' TEnum = (red,green);', + ' public', + ' i: longint;', + ' e: TEnum;', + ' procedure DoIt; virtual; abstract;', + ' property A: longint read FA write FA;', + ' end;', + 'var', + ' o: TObject;']), + LinesToStr([ + ''])); + + StartUnit(true); + Add([ + 'interface', + 'uses unit2;', + 'var', + ' b: TObject;', + 'implementation', + 'initialization', + ' o.DoIt;', + ' o.i:=b.A;', + ' o.e:=red;', + 'end.', + '']); + WriteReadUnit; +end; + Initialization RegisterTests([TTestPrecompile]); end. diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 1b613dcf94..ccd1f766c3 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -100,10 +100,10 @@ type function GetResolverCount: integer; function GetResolvers(Index: integer): TTestEnginePasResolver; function OnPasResolverFindUnit(const aUnitName: String): TPasModule; - function FindUnit(const aUnitName: String): TPasModule; protected procedure SetUp; override; function CreateConverter: TPasToJSConverter; virtual; + function LoadUnit(const aUnitName: String): TPasModule; procedure InitScanner(aScanner: TPascalScanner); virtual; procedure TearDown; override; Procedure Add(Line: string); virtual; @@ -858,17 +858,17 @@ begin DefNamespace:=GetDefaultNamespace; if DefNamespace<>'' then begin - Result:=FindUnit(DefNamespace+'.'+aUnitName); + Result:=LoadUnit(DefNamespace+'.'+aUnitName); if Result<>nil then exit; end; end; - Result:=FindUnit(aUnitName); + Result:=LoadUnit(aUnitName); if Result<>nil then exit; writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"'); Fail('can''t find unit "'+aUnitName+'"'); end; -function TCustomTestModule.FindUnit(const aUnitName: String): TPasModule; +function TCustomTestModule.LoadUnit(const aUnitName: String): TPasModule; var i: Integer; CurEngine: TTestEnginePasResolver;