Browse Source

pastojs: parse double quotes in asm-blocks

git-svn-id: trunk@40279 -
Mattias Gaertner 6 years ago
parent
commit
6d78637441

+ 18 - 8
packages/fcl-passrc/src/pscanner.pp

@@ -648,6 +648,8 @@ type
   TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
   TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
   TPScannerModeDirective = procedure(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean) of object;
   TPScannerModeDirective = procedure(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean) of object;
 
 
+  TPasScannerTokenPos = {$ifdef UsePChar}PChar{$else}integer{$endif};
+
   TPascalScanner = class
   TPascalScanner = class
   private
   private
     type
     type
@@ -700,7 +702,7 @@ type
     FSkipGlobalSwitches: boolean;
     FSkipGlobalSwitches: boolean;
     FSkipWhiteSpace: Boolean;
     FSkipWhiteSpace: Boolean;
     FTokenOptions: TTokenOptions;
     FTokenOptions: TTokenOptions;
-    FTokenPos: {$ifdef UsePChar}PChar;{$else}integer; { position in FCurLine }{$endif}
+    FTokenPos: TPasScannerTokenPos; // position in FCurLine }
     FIncludeStack: TFPList;
     FIncludeStack: TFPList;
     FFiles: TStrings;
     FFiles: TStrings;
     FWarnMsgStates: TWarnMsgNumberStateArr;
     FWarnMsgStates: TWarnMsgNumberStateArr;
@@ -767,13 +769,15 @@ type
     function DoFetchToken: TToken;
     function DoFetchToken: TToken;
     procedure ClearFiles;
     procedure ClearFiles;
     Procedure ClearMacros;
     Procedure ClearMacros;
-    Procedure SetCurTokenString(AValue: string);
+    Procedure SetCurToken(const AValue: TToken);
+    Procedure SetCurTokenString(const AValue: string);
     procedure SetCurrentBoolSwitches(const AValue: TBoolSwitches); virtual;
     procedure SetCurrentBoolSwitches(const AValue: TBoolSwitches); virtual;
     procedure SetCurrentModeSwitches(AValue: TModeSwitches); virtual;
     procedure SetCurrentModeSwitches(AValue: TModeSwitches); virtual;
     procedure SetCurrentValueSwitch(V: TValueSwitch; const AValue: string);
     procedure SetCurrentValueSwitch(V: TValueSwitch; const AValue: string);
     procedure SetWarnMsgState(Number: integer; State: TWarnMsgState); virtual;
     procedure SetWarnMsgState(Number: integer; State: TWarnMsgState); virtual;
     function GetWarnMsgState(Number: integer): TWarnMsgState; virtual;
     function GetWarnMsgState(Number: integer): TWarnMsgState; virtual;
     function LogEvent(E : TPScannerLogEvent) : Boolean; inline;
     function LogEvent(E : TPScannerLogEvent) : Boolean; inline;
+    property TokenPos: TPasScannerTokenPos read FTokenPos write FTokenPos;
   public
   public
     constructor Create(AFileResolver: TBaseFileResolver);
     constructor Create(AFileResolver: TBaseFileResolver);
     destructor Destroy; override;
     destructor Destroy; override;
@@ -786,7 +790,7 @@ type
     procedure UnSetTokenOption(aOption : TTokenoption);
     procedure UnSetTokenOption(aOption : TTokenoption);
     function CheckToken(aToken : TToken; const ATokenString : String) : TToken;
     function CheckToken(aToken : TToken; const ATokenString : String) : TToken;
     function FetchToken: TToken;
     function FetchToken: TToken;
-    function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken;
+    function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken; virtual;
     function AddDefine(const aName: String; Quiet: boolean = false): boolean;
     function AddDefine(const aName: String; Quiet: boolean = false): boolean;
     function RemoveDefine(const aName: String; Quiet: boolean = false): boolean;
     function RemoveDefine(const aName: String; Quiet: boolean = false): boolean;
     function UnDefine(const aName: String; Quiet: boolean = false): boolean; // check defines and macros
     function UnDefine(const aName: String; Quiet: boolean = false): boolean; // check defines and macros
@@ -2662,9 +2666,14 @@ begin
   FMacros.Clear;
   FMacros.Clear;
 end;
 end;
 
 
-procedure TPascalScanner.SetCurTokenString(AValue: string);
+procedure TPascalScanner.SetCurToken(const AValue: TToken);
+begin
+  FCurToken:=AValue;
+end;
+
+procedure TPascalScanner.SetCurTokenString(const AValue: string);
 begin
 begin
-  FCurtokenString:=AValue;
+  FCurTokenString:=AValue;
 end;
 end;
 
 
 procedure TPascalScanner.OpenFile(AFilename: string);
 procedure TPascalScanner.OpenFile(AFilename: string);
@@ -2865,9 +2874,10 @@ begin
       {$endif}
       {$endif}
       '''':
       '''':
         begin
         begin
-        // Note: Eventually there should be a mechanism to override parsing non-pascal
-        // By default skip Pascal string literals, as this is more intuitive in
-        // IDEs with Pascal highlighters
+        // Notes:
+        // 1. Eventually there should be a mechanism to override parsing non-pascal
+        // 2. By default skip Pascal string literals, as this is more intuitive
+        //    in IDEs with Pascal highlighters
         inc(FTokenPos);
         inc(FTokenPos);
         repeat
         repeat
           {$ifndef UsePChar}
           {$ifndef UsePChar}

+ 294 - 32
packages/pastojs/src/fppas2js.pp

@@ -928,13 +928,7 @@ const
      'valueOf'
      'valueOf'
     );
     );
 
 
-const
-  ClassVarModifiersType = [vmClass,vmStatic];
-  LowJSNativeInt = MinSafeIntDouble;
-  HighJSNativeInt = MaxSafeIntDouble;
-  LowJSBoolean = false;
-  HighJSBoolean = true;
-Type
+type
 
 
   { EPas2JS }
   { EPas2JS }
 
 
@@ -947,6 +941,29 @@ Type
     MsgType: TMessageType;
     MsgType: TMessageType;
   end;
   end;
 
 
+type
+  TPasToJsPlatform = (
+    PlatformBrowser,
+    PlatformNodeJS
+    );
+  TPasToJsPlatforms = set of TPasToJsPlatform;
+const
+  PasToJsPlatformNames: array[TPasToJsPlatform] of string = (
+   'Browser',
+   'NodeJS'
+    );
+type
+  TPasToJsProcessor = (
+    ProcessorECMAScript5,
+    ProcessorECMAScript6
+    );
+  TPasToJsProcessors = set of TPasToJsProcessor;
+const
+  PasToJsProcessorNames: array[TPasToJsProcessor] of string = (
+   'ECMAScript5',
+   'ECMAScript6'
+    );
+
 //------------------------------------------------------------------------------
 //------------------------------------------------------------------------------
 // Pas2js built-in types
 // Pas2js built-in types
 type
 type
@@ -962,6 +979,13 @@ const
     'JSValue'
     'JSValue'
     );
     );
 
 
+const
+  ClassVarModifiersType = [vmClass,vmStatic];
+  LowJSNativeInt = MinSafeIntDouble;
+  HighJSNativeInt = MaxSafeIntDouble;
+  LowJSBoolean = false;
+  HighJSBoolean = true;
+
 //------------------------------------------------------------------------------
 //------------------------------------------------------------------------------
 // Element CustomData
 // Element CustomData
 type
 type
@@ -1141,6 +1165,29 @@ const
     proMethodAddrAsPointer
     proMethodAddrAsPointer
     ];
     ];
 type
 type
+  TPas2JSResolver = class;
+
+  { TPas2jsPasScanner }
+
+  TPas2jsPasScanner = class(TPascalScanner)
+  private
+    FCompilerVersion: string;
+    FResolver: TPas2JSResolver;
+    FTargetPlatform: TPasToJsPlatform;
+    FTargetProcessor: TPasToJsProcessor;
+  protected
+    function HandleInclude(const Param: String): TToken; override;
+  public
+    function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken;
+      override;
+    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;
+
+  { TPas2JSResolver }
+
   TPas2JSResolver = class(TPasResolver)
   TPas2JSResolver = class(TPasResolver)
   private
   private
     FJSBaseTypes: array[TPas2jsBaseType] of TPasUnresolvedSymbolRef;
     FJSBaseTypes: array[TPas2jsBaseType] of TPasUnresolvedSymbolRef;
@@ -1427,32 +1474,7 @@ const
     woCompactObjectLiterals,
     woCompactObjectLiterals,
     woCompactArguments];
     woCompactArguments];
 type
 type
-
   TPas2JSIsElementUsedEvent = function(Sender: TObject; El: TPasElement): boolean of object;
   TPas2JSIsElementUsedEvent = function(Sender: TObject; El: TPasElement): boolean of object;
-
-  TPasToJsPlatform = (
-    PlatformBrowser,
-    PlatformNodeJS
-    );
-  TPasToJsPlatforms = set of TPasToJsPlatform;
-const
-  PasToJsPlatformNames: array[TPasToJsPlatform] of string = (
-   'Browser',
-   'NodeJS'
-    );
-type
-  TPasToJsProcessor = (
-    ProcessorECMAScript5,
-    ProcessorECMAScript6
-    );
-  TPasToJsProcessors = set of TPasToJsProcessor;
-const
-  PasToJsProcessorNames: array[TPasToJsProcessor] of string = (
-   'ECMAScript5',
-   'ECMAScript6'
-    );
-
-type
   TJSReservedWordList = array of String;
   TJSReservedWordList = array of String;
 
 
   TRefPathKind = (
   TRefPathKind = (
@@ -1844,6 +1866,7 @@ const
   TempRefObjGetterName = 'get';
   TempRefObjGetterName = 'get';
   TempRefObjSetterName = 'set';
   TempRefObjSetterName = 'set';
   TempRefObjSetterArgName = 'v';
   TempRefObjSetterArgName = 'v';
+  IdentChars = ['0'..'9', 'A'..'Z', 'a'..'z','_'];
 
 
 function CodePointToJSString(u: longword): TJSString;
 function CodePointToJSString(u: longword): TJSString;
 begin
 begin
@@ -2018,6 +2041,245 @@ begin
   Element:=TheEl;
   Element:=TheEl;
 end;
 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;
+
+function TPas2jsPasScanner.ReadNonPascalTillEndToken(StopAtLineEnd: boolean
+  ): TToken;
+var
+  StartPos, MyTokenPos: integer;
+  s: string;
+  l: integer;
+
+  Procedure CommitTokenPos;
+  begin
+    {$IFDEF Pas2js}
+    TokenPos:=MyTokenPos;
+    {$ELSE}
+    TokenPos:=PChar(s)+MyTokenPos-1;
+    {$ENDIF}
+  end;
+
+  Procedure Add;
+  var
+    AddLen: PtrInt;
+  begin
+    AddLen:=MyTokenPos-StartPos;
+    if AddLen=0 then
+      SetCurTokenString('')
+    else
+      begin
+      SetCurTokenString(CurTokenString+copy(CurLine,StartPos,AddLen));
+      StartPos:=MyTokenPos;
+      end;
+  end;
+
+  function DoEndOfLine: boolean;
+  begin
+    Add;
+    if StopAtLineEnd then
+      begin
+      ReadNonPascalTillEndToken := tkLineEnding;
+      CommitTokenPos;
+      SetCurToken(tkLineEnding);
+      FetchLine;
+      exit(true);
+      end;
+    if not FetchLine then
+      begin
+      ReadNonPascalTillEndToken := tkEOF;
+      SetCurToken(tkEOF);
+      exit(true);
+      end;
+    s:=CurLine;
+    l:=length(s);
+    MyTokenPos:=1;
+    StartPos:=MyTokenPos;
+    Result:=false;
+  end;
+
+begin
+  SetCurTokenString('');
+  s:=CurLine;
+  l:=length(s);
+  {$IFDEF Pas2js}
+  MyTokenPos:=TokenPos;
+  {$ELSE}
+  {$IFDEF VerbosePas2JS}
+  if (TokenPos<PChar(s)) or (TokenPos>PChar(s)+length(s)) then
+    Error(nErrRangeCheck,'[20181109104812]');
+  {$ENDIF}
+  MyTokenPos:=TokenPos-PChar(s)+1;
+  {$ENDIF}
+  StartPos:=MyTokenPos;
+  repeat
+    if MyTokenPos>l then
+      if DoEndOfLine then exit;
+    case s[MyTokenPos] of
+    '''':
+      begin
+      inc(MyTokenPos);
+      repeat
+        if MyTokenPos>l then
+          Error(nErrOpenString,SErrOpenString);
+        case s[MyTokenPos] of
+        '''':
+          begin
+          inc(MyTokenPos);
+          break;
+          end;
+        #10,#13:
+          begin
+          // string literal missing closing apostroph
+          break;
+          end
+        else
+          inc(MyTokenPos);
+        end;
+      until false;
+      end;
+    '"':
+      begin
+      inc(MyTokenPos);
+      repeat
+        if MyTokenPos>l then
+          Error(nErrOpenString,SErrOpenString);
+        case s[MyTokenPos] of
+        '"':
+          begin
+          inc(MyTokenPos);
+          break;
+          end;
+        #10,#13:
+          begin
+          // string literal missing closing quote
+          break;
+          end
+        else
+          inc(MyTokenPos);
+        end;
+      until false;
+      end;
+    '/':
+      begin
+      inc(MyTokenPos);
+      if (MyTokenPos<=l) and (s[MyTokenPos]='/') then
+        begin
+        // skip Delphi comment //, see Note above
+        repeat
+          inc(MyTokenPos);
+        until (MyTokenPos>l) or (s[MyTokenPos] in [#10,#13]);
+        end;
+      end;
+    '0'..'9', 'A'..'Z', 'a'..'z','_':
+      begin
+      // number or identifier
+      if (CompareText(copy(s,MyTokenPos,3),'end')=0)
+          and ((MyTokenPos+3>l) or not (s[MyTokenPos+3] in IdentChars)) then
+        begin
+        // 'end' found
+        Add;
+        if CurTokenString<>'' then
+          begin
+          // return characters in front of 'end'
+          Result:=tkWhitespace;
+          CommitTokenPos;
+          SetCurToken(Result);
+          exit;
+          end;
+        // return 'end'
+        Result := tkend;
+        SetCurTokenString(copy(s,MyTokenPos,3));
+        inc(MyTokenPos,3);
+        CommitTokenPos;
+        SetCurToken(Result);
+        exit;
+        end
+      else
+        begin
+        // skip identifier
+        while (MyTokenPos<=l) and (s[MyTokenPos] in IdentChars) do
+          inc(MyTokenPos);
+        end;
+      end;
+    else
+      inc(MyTokenPos);
+    end;
+  until false;
+end;
+
 { TPas2JSResolver }
 { TPas2JSResolver }
 
 
 // inline
 // inline

+ 0 - 92
packages/pastojs/src/pas2jspparser.pp

@@ -34,23 +34,6 @@ const // Messages
 
 
 type
 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 }
 
 
   TPas2jsPasParser = class(TPasParser)
   TPas2jsPasParser = class(TPasParser)
@@ -123,81 +106,6 @@ begin
   r(mtError,nFinalizationNotSupported,sFinalizationNotSupported);
   r(mtError,nFinalizationNotSupported,sFinalizationNotSupported);
 end;
 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 }
 { TPas2jsPasParser }
 
 
 constructor TPas2jsPasParser.Create(AScanner: TPascalScanner;
 constructor TPas2jsPasParser.Create(AScanner: TPascalScanner;

+ 1 - 1
packages/pastojs/tests/tcfiler.pas

@@ -25,7 +25,7 @@ interface
 uses
 uses
   Classes, SysUtils, fpcunit, testregistry,
   Classes, SysUtils, fpcunit, testregistry,
   PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
   PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
-  FPPas2Js, Pas2JsFiler, Pas2jsPParser,
+  FPPas2Js, Pas2JsFiler,
   tcmodules, jstree;
   tcmodules, jstree;
 
 
 type
 type

+ 15 - 1
packages/pastojs/tests/tcmodules.pas

@@ -27,7 +27,7 @@ uses
   Classes, SysUtils, fpcunit, testregistry, contnrs,
   Classes, SysUtils, fpcunit, testregistry, contnrs,
   jstree, jswriter, jsbase,
   jstree, jswriter, jsbase,
   PasTree, PScanner, PasResolver, PParser, PasResolveEval,
   PasTree, PScanner, PasResolver, PParser, PasResolveEval,
-  Pas2jsPParser, FPPas2Js;
+  FPPas2Js;
 
 
 const
 const
   // default parser+scanner options
   // default parser+scanner options
@@ -3317,6 +3317,14 @@ begin
   '  { a:{ b:{}, c:[]}, d:''1'' };',
   '  { a:{ b:{}, c:[]}, d:''1'' };',
   '  end;',
   '  end;',
   '  asm console.log(); end;',
   '  asm console.log(); end;',
+  '  asm',
+  '    s = "'' ";',
+  '    s = ''" '';',
+  '    s = s + "world" + "''";',
+  '    // end',
+  '    s = ''end'';',
+  '    s = "end";',
+  '  end;',
   'end;',
   'end;',
   'begin']);
   'begin']);
   ConvertProgram;
   ConvertProgram;
@@ -3326,6 +3334,12 @@ begin
     '  var Result = 0;',
     '  var Result = 0;',
     '  { a:{ b:{}, c:[]}, d:''1'' };',
     '  { a:{ b:{}, c:[]}, d:''1'' };',
     '  console.log();',
     '  console.log();',
+    '  s = "'' ";',
+    '  s = ''" '';',
+    '  s = s + "world" + "''";',
+    '  // end',
+    '  s = ''end'';',
+    '  s = "end";',
     '  return Result;',
     '  return Result;',
     '};'
     '};'
     ]),
     ]),