|
|
@@ -0,0 +1,952 @@
|
|
|
+{
|
|
|
+ This file is part of the Free Component Library (FCL)
|
|
|
+ Copyright (c) 2014 by Michael Van Canneyt
|
|
|
+
|
|
|
+ Unit tests for Pascal-to-Javascript converter class.
|
|
|
+
|
|
|
+ See the file COPYING.FPC, included in this distribution,
|
|
|
+ for details about the copyright.
|
|
|
+
|
|
|
+ This program is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
+
|
|
|
+ **********************************************************************
|
|
|
+
|
|
|
+ Examples:
|
|
|
+ ./testpas2js --suite=TTestModuleConverter.TestEmptyProgram
|
|
|
+}
|
|
|
+unit tcmodules;
|
|
|
+
|
|
|
+{$mode objfpc}{$H+}
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+uses
|
|
|
+ Classes, SysUtils, fpcunit, testregistry, contnrs, fppas2js,
|
|
|
+ pastree, PScanner, PasResolver, PParser, jstree, jswriter, jsbase;
|
|
|
+
|
|
|
+const
|
|
|
+ po_pas2js = [po_asmwhole,po_resolvestandardtypes];
|
|
|
+type
|
|
|
+
|
|
|
+ { TTestPasParser }
|
|
|
+
|
|
|
+ TTestPasParser = Class(TPasParser)
|
|
|
+ end;
|
|
|
+
|
|
|
+ TOnFindUnit = function(const aUnitName: String): TPasModule of object;
|
|
|
+
|
|
|
+ { TTestEnginePasResolver }
|
|
|
+
|
|
|
+ TTestEnginePasResolver = class(TPasResolver)
|
|
|
+ private
|
|
|
+ FFilename: string;
|
|
|
+ FModule: TPasModule;
|
|
|
+ FOnFindUnit: TOnFindUnit;
|
|
|
+ FParser: TTestPasParser;
|
|
|
+ FResolver: TStreamResolver;
|
|
|
+ FScanner: TPascalScanner;
|
|
|
+ FSource: string;
|
|
|
+ procedure SetModule(AValue: TPasModule);
|
|
|
+ public
|
|
|
+ constructor Create;
|
|
|
+ destructor Destroy; override;
|
|
|
+ function FindModule(const AName: String): TPasModule; override;
|
|
|
+ property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
|
|
|
+ property Filename: string read FFilename write FFilename;
|
|
|
+ property Resolver: TStreamResolver read FResolver write FResolver;
|
|
|
+ property Scanner: TPascalScanner read FScanner write FScanner;
|
|
|
+ property Parser: TTestPasParser read FParser write FParser;
|
|
|
+ property Source: string read FSource write FSource;
|
|
|
+ property Module: TPasModule read FModule write SetModule;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { TTestModule }
|
|
|
+
|
|
|
+ TTestModule = Class(TTestCase)
|
|
|
+ private
|
|
|
+ FConverter: TPasToJSConverter;
|
|
|
+ FEngine: TTestEnginePasResolver;
|
|
|
+ FFilename: string;
|
|
|
+ FFileResolver: TStreamResolver;
|
|
|
+ FJSInitBody: TJSFunctionBody;
|
|
|
+ FJSInterfaceUses: TJSArrayLiteral;
|
|
|
+ FJSModule: TJSSourceElements;
|
|
|
+ FJSModuleSrc: TJSSourceElements;
|
|
|
+ FJSSource: TStringList;
|
|
|
+ FModule: TPasModule;
|
|
|
+ FJSModuleCallArgs: TJSArguments;
|
|
|
+ FModules: TObjectList;// list of TTestEnginePasResolver
|
|
|
+ FParser: TTestPasParser;
|
|
|
+ FPasProgram: TPasProgram;
|
|
|
+ FJSRegModuleCall: TJSCallExpression;
|
|
|
+ FScanner: TPascalScanner;
|
|
|
+ FSource: TStringList;
|
|
|
+ FFirstPasStatement: TPasImplBlock;
|
|
|
+ function GetModuleCount: integer;
|
|
|
+ function GetModules(Index: integer): TTestEnginePasResolver;
|
|
|
+ function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
|
|
|
+ protected
|
|
|
+ procedure SetUp; override;
|
|
|
+ procedure TearDown; override;
|
|
|
+ Procedure Add(Line: string);
|
|
|
+ Procedure StartParsing;
|
|
|
+ Procedure ParseModule;
|
|
|
+ procedure ParseProgram;
|
|
|
+ protected
|
|
|
+ function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver;
|
|
|
+ function AddModule(aFilename: string): TTestEnginePasResolver;
|
|
|
+ function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver;
|
|
|
+ function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
|
|
|
+ ImplementationSrc: string): TTestEnginePasResolver;
|
|
|
+ procedure AddSystemUnit;
|
|
|
+ procedure StartProgram(NeedSystemUnit: boolean);
|
|
|
+ Procedure ConvertProgram;
|
|
|
+ procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
|
|
|
+ function GetDottedIdentifier(El: TJSElement): string;
|
|
|
+ procedure CheckSource(Msg,Statements, InitStatements: string);
|
|
|
+ procedure CheckDiff(Msg, Expected, Actual: string);
|
|
|
+ property PasProgram: TPasProgram Read FPasProgram;
|
|
|
+ property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
|
|
|
+ property ModuleCount: integer read GetModuleCount;
|
|
|
+ property Engine: TTestEnginePasResolver read FEngine;
|
|
|
+ property Filename: string read FFilename;
|
|
|
+ Property Module: TPasModule Read FModule;
|
|
|
+ property FirstPasStatement: TPasImplBlock read FFirstPasStatement;
|
|
|
+ property Converter: TPasToJSConverter read FConverter;
|
|
|
+ property JSSource: TStringList read FJSSource;
|
|
|
+ property JSModule: TJSSourceElements read FJSModule;
|
|
|
+ property JSRegModuleCall: TJSCallExpression read FJSRegModuleCall;
|
|
|
+ property JSModuleCallArgs: TJSArguments read FJSModuleCallArgs;
|
|
|
+ property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
|
|
|
+ property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
|
|
|
+ property JSInitBody: TJSFunctionBody read FJSInitBody;
|
|
|
+ public
|
|
|
+ property Source: TStringList read FSource;
|
|
|
+ property FileResolver: TStreamResolver read FFileResolver;
|
|
|
+ property Scanner: TPascalScanner read FScanner;
|
|
|
+ property Parser: TTestPasParser read FParser;
|
|
|
+ Published
|
|
|
+ Procedure TestEmptyProgram;
|
|
|
+ Procedure TestVarInt;
|
|
|
+ Procedure TestEmptyProc;
|
|
|
+ Procedure TestProcTwoArgs;
|
|
|
+ Procedure TestFunctionInt;
|
|
|
+ Procedure TestFunctionString;
|
|
|
+ Procedure TestVarRecord;
|
|
|
+ Procedure TestForLoop;
|
|
|
+ Procedure TestForLoopInFunction;
|
|
|
+ Procedure TestRepeatUntil;
|
|
|
+ Procedure TestAsmBlock;
|
|
|
+ Procedure TestTryFinally;
|
|
|
+ end;
|
|
|
+
|
|
|
+function LinesToStr(Args: array of const): string;
|
|
|
+function ExtractFileUnitName(aFilename: string): string;
|
|
|
+function JSToStr(El: TJSElement): string;
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+function LinesToStr(Args: array of const): string;
|
|
|
+var
|
|
|
+ s: String;
|
|
|
+ i: Integer;
|
|
|
+begin
|
|
|
+ s:='';
|
|
|
+ for i:=Low(Args) to High(Args) do
|
|
|
+ case Args[i].VType of
|
|
|
+ vtChar: s += Args[i].VChar+LineEnding;
|
|
|
+ vtString: s += Args[i].VString^+LineEnding;
|
|
|
+ vtPChar: s += Args[i].VPChar+LineEnding;
|
|
|
+ vtWideChar: s += AnsiString(Args[i].VWideChar)+LineEnding;
|
|
|
+ vtPWideChar: s += AnsiString(Args[i].VPWideChar)+LineEnding;
|
|
|
+ vtAnsiString: s += AnsiString(Args[i].VAnsiString)+LineEnding;
|
|
|
+ vtWidestring: s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
|
|
|
+ vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
|
|
|
+ end;
|
|
|
+ Result:=s;
|
|
|
+end;
|
|
|
+
|
|
|
+function ExtractFileUnitName(aFilename: string): string;
|
|
|
+var
|
|
|
+ p: Integer;
|
|
|
+begin
|
|
|
+ Result:=ExtractFileName(aFilename);
|
|
|
+ if Result='' then exit;
|
|
|
+ for p:=length(Result) downto 1 do
|
|
|
+ case Result[p] of
|
|
|
+ '/','\': exit;
|
|
|
+ '.':
|
|
|
+ begin
|
|
|
+ Delete(Result,p,length(Result));
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function JSToStr(El: TJSElement): string;
|
|
|
+var
|
|
|
+ aWriter: TBufferWriter;
|
|
|
+ aJSWriter: TJSWriter;
|
|
|
+begin
|
|
|
+ aWriter:=TBufferWriter.Create(1000);
|
|
|
+ try
|
|
|
+ aJSWriter:=TJSWriter.Create(aWriter);
|
|
|
+ aJSWriter.IndentSize:=2;
|
|
|
+ aJSWriter.WriteJS(El);
|
|
|
+ Result:=aWriter.AsAnsistring;
|
|
|
+ finally
|
|
|
+ aWriter.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{ TTestEnginePasResolver }
|
|
|
+
|
|
|
+procedure TTestEnginePasResolver.SetModule(AValue: TPasModule);
|
|
|
+begin
|
|
|
+ if FModule=AValue then Exit;
|
|
|
+ if Module<>nil then
|
|
|
+ Module.Release;
|
|
|
+ FModule:=AValue;
|
|
|
+ if Module<>nil then
|
|
|
+ Module.AddRef;
|
|
|
+end;
|
|
|
+
|
|
|
+constructor TTestEnginePasResolver.Create;
|
|
|
+begin
|
|
|
+ inherited Create;
|
|
|
+ StoreSrcColumns:=true;
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TTestEnginePasResolver.Destroy;
|
|
|
+begin
|
|
|
+ FreeAndNil(FResolver);
|
|
|
+ Module:=nil;
|
|
|
+ FreeAndNil(FParser);
|
|
|
+ FreeAndNil(FScanner);
|
|
|
+ FreeAndNil(FResolver);
|
|
|
+ inherited Destroy;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestEnginePasResolver.FindModule(const AName: String): TPasModule;
|
|
|
+begin
|
|
|
+ Result:=nil;
|
|
|
+ if Assigned(OnFindUnit) then
|
|
|
+ Result:=OnFindUnit(AName);
|
|
|
+end;
|
|
|
+
|
|
|
+{ TTestModule }
|
|
|
+
|
|
|
+function TTestModule.GetModuleCount: integer;
|
|
|
+begin
|
|
|
+ Result:=FModules.Count;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestModule.GetModules(Index: integer
|
|
|
+ ): TTestEnginePasResolver;
|
|
|
+begin
|
|
|
+ Result:=TTestEnginePasResolver(FModules[Index]);
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestModule.OnPasResolverFindUnit(const aUnitName: String
|
|
|
+ ): TPasModule;
|
|
|
+var
|
|
|
+ i: Integer;
|
|
|
+ CurEngine: TTestEnginePasResolver;
|
|
|
+ CurUnitName: String;
|
|
|
+begin
|
|
|
+ //writeln('TTestModule.OnPasResolverFindUnit 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);
|
|
|
+ if CompareText(aUnitName,CurUnitName)=0 then
|
|
|
+ begin
|
|
|
+ Result:=CurEngine.Module;
|
|
|
+ if Result<>nil then exit;
|
|
|
+ //writeln('TTestModule.OnPasResolverFindUnit PARSING unit "',CurEngine.Filename,'"');
|
|
|
+ FileResolver.FindSourceFile(aUnitName);
|
|
|
+
|
|
|
+ CurEngine.Resolver:=TStreamResolver.Create;
|
|
|
+ CurEngine.Resolver.OwnsStreams:=True;
|
|
|
+ //writeln('TTestResolver.OnPasResolverFindUnit 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);
|
|
|
+ CurEngine.Parser.Options:=CurEngine.Parser.Options+po_pas2js;
|
|
|
+ if CompareText(CurUnitName,'System')=0 then
|
|
|
+ CurEngine.Parser.ImplicitUses.Clear;
|
|
|
+ CurEngine.Scanner.OpenFile(CurEngine.Filename);
|
|
|
+ try
|
|
|
+ CurEngine.Parser.NextToken;
|
|
|
+ CurEngine.Parser.ParseUnit(CurEngine.FModule);
|
|
|
+ except
|
|
|
+ on E: Exception do
|
|
|
+ begin
|
|
|
+ writeln('ERROR: TTestModule.OnPasResolverFindUnit during parsing: '+E.ClassName+':'+E.Message
|
|
|
+ +' File='+CurEngine.Scanner.CurFilename
|
|
|
+ +' LineNo='+IntToStr(CurEngine.Scanner.CurRow)
|
|
|
+ +' Col='+IntToStr(CurEngine.Scanner.CurColumn)
|
|
|
+ +' Line="'+CurEngine.Scanner.CurLine+'"'
|
|
|
+ );
|
|
|
+ raise E;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ //writeln('TTestModule.OnPasResolverFindUnit END ',CurUnitName);
|
|
|
+ Result:=CurEngine.Module;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"');
|
|
|
+ raise Exception.Create('can''t find unit "'+aUnitName+'"');
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.SetUp;
|
|
|
+begin
|
|
|
+ inherited SetUp;
|
|
|
+ FSource:=TStringList.Create;
|
|
|
+ FModules:=TObjectList.Create(true);
|
|
|
+
|
|
|
+ FFilename:='test1.pp';
|
|
|
+ FFileResolver:=TStreamResolver.Create;
|
|
|
+ FFileResolver.OwnsStreams:=True;
|
|
|
+ FScanner:=TPascalScanner.Create(FFileResolver);
|
|
|
+ FEngine:=AddModule(Filename);
|
|
|
+ FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
|
|
|
+ Parser.Options:=Parser.Options+po_pas2js;
|
|
|
+ FModule:=Nil;
|
|
|
+ FConverter:=TPasToJSConverter.Create;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TearDown;
|
|
|
+begin
|
|
|
+ FJSModule:=nil;
|
|
|
+ FJSRegModuleCall:=nil;
|
|
|
+ FJSModuleCallArgs:=nil;
|
|
|
+ FJSInterfaceUses:=nil;
|
|
|
+ FJSModuleSrc:=nil;
|
|
|
+ FJSInitBody:=nil;
|
|
|
+ FreeAndNil(FJSSource);
|
|
|
+ FreeAndNil(FJSModule);
|
|
|
+ FreeAndNil(FConverter);
|
|
|
+ Engine.Clear;
|
|
|
+ if Assigned(FModule) then
|
|
|
+ begin
|
|
|
+ FModule.Release;
|
|
|
+ FModule:=nil;
|
|
|
+ end;
|
|
|
+ FreeAndNil(FSource);
|
|
|
+ FreeAndNil(FParser);
|
|
|
+ FreeAndNil(FScanner);
|
|
|
+ FreeAndNil(FFileResolver);
|
|
|
+ if FModules<>nil then
|
|
|
+ begin
|
|
|
+ FreeAndNil(FModules);
|
|
|
+ FEngine:=nil;
|
|
|
+ end;
|
|
|
+
|
|
|
+ inherited TearDown;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.Add(Line: string);
|
|
|
+begin
|
|
|
+ Source.Add(Line);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.StartParsing;
|
|
|
+begin
|
|
|
+ FileResolver.AddStream(FileName,TStringStream.Create(Source.Text));
|
|
|
+ Scanner.OpenFile(FileName);
|
|
|
+ Writeln('// Test : ',Self.TestName);
|
|
|
+ Writeln(Source.Text);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.ParseModule;
|
|
|
+begin
|
|
|
+ StartParsing;
|
|
|
+ Parser.ParseMain(FModule);
|
|
|
+ AssertNotNull('Module resulted in Module',FModule);
|
|
|
+ AssertEquals('modulename',ChangeFileExt(FFileName,''),Module.Name);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.ParseProgram;
|
|
|
+begin
|
|
|
+ FFirstPasStatement:=nil;
|
|
|
+ try
|
|
|
+ ParseModule;
|
|
|
+ except
|
|
|
+ on E: EParserError do
|
|
|
+ begin
|
|
|
+ writeln('ERROR: TTestModule.ParseProgram Parser: '+E.ClassName+':'+E.Message
|
|
|
+ +' File='+Scanner.CurFilename
|
|
|
+ +' LineNo='+IntToStr(Scanner.CurRow)
|
|
|
+ +' Col='+IntToStr(Scanner.CurColumn)
|
|
|
+ +' Line="'+Scanner.CurLine+'"'
|
|
|
+ );
|
|
|
+ raise E;
|
|
|
+ end;
|
|
|
+ on E: EPasResolve do
|
|
|
+ begin
|
|
|
+ writeln('ERROR: TTestModule.ParseProgram PasResolver: '+E.ClassName+':'+E.Message
|
|
|
+ +' File='+Scanner.CurFilename
|
|
|
+ +' LineNo='+IntToStr(Scanner.CurRow)
|
|
|
+ +' Col='+IntToStr(Scanner.CurColumn)
|
|
|
+ +' Line="'+Scanner.CurLine+'"'
|
|
|
+ );
|
|
|
+ raise E;
|
|
|
+ end;
|
|
|
+ on E: Exception do
|
|
|
+ begin
|
|
|
+ writeln('ERROR: TTestModule.ParseProgram Exception: '+E.ClassName+':'+E.Message);
|
|
|
+ raise E;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
|
|
|
+ AssertEquals('Has program',TPasProgram,Module.ClassType);
|
|
|
+ FPasProgram:=TPasProgram(Module);
|
|
|
+ AssertNotNull('Has program section',PasProgram.ProgramSection);
|
|
|
+ AssertNotNull('Has initialization section',PasProgram.InitializationSection);
|
|
|
+ if (PasProgram.InitializationSection.Elements.Count>0) then
|
|
|
+ if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
|
|
|
+ FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestModule.FindModuleWithFilename(aFilename: string
|
|
|
+ ): TTestEnginePasResolver;
|
|
|
+var
|
|
|
+ i: Integer;
|
|
|
+begin
|
|
|
+ for i:=0 to ModuleCount-1 do
|
|
|
+ if CompareText(Modules[i].Filename,aFilename)=0 then
|
|
|
+ exit(Modules[i]);
|
|
|
+ Result:=nil;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestModule.AddModule(aFilename: string
|
|
|
+ ): TTestEnginePasResolver;
|
|
|
+begin
|
|
|
+ //writeln('TTestModuleConverter.AddModule ',aFilename);
|
|
|
+ if FindModuleWithFilename(aFilename)<>nil then
|
|
|
+ raise Exception.Create('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists');
|
|
|
+ Result:=TTestEnginePasResolver.Create;
|
|
|
+ Result.Filename:=aFilename;
|
|
|
+ Result.AddObjFPCBuiltInIdentifiers([btChar,btString,btLongint,btInt64,btBoolean,btDouble]);
|
|
|
+ Result.OnFindUnit:=@OnPasResolverFindUnit;
|
|
|
+ FModules.Add(Result);
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestModule.AddModuleWithSrc(aFilename, Src: string
|
|
|
+ ): TTestEnginePasResolver;
|
|
|
+begin
|
|
|
+ Result:=AddModule(aFilename);
|
|
|
+ Result.Source:=Src;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
|
|
|
+ ImplementationSrc: string): TTestEnginePasResolver;
|
|
|
+var
|
|
|
+ Src: String;
|
|
|
+begin
|
|
|
+ Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
|
|
|
+ Src+=LineEnding;
|
|
|
+ Src+='interface'+LineEnding;
|
|
|
+ Src+=LineEnding;
|
|
|
+ Src+=InterfaceSrc;
|
|
|
+ Src+='implementation'+LineEnding;
|
|
|
+ Src+=LineEnding;
|
|
|
+ Src+=ImplementationSrc;
|
|
|
+ Src+='end.'+LineEnding;
|
|
|
+ Result:=AddModuleWithSrc(aFilename,Src);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.AddSystemUnit;
|
|
|
+begin
|
|
|
+ AddModuleWithIntfImplSrc('system.pp',
|
|
|
+ // interface
|
|
|
+ LinesToStr([
|
|
|
+ 'type',
|
|
|
+ ' integer=longint;',
|
|
|
+ 'var',
|
|
|
+ ' ExitCode: Longint;',
|
|
|
+ ''
|
|
|
+ // implementation
|
|
|
+ ]),LinesToStr([
|
|
|
+ ''
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.StartProgram(NeedSystemUnit: boolean);
|
|
|
+begin
|
|
|
+ if NeedSystemUnit then
|
|
|
+ AddSystemUnit
|
|
|
+ else
|
|
|
+ Parser.ImplicitUses.Clear;
|
|
|
+ Add('program test1;');
|
|
|
+ Add('');
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.ConvertProgram;
|
|
|
+var
|
|
|
+ ModuleNameExpr: TJSLiteral;
|
|
|
+ FunDecl, InitFunction: TJSFunctionDeclarationStatement;
|
|
|
+ FunDef: TJSFuncDef;
|
|
|
+ InitAssign: TJSSimpleAssignStatement;
|
|
|
+ FunBody: TJSFunctionBody;
|
|
|
+begin
|
|
|
+ FJSSource:=TStringList.Create;
|
|
|
+ Add('end.');
|
|
|
+ ParseProgram;
|
|
|
+ FJSModule:=FConverter.ConvertPasElement(Module,nil) as TJSSourceElements;
|
|
|
+ FJSSource.Text:=JSToStr(JSModule);
|
|
|
+ writeln('TTestModule.ConvertProgram JS:');
|
|
|
+ write(FJSSource.Text);
|
|
|
+
|
|
|
+ // rtl.module(...
|
|
|
+ AssertEquals('jsmodule has one statement - the call',1,JSModule.Statements.Count);
|
|
|
+ AssertNotNull('register module call',JSModule.Statements.Nodes[0].Node);
|
|
|
+ AssertEquals('register module call',TJSCallExpression,JSModule.Statements.Nodes[0].Node.ClassType);
|
|
|
+ FJSRegModuleCall:=JSModule.Statements.Nodes[0].Node as TJSCallExpression;
|
|
|
+ AssertNotNull('register module rtl.module expr',JSRegModuleCall.Expr);
|
|
|
+ AssertNotNull('register module rtl.module args',JSRegModuleCall.Args);
|
|
|
+ AssertEquals('rtl.module args',TJSArguments,JSRegModuleCall.Args.ClassType);
|
|
|
+ FJSModuleCallArgs:=JSRegModuleCall.Args as TJSArguments;
|
|
|
+ AssertEquals('rtl.module args.count',3,JSModuleCallArgs.Elements.Count);
|
|
|
+
|
|
|
+ // parameter 'unitname'
|
|
|
+ AssertNotNull('module name param',JSModuleCallArgs.Elements.Elements[0].Expr);
|
|
|
+ ModuleNameExpr:=JSModuleCallArgs.Elements.Elements[0].Expr as TJSLiteral;
|
|
|
+ AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
|
|
|
+ AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString));
|
|
|
+
|
|
|
+ // main uses section
|
|
|
+ AssertNotNull('interface uses section',JSModuleCallArgs.Elements.Elements[1].Expr);
|
|
|
+ AssertEquals('interface uses section type',TJSArrayLiteral,JSModuleCallArgs.Elements.Elements[1].Expr.ClassType);
|
|
|
+ FJSInterfaceUses:=JSModuleCallArgs.Elements.Elements[1].Expr as TJSArrayLiteral;
|
|
|
+
|
|
|
+ // function()
|
|
|
+ AssertNotNull('module function',JSModuleCallArgs.Elements.Elements[2].Expr);
|
|
|
+ AssertEquals('module function type',TJSFunctionDeclarationStatement,JSModuleCallArgs.Elements.Elements[2].Expr.ClassType);
|
|
|
+ FunDecl:=JSModuleCallArgs.Elements.Elements[2].Expr as TJSFunctionDeclarationStatement;
|
|
|
+ AssertNotNull('module function def',FunDecl.AFunction);
|
|
|
+ FunDef:=FunDecl.AFunction as TJSFuncDef;
|
|
|
+ AssertEquals('module function name','',String(FunDef.Name));
|
|
|
+ AssertNotNull('module function body',FunDef.Body);
|
|
|
+ FunBody:=FunDef.Body as TJSFunctionBody;
|
|
|
+ FJSModuleSrc:=FunBody.A as TJSSourceElements;
|
|
|
+
|
|
|
+ // init this.$main - the last statement
|
|
|
+ AssertEquals('this.$main function 1',true,JSModuleSrc.Statements.Count>0);
|
|
|
+ InitAssign:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node as TJSSimpleAssignStatement;
|
|
|
+ CheckDottedIdentifier('init function',InitAssign.LHS,'this.$main');
|
|
|
+
|
|
|
+ InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
|
|
|
+ FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
|
|
|
+ DottedName: string);
|
|
|
+begin
|
|
|
+ if DottedName='' then
|
|
|
+ begin
|
|
|
+ AssertNull(Msg,El);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ AssertNotNull(Msg,El);
|
|
|
+ AssertEquals(Msg,DottedName,GetDottedIdentifier(EL));
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TTestModule.GetDottedIdentifier(El: TJSElement): string;
|
|
|
+begin
|
|
|
+ if El=nil then
|
|
|
+ Result:=''
|
|
|
+ else if El is TJSPrimaryExpressionIdent then
|
|
|
+ Result:=String(TJSPrimaryExpressionIdent(El).Name)
|
|
|
+ else if El is TJSDotMemberExpression then
|
|
|
+ Result:=GetDottedIdentifier(TJSDotMemberExpression(El).MExpr)+'.'+String(TJSDotMemberExpression(El).Name)
|
|
|
+ else
|
|
|
+ AssertEquals('GetDottedIdentifier',TJSPrimaryExpressionIdent,El.ClassType);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.CheckSource(Msg, Statements, InitStatements: string);
|
|
|
+var
|
|
|
+ ActualSrc, ExpectedSrc: String;
|
|
|
+begin
|
|
|
+ ActualSrc:=JSToStr(JSModuleSrc);
|
|
|
+ ExpectedSrc:=Statements+LineEnding
|
|
|
+ +'this.$main = function () {'+LineEnding
|
|
|
+ +InitStatements
|
|
|
+ +'};'+LineEnding;
|
|
|
+ CheckDiff(Msg,ExpectedSrc,ActualSrc);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.CheckDiff(Msg, Expected, Actual: string);
|
|
|
+// search diff, ignore changes in spaces
|
|
|
+const
|
|
|
+ SpaceChars = [#9,#10,#13,' '];
|
|
|
+var
|
|
|
+ ExpectedP, ActualP: PChar;
|
|
|
+
|
|
|
+ function FindLineEnd(p: PChar): PChar;
|
|
|
+ begin
|
|
|
+ Result:=p;
|
|
|
+ while not (Result^ in [#0,#10,#13]) do inc(Result);
|
|
|
+ end;
|
|
|
+
|
|
|
+ function FindLineStart(p, MinP: PChar): PChar;
|
|
|
+ begin
|
|
|
+ while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
|
|
|
+ Result:=p;
|
|
|
+ end;
|
|
|
+
|
|
|
+ procedure DiffFound;
|
|
|
+ var
|
|
|
+ ActLineStartP, ActLineEndP, p, StartPos: PChar;
|
|
|
+ ExpLine, ActLine: String;
|
|
|
+ i: Integer;
|
|
|
+ begin
|
|
|
+ writeln('Diff found "',Msg,'". Lines:');
|
|
|
+ // write correct lines
|
|
|
+ p:=PChar(Expected);
|
|
|
+ repeat
|
|
|
+ StartPos:=p;
|
|
|
+ while not (p^ in [#0,#10,#13]) do inc(p);
|
|
|
+ ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
|
|
|
+ if p^ in [#10,#13] then begin
|
|
|
+ if (p[1] in [#10,#13]) and (p^<>p[1]) then
|
|
|
+ inc(p,2)
|
|
|
+ else
|
|
|
+ inc(p);
|
|
|
+ end;
|
|
|
+ if p<=ExpectedP then begin
|
|
|
+ writeln('= ',ExpLine);
|
|
|
+ end else begin
|
|
|
+ // diff line
|
|
|
+ // write actual line
|
|
|
+ ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
|
|
|
+ ActLineEndP:=FindLineEnd(ActualP);
|
|
|
+ ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
|
|
|
+ writeln('- ',ActLine);
|
|
|
+ // write expected line
|
|
|
+ writeln('+ ',ExpLine);
|
|
|
+ // write empty line with pointer ^
|
|
|
+ for i:=1 to 2+ExpectedP-StartPos do write(' ');
|
|
|
+ writeln('^');
|
|
|
+ AssertEquals(Msg,ExpLine,ActLine);
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ until p^=#0;
|
|
|
+ raise Exception.Create('diff found, but lines are the same, internal error');
|
|
|
+ end;
|
|
|
+
|
|
|
+var
|
|
|
+ IsSpaceNeeded: Boolean;
|
|
|
+ LastChar: Char;
|
|
|
+begin
|
|
|
+ if Expected='' then Expected:=' ';
|
|
|
+ if Actual='' then Actual:=' ';
|
|
|
+ ExpectedP:=PChar(Expected);
|
|
|
+ ActualP:=PChar(Actual);
|
|
|
+ repeat
|
|
|
+ //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
|
|
|
+ case ExpectedP^ of
|
|
|
+ #0:
|
|
|
+ begin
|
|
|
+ // check that rest of Actual has only spaces
|
|
|
+ while ActualP^ in SpaceChars do inc(ActualP);
|
|
|
+ if ActualP^<>#0 then
|
|
|
+ DiffFound;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ ' ',#9,#10,#13:
|
|
|
+ begin
|
|
|
+ // skip space in Expected
|
|
|
+ IsSpaceNeeded:=false;
|
|
|
+ if ExpectedP>PChar(Expected) then
|
|
|
+ LastChar:=ExpectedP[-1]
|
|
|
+ else
|
|
|
+ LastChar:=#0;
|
|
|
+ while ExpectedP^ in SpaceChars do inc(ExpectedP);
|
|
|
+ if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
|
|
|
+ and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
|
|
|
+ IsSpaceNeeded:=true;
|
|
|
+ if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
|
|
|
+ DiffFound;
|
|
|
+ while ActualP^ in SpaceChars do inc(ActualP);
|
|
|
+ end;
|
|
|
+ else
|
|
|
+ while ActualP^ in SpaceChars do inc(ActualP);
|
|
|
+ if ExpectedP^<>ActualP^ then
|
|
|
+ DiffFound;
|
|
|
+ inc(ExpectedP);
|
|
|
+ inc(ActualP);
|
|
|
+ end;
|
|
|
+ until false;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestEmptyProgram;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('Empty program','','');
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestVarInt;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarInt','this.i=0;','');
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestEmptyProc;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('procedure Test;');
|
|
|
+ Add('begin');
|
|
|
+ Add('end;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestEmptyProc',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.test = function () {',
|
|
|
+ '};'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ''
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestProcTwoArgs;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('procedure Test(a,b: longint);');
|
|
|
+ Add('begin');
|
|
|
+ Add('end;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestProcTwoArgs',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.test = function (a,b) {',
|
|
|
+ '};'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ''
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestFunctionInt;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('function Test(a: longint): longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' Result:=2*a');
|
|
|
+ Add('end;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestProcTwoArgs',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.test = function (a) {',
|
|
|
+ ' var result = 0;',
|
|
|
+ ' result = (2*a);',
|
|
|
+ ' return result;',
|
|
|
+ '};'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ''
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestFunctionString;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('function Test(a: string): string;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' Result:=a+a');
|
|
|
+ Add('end;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestProcTwoArgs',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.test = function (a) {',
|
|
|
+ ' var result = "";',
|
|
|
+ ' result = (a+a);',
|
|
|
+ ' return result;',
|
|
|
+ '};'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ''
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestVarRecord;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('type');
|
|
|
+ Add(' TRecA = record');
|
|
|
+ Add(' B: longint;');
|
|
|
+ Add(' end;');
|
|
|
+ Add('var r: TRecA;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' r.B:=123');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.treca = function () {',
|
|
|
+ ' b = 0;',
|
|
|
+ '};',
|
|
|
+ 'this.r = new this.treca();'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'this.r.b = 123;'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestForLoop;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var');
|
|
|
+ Add(' i, j, n: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' j:=0;');
|
|
|
+ Add(' n:=3;');
|
|
|
+ Add(' for i:=1 to n do');
|
|
|
+ Add(' begin');
|
|
|
+ Add(' j:=j+i;');
|
|
|
+ Add(' end;');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;',
|
|
|
+ 'this.j = 0;',
|
|
|
+ 'this.n = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ' this.j = 0;',
|
|
|
+ ' this.n = 3;',
|
|
|
+ ' this.i = 1;',
|
|
|
+ ' for (var $loopend = this.n; (this.i <= $loopend); this.i++) {',
|
|
|
+ ' this.j = (this.j + this.i);',
|
|
|
+ ' };'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestForLoopInFunction;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('function SumNumbers(n: longint): longint;');
|
|
|
+ Add('var');
|
|
|
+ Add(' i, j: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' j:=0;');
|
|
|
+ Add(' for i:=1 to n do');
|
|
|
+ Add(' begin');
|
|
|
+ Add(' j:=j+i;');
|
|
|
+ Add(' end;');
|
|
|
+ Add('end;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' SumNumbers(3);');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.sumnumbers = function (n) {',
|
|
|
+ ' var result = 0;',
|
|
|
+ ' var i = 0;',
|
|
|
+ ' var j = 0;',
|
|
|
+ ' j = 0;',
|
|
|
+ ' i = 1;',
|
|
|
+ ' for (var $loopend = n; (i <= $loopend); i++) {',
|
|
|
+ ' j = (j + i);',
|
|
|
+ ' };',
|
|
|
+ ' return result;',
|
|
|
+ '};'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ' this.sumnumbers(3);'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestRepeatUntil;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var');
|
|
|
+ Add(' i, j, n: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' n:=3;');
|
|
|
+ Add(' j:=0;');
|
|
|
+ Add(' i:=0;');
|
|
|
+ Add(' repeat');
|
|
|
+ Add(' i:=i+1;');
|
|
|
+ Add(' j:=j+i;');
|
|
|
+ Add(' until i>=n');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;',
|
|
|
+ 'this.j = 0;',
|
|
|
+ 'this.n = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ' this.n = 3;',
|
|
|
+ ' this.j = 0;',
|
|
|
+ ' this.i = 0;',
|
|
|
+ ' do{',
|
|
|
+ ' this.i = (this.i + 1);',
|
|
|
+ ' this.j = (this.j + this.i);',
|
|
|
+ ' }while(!(this.i>=this.n));'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestAsmBlock;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var');
|
|
|
+ Add(' i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' i:=1;');
|
|
|
+ Add(' asm');
|
|
|
+ Add(' if (i==1) {');
|
|
|
+ Add(' i=2;');
|
|
|
+ Add(' }');
|
|
|
+ Add(' if (i==2){ i=3; }');
|
|
|
+ Add(' end;');
|
|
|
+ Add(' i:=4;');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestAsm',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ' this.i = 1;',
|
|
|
+ 'if (i==1) {',
|
|
|
+ 'i=2;',
|
|
|
+ '}',
|
|
|
+ 'if (i==2){ i=3; }',
|
|
|
+ ';',
|
|
|
+ 'this.i = 4;'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestTryFinally;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' try');
|
|
|
+ Add(' i:=0; i:=2 div i;');
|
|
|
+ Add(' finally');
|
|
|
+ Add(' i:=3');
|
|
|
+ Add(' end;');
|
|
|
+ ConvertProgram;
|
|
|
+end;
|
|
|
+
|
|
|
+Initialization
|
|
|
+ RegisterTests([TTestModule]);
|
|
|
+end.
|
|
|
+
|
michael