paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 06:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: filer: class in other unit

Browse Source 
git-svn-id: trunk@38479 -
This commit is contained in:
Mattias Gaertner 2018-03-10 10:17:33 +00:00
parent b2e21f4c4a
commit 787b2a2e05
3 changed files with 292 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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];

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

@ -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.

8
packages/pastojs/tests/tcmodules.pas
View File

@ -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;