pastojs: $i %date%, %time%, %line%

git-svn-id: trunk@40062 -

packages/pastojs/src/fppas2js.pp

@@ -375,7 +375,7 @@ ToDos:
   - array of interface
   - record member interface
 
-Not in Version 1.0:
+ToDo:
 - record field external name
 - make records more lightweight
 - 1 as TEnum, ERangeError
@@ -385,6 +385,7 @@ Not in Version 1.0:
 - property read Arr[0]  https://bugs.freepascal.org/view.php?id=33416
 - write, writeln
 - array of const
+- Result:=inherited;
 - sets
   - set of char, boolean, integer range, char range, enum range
 - call array of proc element without ()

packages/pastojs/src/pas2jsfileutils.pp

@@ -70,14 +70,11 @@ type TChangeStamp = SizeInt;
 const InvalidChangeStamp = low(TChangeStamp);
 procedure IncreaseChangeStamp(var Stamp: TChangeStamp);
 
-{$IFDEF FPC_HAS_CPSTRING}
 const
-  UTF8BOM = #$EF#$BB#$BF;
   EncodingUTF8 = 'UTF-8';
   EncodingSystem = 'System';
 function NormalizeEncoding(const Encoding: string): string;
 function IsNonUTF8System: boolean;// true if system encoding is not UTF-8
-function UTF8CharacterStrictLength(P: PChar): integer;
 function GetDefaultTextEncoding: string;
 function GetConsoleTextEncoding: string;
 {$IFDEF Windows}
@@ -90,6 +87,11 @@ function GetUnixEncoding: string;
 {$ENDIF}
 function IsASCII(const s: string): boolean; inline;
 
+{$IFDEF FPC_HAS_CPSTRING}
+const
+  UTF8BOM = #$EF#$BB#$BF;
+function UTF8CharacterStrictLength(P: PChar): integer;
+
 function UTF8ToUTF16(const s: string): UnicodeString;
 function UTF16ToUTF8(const s: UnicodeString): string;
 
@@ -107,7 +109,6 @@ implementation
 uses Windows;
 {$ENDIF}
 
-{$IFDEF FPC_HAS_CPSTRING}
 var
   EncodingValid: boolean = false;
   DefaultTextEncoding: string = EncodingSystem;
@@ -116,8 +117,7 @@ var
   Lang: string = '';
   {$ENDIF}
   {$ENDIF}
-  NonUTF8System: boolean = false;
-{$ENDIF}
+  NonUTF8System: boolean = {$IFDEF FPC_HAS_CPSTRING}false{$ELSE}true{$ENDIF};
 
 function FilenameIsWinAbsolute(const aFilename: string): boolean;
 begin
@@ -711,12 +711,66 @@ begin
     Stamp:=InvalidChangeStamp+1;
 end;
 
-{$IFDEF FPC_HAS_CPSTRING}
 function IsNonUTF8System: boolean;
 begin
   Result:=NonUTF8System;
 end;
 
+function GetDefaultTextEncoding: string;
+begin
+  if EncodingValid then
+  begin
+    Result:=DefaultTextEncoding;
+    exit;
+  end;
+
+  {$IFDEF Windows}
+  Result:=GetWindowsEncoding;
+  {$ELSE}
+    {$IFDEF Darwin}
+    Result:=EncodingUTF8;
+    {$ELSE}
+    Lang := GetEnvironmentVariable('LC_ALL');
+    if Lang='' then
+    begin
+      Lang := GetEnvironmentVariable('LC_MESSAGES');
+      if Lang='' then
+        Lang := GetEnvironmentVariable('LANG');
+    end;
+    Result:=GetUnixEncoding;
+    {$ENDIF}
+  {$ENDIF}
+  Result:=NormalizeEncoding(Result);
+
+  DefaultTextEncoding:=Result;
+  EncodingValid:=true;
+end;
+
+function NormalizeEncoding(const Encoding: string): string;
+var
+  i: Integer;
+begin
+  Result:=LowerCase(Encoding);
+  for i:=length(Result) downto 1 do
+    if Result[i]='-' then Delete(Result,i,1);
+end;
+
+function IsASCII(const s: string): boolean; inline;
+var
+  p: PChar;
+begin
+  if s='' then exit(true);
+  p:=PChar(s);
+  repeat
+    case p^ of
+    #0: if p-PChar(s)=length(s) then exit(true);
+    #128..#255: exit(false);
+    end;
+    inc(p);
+  until false;
+end;
+
+{$IFDEF FPC_HAS_CPSTRING}
 function UTF8CharacterStrictLength(P: PChar): integer;
 begin
   if p=nil then exit(0);
@@ -760,60 +814,6 @@ begin
     exit(0);
 end;
 
-function GetDefaultTextEncoding: string;
-begin
-  if EncodingValid then
-  begin
-    Result:=DefaultTextEncoding;
-    exit;
-  end;
-
-  {$IFDEF Windows}
-  Result:=GetWindowsEncoding;
-  {$ELSE}
-  {$IFDEF Darwin}
-  Result:=EncodingUTF8;
-  {$ELSE}
-  Lang := GetEnvironmentVariable('LC_ALL');
-  if Lang='' then
-  begin
-    Lang := GetEnvironmentVariable('LC_MESSAGES');
-    if Lang='' then
-      Lang := GetEnvironmentVariable('LANG');
-  end;
-  Result:=GetUnixEncoding;
-  {$ENDIF}
-  {$ENDIF}
-  Result:=NormalizeEncoding(Result);
-
-  DefaultTextEncoding:=Result;
-  EncodingValid:=true;
-end;
-
-function NormalizeEncoding(const Encoding: string): string;
-var
-  i: Integer;
-begin
-  Result:=LowerCase(Encoding);
-  for i:=length(Result) downto 1 do
-    if Result[i]='-' then Delete(Result,i,1);
-end;
-
-function IsASCII(const s: string): boolean; inline;
-var
-  p: PChar;
-begin
-  if s='' then exit(true);
-  p:=PChar(s);
-  repeat
-    case p^ of
-    #0: if p-PChar(s)=length(s) then exit(true);
-    #128..#255: exit(false);
-    end;
-    inc(p);
-  until false;
-end;
-
 function UTF8ToUTF16(const s: string): UnicodeString;
 begin
   Result:=UTF8Decode(s);

packages/pastojs/src/pas2jspparser.pp

@@ -34,6 +34,23 @@ const // Messages
 
 type
 
+  { TPas2jsPasScanner }
+
+  TPas2jsPasScanner = class(TPascalScanner)
+  private
+    FCompilerVersion: string;
+    FResolver: TPas2JSResolver;
+    FTargetPlatform: TPasToJsPlatform;
+    FTargetProcessor: TPasToJsProcessor;
+  protected
+    function HandleInclude(const Param: String): TToken; override;
+  public
+    property CompilerVersion: string read FCompilerVersion write FCompilerVersion;
+    property Resolver: TPas2JSResolver read FResolver write FResolver;
+    property TargetPlatform: TPasToJsPlatform read FTargetPlatform write FTargetPlatform;
+    property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor;
+  end;
+
   { TPas2jsPasParser }
 
   TPas2jsPasParser = class(TPasParser)
@@ -106,6 +123,81 @@ begin
   r(mtError,nFinalizationNotSupported,sFinalizationNotSupported);
 end;
 
+{ TPas2jsPasScanner }
+
+function TPas2jsPasScanner.HandleInclude(const Param: String): TToken;
+
+  procedure SetStr(const s: string);
+  begin
+    Result:=tkString;
+    SetCurTokenString(''''+s+'''');
+  end;
+
+var
+  Year, Month, Day, Hour, Minute, Second, MilliSecond: word;
+  i: Integer;
+  Scope: TPasScope;
+begin
+  if (Param<>'') and (Param[1]='%') then
+  begin
+    case lowercase(Param) of
+    '%date%':
+      begin
+        DecodeDate(Now,Year,Month,Day);
+        SetStr('['+IntToStr(Year)+'/'+IntToStr(Month)+'/'+IntToStr(Day)+']');
+        exit;
+      end;
+    '%time%':
+      begin
+        DecodeTime(Now,Hour,Minute,Second,MilliSecond);
+        SetStr(Format('%2d:%2d:%2d',[Hour,Minute,Second]));
+        exit;
+      end;
+    '%pas2jstarget%','%fpctarget%',
+    '%pas2jstargetos%','%fpctargetos%':
+      begin
+        SetStr(PasToJsPlatformNames[TargetPlatform]);
+        exit;
+      end;
+    '%pas2jstargetcpu%','%fpctargetcpu%':
+      begin
+        SetStr(PasToJsProcessorNames[TargetProcessor]);
+        exit;
+      end;
+    '%pas2jsversion%','%fpcversion%':
+      begin
+        SetStr(CompilerVersion);
+        exit;
+      end;
+    '%line%':
+      begin
+        SetStr(IntToStr(CurRow));
+        exit;
+      end;
+    '%currentroutine%':
+      begin
+        if Resolver<>nil then
+          for i:=Resolver.ScopeCount-1 downto 0 do
+          begin
+            Scope:=Resolver.Scopes[i];
+            if (Scope.Element is TPasProcedure)
+                and (Scope.Element.Name<>'') then
+            begin
+              SetStr(Scope.Element.Name);
+              exit;
+            end;
+          end;
+        SetStr('<anonymous>');
+        exit;
+      end;
+    else
+      DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,SWarnIllegalCompilerDirectiveX,
+        ['$i '+Param]);
+    end;
+  end;
+  Result:=inherited HandleInclude(Param);
+end;
+
 { TPas2jsPasParser }
 
 constructor TPas2jsPasParser.Create(AScanner: TPascalScanner;

packages/pastojs/tests/tcfiler.pas

@@ -25,7 +25,7 @@ interface
 uses
   Classes, SysUtils, fpcunit, testregistry,
   PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
-  FPPas2Js, Pas2JsFiler,
+  FPPas2Js, Pas2JsFiler, Pas2jsPParser,
   tcmodules, jstree;
 
 type
@@ -307,7 +307,7 @@ var
   // restored classes:
   RestResolver: TTestEnginePasResolver;
   RestFileResolver: TFileResolver;
-  RestScanner: TPascalScanner;
+  RestScanner: TPas2jsPasScanner;
   RestParser: TPasParser;
   RestConverter: TPasToJSConverter;
   RestJSModule: TJSSourceElements;
@@ -348,7 +348,7 @@ begin
       writeln('TCustomTestPrecompile.WriteReadUnit PCU END-------');
 
       RestFileResolver:=TFileResolver.Create;
-      RestScanner:=TPascalScanner.Create(RestFileResolver);
+      RestScanner:=TPas2jsPasScanner.Create(RestFileResolver);
       InitScanner(RestScanner);
       RestResolver:=TTestEnginePasResolver.Create;
       RestResolver.Filename:=Engine.Filename;

packages/pastojs/tests/tcmodules.pas

@@ -27,7 +27,7 @@ uses
   Classes, SysUtils, fpcunit, testregistry, contnrs,
   jstree, jswriter, jsbase,
   PasTree, PScanner, PasResolver, PParser, PasResolveEval,
-  FPPas2Js;
+  Pas2jsPParser, FPPas2Js;
 
 const
   // default parser+scanner options
@@ -76,7 +76,7 @@ type
     FOnFindUnit: TOnFindUnit;
     FParser: TTestPasParser;
     FStreamResolver: TStreamResolver;
-    FScanner: TPascalScanner;
+    FScanner: TPas2jsPasScanner;
     FSource: string;
   public
     destructor Destroy; override;
@@ -86,7 +86,7 @@ type
     property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
     property Filename: string read FFilename write FFilename;
     property StreamResolver: TStreamResolver read FStreamResolver write FStreamResolver;
-    property Scanner: TPascalScanner read FScanner write FScanner;
+    property Scanner: TPas2jsPasScanner read FScanner write FScanner;
     property Parser: TTestPasParser read FParser write FParser;
     property Source: string read FSource write FSource;
     property Module: TPasModule read FModule;
@@ -119,7 +119,7 @@ type
     FHintMsgs: TObjectList; // list of TTestHintMessage
     FHintMsgsGood: TFPList; // list of TTestHintMessage marked as expected
     FJSRegModuleCall: TJSCallExpression;
-    FScanner: TPascalScanner;
+    FScanner: TPas2jsPasScanner;
     FSkipTests: boolean;
     FSource: TStringList;
     FFirstPasStatement: TPasImplBlock;
@@ -138,7 +138,7 @@ type
     procedure SetUp; override;
     function CreateConverter: TPasToJSConverter; virtual;
     function LoadUnit(const aUnitName: String): TPasModule;
-    procedure InitScanner(aScanner: TPascalScanner); virtual;
+    procedure InitScanner(aScanner: TPas2jsPasScanner); virtual;
     procedure TearDown; override;
     Procedure Add(Line: string); virtual;
     Procedure Add(const Lines: array of string);
@@ -210,7 +210,7 @@ type
     destructor Destroy; override;
     property Source: TStringList read FSource;
     property FileResolver: TStreamResolver read FFileResolver;
-    property Scanner: TPascalScanner read FScanner;
+    property Scanner: TPas2jsPasScanner read FScanner;
     property Parser: TTestPasParser read FParser;
     property MsgCount: integer read GetMsgCount;
     property Msgs[Index: integer]: TTestHintMessage read GetMsgs;
@@ -232,6 +232,7 @@ type
     Procedure Test_ModeSwitchCBlocksFail;
     Procedure TestUnit_UseSystem;
     Procedure TestUnit_Intf1Impl2Intf1;
+    Procedure TestIncludeVersion;
 
     // vars/const
     Procedure TestVarInt;
@@ -1072,9 +1073,9 @@ end;
 procedure TCustomTestModule.OnScannerLog(Sender: TObject; const Msg: String);
 var
   Item: TTestHintMessage;
-  aScanner: TPascalScanner;
+  aScanner: TPas2jsPasScanner;
 begin
-  aScanner:=Sender as TPascalScanner;
+  aScanner:=Sender as TPas2jsPasScanner;
   Item:=TTestHintMessage.Create;
   Item.Id:=aScanner.LastMsgNumber;
   Item.MsgType:=aScanner.LastMsgType;
@@ -1115,7 +1116,7 @@ begin
       CurEngine.StreamResolver.OwnsStreams:=True;
       //writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
       CurEngine.StreamResolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
-      CurEngine.Scanner:=TPascalScanner.Create(CurEngine.StreamResolver);
+      CurEngine.Scanner:=TPas2jsPasScanner.Create(CurEngine.StreamResolver);
       InitScanner(CurEngine.Scanner);
       CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.StreamResolver,CurEngine);
       CurEngine.Parser.Options:=po_tcmodules;
@@ -1157,11 +1158,12 @@ begin
   FFileResolver:=TStreamResolver.Create;
   FFileResolver.OwnsStreams:=True;
 
-  FScanner:=TPascalScanner.Create(FFileResolver);
+  FScanner:=TPas2jsPasScanner.Create(FFileResolver);
   InitScanner(FScanner);
 
   FEngine:=AddModule(Filename);
   FEngine.Scanner:=FScanner;
+  FScanner.Resolver:=FEngine;
 
   FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
   FParser.OnLog:=@OnParserLog;
@@ -1180,7 +1182,7 @@ begin
   Result.Options:=co_tcmodules;
 end;
 
-procedure TCustomTestModule.InitScanner(aScanner: TPascalScanner);
+procedure TCustomTestModule.InitScanner(aScanner: TPas2jsPasScanner);
 begin
   aScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
   aScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
@@ -1191,6 +1193,8 @@ begin
   aScanner.CurrentBoolSwitches:=msAllPas2jsBoolSwitchesReadOnly+[bsHints,bsNotes,bsWarnings,bsWriteableConst];
 
   aScanner.OnLog:=@OnScannerLog;
+
+  aScanner.CompilerVersion:='Comp.Ver.tcmodules';
 end;
 
 procedure TCustomTestModule.TearDown;
@@ -2248,6 +2252,32 @@ begin
     '']) );
 end;
 
+procedure TTestModule.TestIncludeVersion;
+begin
+  StartProgram(false);
+  Add([
+  'var s: string;',
+  'begin',
+  '  s:={$I %line%};',
+  '  s:={$I %currentroutine%};',
+  '  s:={$I %pas2jsversion%};',
+  '  s:={$I %pas2jstarget%};',
+  '  s:={$I %pas2jstargetos%};',
+  '  s:={$I %pas2jstargetcpu%};',
+  '']);
+  ConvertProgram;
+  CheckSource('TestIncludeVersion',
+    'this.s="";',
+    LinesToStr([
+    '$mod.s = "5";',
+    '$mod.s = "<anonymous>";',
+    '$mod.s = "Comp.Ver.tcmodules";',
+    '$mod.s = "Browser";',
+    '$mod.s = "Browser";',
+    '$mod.s = "ECMAScript5";',
+    '']));
+end;
+
 procedure TTestModule.TestVarInt;
 begin
   StartProgram(false);

utils/pas2js/docs/translation.html

@@ -2796,6 +2796,17 @@ End.
     <li>{$modeswitch arrayoperators}: allow + operator to concatenate arrays, default in mode delphi</li>
     <li>{$macro on|off} enables macro replacements. Only macros with a value are replaced. Macros are never replaced inside directives.</li>
     <li>{$I filename} or {$include filename} - insert include file</li>
+    <li>{$I %param%}:
+      <ul>
+        <li>%date%: current date as string literal, '[yyyy/mm/dd]'</li>
+        <li>%time%: current time as string literal, 'hh:mm:ss'</li>
+        <li>%line%: current source line number as string literal, e.g. '123'</li>
+        <li>%currentroutine%: short name of current routine as string literal</li>
+        <li>%pas2jstarget%, %pas2jstargetos%, %fpctarget%, %fpctargetos%: target os as string literal, e.g. 'Browser'</li>
+        <li>%pas2jstargetcpu%, %fpctargetcpu%: target cpu as string literal, e.g. 'ECMAScript5'</li>
+        <li>%pas2jsversion%, %fpcversion%: compiler version as strnig literal, e.g. '1.0.2'</li>
+      </ul>
+    </li>
     <li>{$Warnings on|off}</li>
     <li>{$Notes on|off}</li>
     <li>{$Hints on|off}</li>
@@ -2843,8 +2854,8 @@ End.
     <ul>
     <li>PASJS</li>
     <li>PAS2JS_FULLVERSION - major*1000+minor*100+release, e.g. 1.2.3 = 10203</li>
-    <li>Target platform: BROWSER, NODEJS</li>
-    <li>Target processor: ECMAScript5, ECMAScript6, ECMAScript=5</li>
+    <li>Target platform: Browser, NodeJS, Pas2JSTargetOS=&lt;value&gt;</li>
+    <li>Target processor: ECMAScript5, ECMAScript6, ECMAScript=5, Pas2JSTargetCPU=&lt;value&gt;</li>
     <li>Mode: DELPHI, OBJFPC</li>
     </ul>
     </div>

utils/pas2js/nodepas2js.pp

@@ -9,7 +9,7 @@ uses
   fpjson,
   PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer,
   FPPas2Js,
-  Pas2jsFileUtils, Pas2jsLogger, Pas2jsPParser, Pas2jsFileCache;
+  Pas2jsFileUtils, Pas2jsLogger, Pas2jsPParser, Pas2jsFileCache, Pas2jsCompiler;
 
 begin
   // Your code here