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

pastojs: implemented dotted unit reference

Browse Source 
git-svn-id: trunk@36118 -
This commit is contained in:
Mattias Gaertner 2017-05-05 14:20:10 +00:00
parent 96f88184ef
commit 4305ffcfa3
2 changed files with 128 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
packages/pastojs/src/fppas2js.pp
View File

@ -244,6 +244,7 @@ Works:
- ECMAScript6:
- use 0b for binary literals
- use 0o for octal literals
- dotted unit names, namespaces
ToDos:
- constant evaluation
@ -266,7 +267,6 @@ ToDos:
- check memleaks
- @@ compare method in delphi mode
- make records more lightweight
- dotted unit names, namespaces
- enumeration for..in..do
- pointer of record
- nested types in class
@ -10050,7 +10050,7 @@ begin
aModule:=UsesClause[i].Module as TPasModule;
if (not IsElementUsed(aModule)) and not IsSystemUnit(aModule) then
continue;
anUnitName := TransformVariableName(aModule,AContext);
anUnitName := TransformModuleName(aModule,false,AContext);
ArgEx := CreateLiteralString(UsesSection,anUnitName);
ArgArray.Elements.AddElement.Expr := ArgEx;
end;
@ -11805,13 +11805,35 @@ end;
function TPasToJSConverter.TransformModuleName(El: TPasModule;
AddModulesPrefix: boolean; AContext: TConvertContext): String;
var
p, StartP: Integer;
aName, Part: String;
begin
if El is TPasProgram then
Result:='program'
else
Result:=TransformVariableName(El,AContext);
begin
Result:='';
aName:=El.Name;
p:=1;
while p<=length(aName) do
begin
StartP:=p;
while (p<=length(aName)) and (aName[p]<>'.') do inc(p);
Part:=copy(aName,StartP,p-StartP);
Part:=TransformVariableName(El,Part,AContext);
if Result<>'' then Result:=Result+'.';
Result:=Result+Part;
inc(p);
end;
end;
if AddModulesPrefix then
Result:=FBuiltInNames[pbivnModules]+'.'+Result;
begin
if Pos('.',Result)>0 then
Result:=FBuiltInNames[pbivnModules]+'["'+Result+'"]'
else
Result:=FBuiltInNames[pbivnModules]+'.'+Result;
end;
end;
function TPasToJSConverter.IsPreservedWord(const aName: string): boolean;

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

@ -96,6 +96,7 @@ type
function GetModuleCount: integer;
function GetModules(Index: integer): TTestEnginePasResolver;
function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
function FindUnit(const aUnitName: String): TPasModule;
protected
procedure SetUp; override;
procedure TearDown; override;
@ -114,9 +115,9 @@ type
procedure AddSystemUnit; virtual;
procedure StartProgram(NeedSystemUnit: boolean); virtual;
procedure StartUnit(NeedSystemUnit: boolean); virtual;
Procedure ConvertModule; virtual;
Procedure ConvertProgram; virtual;
Procedure ConvertUnit; virtual;
procedure ConvertModule; virtual;
procedure ConvertProgram; virtual;
procedure ConvertUnit; virtual;
procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
function GetDottedIdentifier(El: TJSElement): string;
procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
@ -132,6 +133,7 @@ type
procedure HandleException(E: Exception);
procedure RaiseException(E: Exception);
procedure WriteSources(const aFilename: string; aRow, aCol: integer);
function GetDefaultNamespace: string;
property PasProgram: TPasProgram Read FPasProgram;
property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
property ModuleCount: integer read GetModuleCount;
@ -169,6 +171,8 @@ type
Procedure TestEmptyProgramUseStrict;
Procedure TestEmptyUnit;
Procedure TestEmptyUnitUseStrict;
Procedure TestDottedUnitNames;
Procedure TestDottedUnitExpr;
// vars/const
Procedure TestVarInt;
@ -594,28 +598,48 @@ end;
function TCustomTestModule.OnPasResolverFindUnit(const aUnitName: String
): TPasModule;
var
DefNamespace: String;
begin
//writeln('TTestModule.OnPasResolverFindUnit START Unit="',aUnitName,'"');
if (Pos('.',aUnitName)<1) then
begin
DefNamespace:=GetDefaultNamespace;
if DefNamespace<>'' then
begin
Result:=FindUnit(DefNamespace+'.'+aUnitName);
if Result<>nil then exit;
end;
end;
Result:=FindUnit(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;
var
i: Integer;
CurEngine: TTestEnginePasResolver;
CurUnitName: String;
begin
//writeln('TTestModule.OnPasResolverFindUnit START Unit="',aUnitName,'"');
//writeln('TTestModule.FindUnit START Unit="',aUnitName,'"');
Result:=nil;
for i:=0 to ModuleCount-1 do
begin
CurEngine:=Modules[i];
CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
//writeln('TTestModule.OnPasResolverFindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
//writeln('TTestModule.FindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
if CompareText(aUnitName,CurUnitName)=0 then
begin
Result:=CurEngine.Module;
if Result<>nil then exit;
//writeln('TTestModule.OnPasResolverFindUnit PARSING unit "',CurEngine.Filename,'"');
//writeln('TTestModule.FindUnit PARSING unit "',CurEngine.Filename,'"');
FileResolver.FindSourceFile(aUnitName);
CurEngine.Resolver:=TStreamResolver.Create;
CurEngine.Resolver.OwnsStreams:=True;
//writeln('TTestResolver.OnPasResolverFindUnit SOURCE=',CurEngine.Source);
//writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
@ -634,13 +658,11 @@ begin
on E: Exception do
HandleException(E);
end;
//writeln('TTestModule.OnPasResolverFindUnit END ',CurUnitName);
//writeln('TTestModule.FindUnit END ',CurUnitName);
Result:=CurEngine.Module;
exit;
end;
end;
writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"');
Fail('can''t find unit "'+aUnitName+'"');
end;
procedure TCustomTestModule.SetUp;
@ -844,7 +866,7 @@ begin
AddSystemUnit
else
Parser.ImplicitUses.Clear;
Add('program test1;');
Add('program '+ExtractFileUnitName(Filename)+';');
Add('');
end;
@ -1343,6 +1365,17 @@ begin
end;
end;
function TCustomTestModule.GetDefaultNamespace: string;
var
C: TClass;
begin
Result:='';
if FModule=nil then exit;
C:=FModule.ClassType;
if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
Result:=Engine.DefaultNameSpace;
end;
{ TTestModule }
procedure TTestModule.TestEmptyProgram;
@ -1388,6 +1421,64 @@ begin
'');
end;
procedure TTestModule.TestDottedUnitNames;
begin
AddModuleWithIntfImplSrc('NS1.Unit2.pas',
LinesToStr([
'var iV: longint;'
]),
'');
FFilename:='ns1.test1.pp';
StartProgram(true);
Add('uses unIt2;');
Add('implementation');
Add('var');
Add(' i: longint;');
Add('begin');
Add(' i:=iv;');
Add(' i:=uNit2.iv;');
Add(' i:=Ns1.TEst1.i;');
ConvertProgram;
CheckSource('TestDottedUnitNames',
LinesToStr([
'this.i = 0;',
'']),
LinesToStr([ // this.$init
'$mod.i = pas["NS1.Unit2"].iV;',
'$mod.i = pas["NS1.Unit2"].iV;',
'$mod.i = $mod.i;',
'']) );
end;
procedure TTestModule.TestDottedUnitExpr;
begin
AddModuleWithIntfImplSrc('NS2.SubNs2.Unit2.pas',
LinesToStr([
'procedure DoIt;'
]),
'procedure DoIt; begin end;');
FFilename:='Ns1.SubNs1.Test1.pp';
StartProgram(true);
Add('uses Ns2.sUbnS2.unIt2;');
Add('implementation');
Add('var');
Add(' i: longint;');
Add('begin');
Add(' ns2.subns2.unit2.doit;');
Add(' i:=Ns1.SubNS1.TEst1.i;');
ConvertProgram;
CheckSource('TestDottedUnitExpr',
LinesToStr([
'this.i = 0;',
'']),
LinesToStr([ // this.$init
'pas["NS2.SubNs2.Unit2"].DoIt();',
'$mod.i = $mod.i;',
'']) );
end;
procedure TTestModule.TestVarInt;
begin
StartProgram(false);