pastojs: added option -JoCheckVersion

git-svn-id: trunk@39851 -

packages/fcl-passrc/tests/tcresolver.pas

@@ -916,7 +916,9 @@ procedure TCustomTestResolver.TearDown;
 {$IFDEF CheckPasTreeRefCount}
 var El: TPasElement;
 {$ENDIF}
+{$IF defined(VerbosePasResolver) or defined(VerbosePasResolverMem)}
 var i: Integer;
+{$ENDIF}
 begin
   FResolverMsgs.Clear;
   FResolverGoodMsgs.Clear;

packages/pastojs/src/fppas2js.pp

@@ -361,6 +361,7 @@ ToDos:
   v:=a[0]  gives Local variable "a" is assigned but never used
 - bug:
   exit(something) gives function result not set
+- double utf8bom at start must give error  pscanner 4259
 - setlength(dynarray)  modeswitch to not create a copy
 - check rtl.js version
 - 'new', 'Function' -> class var use .prototype
@@ -521,6 +522,7 @@ type
     pbifnAs,
     pbifnAsExt,
     pbifnCheckMethodCall,
+    pbifnCheckVersion,
     pbifnClassInstanceFree,
     pbifnClassInstanceNew,
     pbifnCreateClass,
@@ -666,6 +668,7 @@ const
     'as', // rtl.as
     'asExt', // rtl.asExt
     'checkMethodCall',
+    'checkVersion',
     '$destroy',
     '$create',
     'createClass', // rtl.createClass
@@ -1404,7 +1407,10 @@ type
     coUseStrict,   // insert 'use strict'
     coNoTypeInfo,  // do not generate RTTI
     coEliminateDeadCode,  // skip code that is never executed
-    coStoreImplJS  // store references to JS code in procscopes
+    coStoreImplJS,  // store references to JS code in procscopes
+    coRTLVersionCheckMain, // insert rtl version check into main
+    coRTLVersionCheckSystem, // insert rtl version check into system unit init
+    coRTLVersionCheckUnit // insert rtl version check into every unit init
     );
   TPasToJsConverterOptions = set of TPasToJsConverterOption;
 const
@@ -1470,6 +1476,7 @@ type
     FOnIsTypeInfoUsed: TPas2JSIsElementUsedEvent;
     FOptions: TPasToJsConverterOptions;
     FReservedWords: TJSReservedWordList; // sorted with CompareStr
+    FRTLVersion: TJSNumber;
     FTargetPlatform: TPasToJsPlatform;
     FTargetProcessor: TPasToJsProcessor;
     Function CreatePrimitiveDotExpr(AName: string; Src: TPasElement): TJSElement;
@@ -1643,6 +1650,7 @@ type
     Procedure AddInFrontOfFunctionTry(NewEl: TJSElement; PosEl: TPasElement;
       FuncContext: TFunctionContext);
     Procedure AddInterfaceReleases(FuncContext: TFunctionContext; PosEl: TPasElement);
+    Procedure AddRTLVersionCheck(FuncContext: TFunctionContext; PosEl: TPasElement);
     // Statements
     Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
     Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
@@ -1783,6 +1791,7 @@ type
     Function ConvertPasElement(El: TPasElement; Resolver: TPas2JSResolver) : TJSElement;
     // options
     Property Options: TPasToJsConverterOptions read FOptions write FOptions default DefaultPasToJSOptions;
+    Property RTLVersion: TJSNumber read FRTLVersion write FRTLVersion;
     Property TargetPlatform: TPasToJsPlatform read FTargetPlatform write FTargetPlatform;
     Property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor;
     Property UseLowerCase: boolean read GetUseLowerCase write SetUseLowerCase default true;
@@ -5146,14 +5155,14 @@ Unit:
 *)
 Var
   OuterSrc , Src: TJSSourceElements;
-  RegModuleCall: TJSCallExpression;
+  RegModuleCall, Call: TJSCallExpression;
   ArgArray: TJSArguments;
   FunDecl, ImplFunc: TJSFunctionDeclarationStatement;
   UsesSection: TPasSection;
   ModuleName, ModVarName: String;
   IntfContext: TSectionContext;
   ImplVarSt: TJSVariableStatement;
-  HasImplUsesClause, ok: Boolean;
+  HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean;
   UsesClause: TPasUsesClause;
 begin
   Result:=Nil;
@@ -5191,6 +5200,16 @@ begin
       // "use strict" must be the first statement in a function
       AddToSourceElements(Src,CreateLiteralString(El,'use strict'));
 
+    NeedRTLCheckVersion:=(coRTLVersionCheckUnit in Options)
+        or ((coRTLVersionCheckSystem in Options) and IsSystemUnit(El));
+    if NeedRTLCheckVersion then
+      begin
+      Call:=CreateCallExpression(El);
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnCheckVersion]]);
+      Call.AddArg(CreateLiteralNumber(El,RTLVersion));
+      AddToSourceElements(Src,Call);
+      end;
+
     ImplVarSt:=nil;
     HasImplUsesClause:=false;
 
@@ -12654,7 +12673,7 @@ function TPasToJSConverter.ConvertInitializationSection(
 var
   FDS: TJSFunctionDeclarationStatement;
   FunName: String;
-  IsMain: Boolean;
+  IsMain, NeedRTLCheckVersion: Boolean;
   AssignSt: TJSSimpleAssignStatement;
   FuncContext: TFunctionContext;
   Body: TJSFunctionBody;
@@ -12681,13 +12700,17 @@ begin
     FunName:=FBuiltInNames[pbifnProgramMain]
   else
     FunName:=FBuiltInNames[pbifnUnitInit];
+  NeedRTLCheckVersion:=IsMain and (coRTLVersionCheckMain in Options);
 
   FuncContext:=nil;
   AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
   try
+    // $mod.$init =
     AssignSt.LHS:=CreateMemberExpression([FBuiltInNames[pbivnModule],FunName]);
-    FDS:=CreateFunctionSt(El,El.Elements.Count>0);
+    // = function(){...}
+    FDS:=CreateFunctionSt(El,(El.Elements.Count>0) or NeedRTLCheckVersion);
     AssignSt.Expr:=FDS;
+
     if El.Elements.Count>0 then
       begin
       Body:=FDS.AFunction.Body;
@@ -12700,6 +12723,16 @@ begin
       AddInterfaceReleases(FuncContext,El);
       Body.A:=FuncContext.BodySt;
       end;
+
+    if NeedRTLCheckVersion then
+      begin
+      // prepend rtl.versionCheck
+      Body:=FDS.AFunction.Body;
+      if FuncContext=nil then
+        FuncContext:=TFunctionContext.Create(El,Body,AContext);
+      AddRTLVersionCheck(FuncContext,El);
+      Body.A:=FuncContext.BodySt;
+      end;
     Result:=AssignSt;
   finally
     FuncContext.Free;
@@ -14900,6 +14933,41 @@ begin
       end;
 end;
 
+procedure TPasToJSConverter.AddRTLVersionCheck(FuncContext: TFunctionContext;
+  PosEl: TPasElement);
+var
+  St: TJSElement;
+  Call: TJSCallExpression;
+  NewSt: TJSStatementList;
+begin
+  St:=FuncContext.BodySt;
+  // rtl.checkVersion(RTLVersion)
+  Call:=CreateCallExpression(PosEl);
+  Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnCheckVersion]]);
+  Call.AddArg(CreateLiteralNumber(PosEl,RTLVersion));
+  if St=nil then
+    FuncContext.BodySt:=Call
+  else if St is TJSEmptyBlockStatement then
+    begin
+    St.Free;
+    FuncContext.BodySt:=Call;
+    end
+  else if St is TJSStatementList then
+    begin
+    NewSt:=TJSStatementList(CreateElement(TJSStatementList,PosEl));
+    NewSt.A:=Call;
+    NewSt.B:=St;
+    FuncContext.BodySt:=NewSt;
+    end
+  else
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.AddRTLVersionCheck St=',GetObjName(St));
+    {$ENDIF}
+    RaiseNotSupported(PosEl,FuncContext,20181002154026,GetObjName(St));
+    end;
+end;
+
 function TPasToJSConverter.ConvertImplBlock(El: TPasImplBlock;
   AContext: TConvertContext): TJSElement;
 begin
@@ -16285,7 +16353,7 @@ end;
 
 function TPasToJSConverter.IsSystemUnit(aModule: TPasModule): boolean;
 begin
-  Result:=CompareText(aModule.Name,'system')=0;
+  Result:=(CompareText(aModule.Name,'system')=0) and (aModule.ClassType=TPasModule);
 end;
 
 function TPasToJSConverter.HasTypeInfo(El: TPasType; AContext: TConvertContext

packages/pastojs/src/pas2jscompiler.pp

@@ -116,8 +116,15 @@ type
     );
   TP2jsCompilerOptions = set of TP2jsCompilerOption;
   TP2jsOptimization = coEnumValuesAsNumbers..coKeepNotUsedDeclarationsWPO;
+  TP2jsRTLVersionCheck = (
+    rvcNone,
+    rvcMain,
+    rvcSystem,
+    rvcUnit
+    );
 const
   DefaultP2jsCompilerOptions = [coShowErrors,coSourceMapXSSIHeader,coUseStrict];
+  DefaultP2jsRTLVersionCheck = rvcNone;
   coShowAll = [coShowErrors..coShowDebug];
   coO1Enable = [coEnumValuesAsNumbers];
   coO1Disable = [coKeepNotUsedPrivates,coKeepNotUsedDeclarationsWPO];
@@ -418,6 +425,7 @@ type
   private
     FInterfaceType: TPasClassInterfaceType;
     FPrecompileInitialFlags: TPCUInitialFlags;
+    FRTLVersionCheck: TP2jsRTLVersionCheck;
     procedure AddDefinesForTargetPlatform;
     procedure AddDefinesForTargetProcessor;
     procedure AddReadingModule(aFile: TPas2jsCompilerFile);
@@ -507,6 +515,7 @@ type
     property ParamMacros: TPas2jsMacroEngine read FParamMacros;
     property PrecompileGUID: TGUID read FPrecompileGUID write FPrecompileGUID;
     property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags;
+    property RTLVersionCheck: TP2jsRTLVersionCheck read FRTLVersionCheck write FRTLVersionCheck;
     property SrcMapEnable: boolean read GetSrcMapEnable write SetSrcMapEnable;
     property SrcMapSourceRoot: string read FSrcMapSourceRoot write FSrcMapSourceRoot;
     property SrcMapBaseDir: string read GetSrcMapBaseDir write SetSrcMapBaseDir;
@@ -828,6 +837,13 @@ begin
     Include(Result,fppas2js.coLowerCase)
   else
     Exclude(Result,fppas2js.coLowerCase);
+
+  case Compiler.RTLVersionCheck of
+    rvcNone: ;
+    rvcMain: Include(Result,fppas2js.coRTLVersionCheckMain);
+    rvcSystem: Include(Result,fppas2js.coRTLVersionCheckSystem);
+    rvcUnit: Include(Result,fppas2js.coRTLVersionCheckUnit);
+  end;
 end;
 
 procedure TPas2jsCompilerFile.CreateScannerAndParser(aFileResolver: TPas2jsFileResolver);
@@ -920,6 +936,7 @@ procedure TPas2jsCompilerFile.CreateConverter;
 begin
   if FConverter<>nil then exit;
   FConverter:=TPasToJSConverter.Create;
+  FConverter.RTLVersion:=(VersionMajor*100+VersionMinor)*100+VersionRelease;
   FConverter.Options:=GetInitialConverterOptions;
   FConverter.TargetPlatform:=Compiler.TargetPlatform;
   FConverter.TargetProcessor:=Compiler.TargetProcessor;
@@ -3280,6 +3297,12 @@ begin
                 FileCache.SearchLikeFPC:=Enable
               else if SameText(Identifier,'UseStrict') then
                 SetOption(coUseStrict,Enable)
+              else if Enable and SameText(Identifier,'CheckVersion=main') then
+                RTLVersionCheck:=rvcMain
+              else if Enable and SameText(Identifier,'CheckVersion=system') then
+                RTLVersionCheck:=rvcSystem
+              else if Enable and SameText(Identifier,'CheckVersion=unit') then
+                RTLVersionCheck:=rvcUnit
               else
                 UnknownParam;
             end;
@@ -3837,6 +3860,7 @@ begin
 
   FCompilerExe:='';
   FOptions:=DefaultP2jsCompilerOptions;
+  FRTLVersionCheck:=DefaultP2jsRTLVersionCheck;
   FMode:=p2jmObjFPC;
   FTargetPlatform:=PlatformBrowser;
   FTargetProcessor:=ProcessorECMAScript5;
@@ -4063,6 +4087,10 @@ begin
   l('   -Jo<x> : Enable or disable extra option. The x is case insensitive:');
   l('     -JoSearchLikeFPC : search source files like FPC, default: search case insensitive.');
   l('     -JoUseStrict : add "use strict" to modules, default.');
+  l('     -JoCheckVersion- : do not add rtl version check, default.');
+  l('     -JoCheckVersion=main : insert rtl version check into main.');
+  l('     -JoCheckVersion=system : insert rtl version check into system unit init.');
+  l('     -JoCheckVersion=unit : insert rtl version check into every unit init.');
   l('   -Ju<x> : Add <x> to foreign unit paths. Foreign units are not compiled.');
   if PrecompileFormats.Count>0 then
   begin

packages/pastojs/src/pas2jsfiler.pp

@@ -211,7 +211,10 @@ const
     'UseStrict',
     'NoTypeInfo',
     'EliminateDeadCode',
-    'StoreImplJS'
+    'StoreImplJS',
+    'RTLVersionCheckMain',
+    'RTLVersionCheckSystem',
+    'RTLVersionCheckUnit'
     );
 
   PCUDefaultTargetPlatform = PlatformBrowser;

packages/pastojs/tests/tcprecompile.pas

@@ -25,7 +25,7 @@ interface
 
 uses
   Classes, SysUtils,
-  fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler,
+  fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler, Pas2jsCompiler,
   tcunitsearch, tcmodules;
 
 type
@@ -42,6 +42,7 @@ type
       SharedParams: TStringList = nil;
       FirstRunParams: TStringList = nil;
       SecondRunParams: TStringList = nil; ExpExitCode: integer = 0);
+    function GetJSFilename(ModuleName: string): string; virtual;
   public
     constructor Create; override;
     property PCUFormat: TPas2JSPrecompileFormat read FPCUFormat write FPCUFormat;
@@ -62,6 +63,9 @@ type
     procedure TestPCU_ClassConstructor;
     procedure TestPCU_ClassInterface;
     procedure TestPCU_Namespace;
+    procedure TestPCU_CheckVersionMain;
+    procedure TestPCU_CheckVersionMain2;
+    procedure TestPCU_CheckVersionSystem;
   end;
 
 function LinesToList(const Lines: array of string): TStringList;
@@ -98,13 +102,15 @@ begin
     writeln('TTestCLI_Precompile.CheckPrecompile create pcu files=========================');
     {$ENDIF}
     Params.Clear;
+    Params.Add('-Jminclude');
+    Params.Add('-Jc');
     if SharedParams<>nil then
-      Params.Assign(SharedParams);
+      Params.AddStrings(SharedParams);
     if FirstRunParams<>nil then
       Params.AddStrings(FirstRunParams);
-    Compile([MainFile,'-Jc','-Fu'+UnitPaths,'-JU'+PCUFormat.Ext,'-FU'+UnitOutputDir,'-Jminclude']);
+    Compile([MainFile,'-Fu'+UnitPaths,'-JU'+PCUFormat.Ext,'-FU'+UnitOutputDir]);
     AssertFileExists(UnitOutputDir+'/system.'+PCUFormat.Ext);
-    JSFilename:=UnitOutputDir+PathDelim+ExtractFilenameOnly(MainFile)+'.js';
+    JSFilename:=GetJSFilename(MainFile);
     AssertFileExists(JSFilename);
     JSFile:=FindFile(JSFilename);
     OrigSrc:=JSFile.Source;
@@ -115,19 +121,21 @@ begin
     JSFile.Source:='';
     Compiler.Reset;
     Params.Clear;
+    Params.Add('-Jminclude');
+    Params.Add('-Jc');
     if SharedParams<>nil then
-      Params.Assign(SharedParams);
+      Params.AddStrings(SharedParams);
     if SecondRunParams<>nil then
       Params.AddStrings(SecondRunParams);
-    Compile([MainFile,'-Jc','-FU'+UnitOutputDir,'-Jminclude'],ExpExitCode);
+    Compile([MainFile,'-FU'+UnitOutputDir],ExpExitCode);
     if ExpExitCode=0 then
       begin
       NewSrc:=JSFile.Source;
       if not CheckSrcDiff(OrigSrc,NewSrc,s) then
-      begin
+        begin
         WriteSources;
         Fail('test1.js: '+s);
-      end;
+        end;
       end;
   finally
     SharedParams.Free;
@@ -136,6 +144,11 @@ begin
   end;
 end;
 
+function TCustomTestCLI_Precompile.GetJSFilename(ModuleName: string): string;
+begin
+  Result:=UnitOutputDir+PathDelim+ExtractFilenameOnly(ModuleName)+'.js';
+end;
+
 constructor TCustomTestCLI_Precompile.Create;
 begin
   inherited Create;
@@ -461,6 +474,89 @@ begin
   AssertFileExists(UnitOutputDir+'/Web.Unit1.'+PCUFormat.Ext);
 end;
 
+procedure TTestCLI_Precompile.TestPCU_CheckVersionMain;
+var
+  aFile: TCLIFile;
+  s, JSFilename, ExpectedSrc: string;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;'],
+    ['']);
+  AddFile('test1.pas',[
+    'begin',
+    'end.']);
+  CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=Main','-Jm-','-Jc-']));
+  JSFilename:=GetJSFilename('test1.js');
+  aFile:=FindFile(JSFilename);
+  AssertNotNull('File not found '+JSFilename,aFile);
+  ExpectedSrc:=LinesToStr([
+    UTF8BOM+'rtl.module("program",["system"],function () {',
+    '  "use strict";',
+    '  var $mod = this;',
+    '  $mod.$main = function () {',
+    '    rtl.checkVersion('+IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease)+');',
+    '  };',
+    '});']);
+  if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
+    Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
+end;
+
+procedure TTestCLI_Precompile.TestPCU_CheckVersionMain2;
+var
+  aFile: TCLIFile;
+  s, JSFilename, ExpectedSrc: string;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;',
+    'procedure Writeln; varargs;'],
+    ['procedure Writeln; begin end;']);
+  AddFile('test1.pas',[
+    'begin',
+    '  Writeln;',
+    'end.']);
+  CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=Main','-Jm-','-Jc-']));
+  JSFilename:=GetJSFilename('test1.js');
+  aFile:=FindFile(JSFilename);
+  AssertNotNull('File not found '+JSFilename,aFile);
+  ExpectedSrc:=LinesToStr([
+    UTF8BOM+'rtl.module("program",["system"],function () {',
+    '  "use strict";',
+    '  var $mod = this;',
+    '  $mod.$main = function () {',
+    '    rtl.checkVersion('+IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease)+');',
+    '    pas.system.Writeln();',
+    '  };',
+    '});']);
+  if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
+    Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
+end;
+
+procedure TTestCLI_Precompile.TestPCU_CheckVersionSystem;
+var
+  aFile: TCLIFile;
+  s, JSFilename, ExpectedSrc: string;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;'],
+    ['']);
+  AddFile('test1.pas',[
+    'begin',
+    'end.']);
+  CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=system','-Jm-','-Jc-']));
+  JSFilename:=GetJSFilename('system.js');
+  aFile:=FindFile(JSFilename);
+  AssertNotNull('File not found '+JSFilename,aFile);
+  writeln('TTestCLI_Precompile.TestPCU_CheckVersionMain ',aFile.Source);
+  ExpectedSrc:=LinesToStr([
+    UTF8BOM+'rtl.module("system",[],function () {',
+    '  "use strict";',
+    '  rtl.checkVersion(10101);',
+    '  var $mod = this;',
+    '});']);
+  if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
+    Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
+end;
+
 Initialization
   {$IFDEF EnablePas2jsPrecompiled}
   RegisterTests([TTestCLI_Precompile]);

utils/pas2js/dist/rtl.js

@@ -2,6 +2,8 @@
 
 var rtl = {
 
+  version: 10101,
+
   quiet: false,
   debug_load_units: false,
   debug_rtti: false,
@@ -20,6 +22,10 @@ var rtl = {
     rtl.debug('Warn: ',s);
   },
 
+  checkVersion: function(v){
+    if (rtl.version != v) throw "expected rtl version "+v+", but found "+rtl.version;
+  },
+
   hasString: function(s){
     return rtl.isString(s) && (s.length>0);
   },