Browse Source

pastojs: restored built in function debugger, less hints

git-svn-id: trunk@40476 -
Mattias Gaertner 6 years ago
parent
commit
e64b098e7f

+ 37 - 0
packages/pastojs/src/fppas2js.pp

@@ -354,6 +354,7 @@ Works:
 - typecast byte(longword) -> value & $ff
 - typecast TJSFunction(func)
 - modeswitch OmitRTTI
+- debugger;
 
 ToDos:
 - do not rename property Date
@@ -1262,8 +1263,11 @@ type
     procedure ComputeBinaryExprRes(Bin: TBinaryExpr; out
       ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
       var LeftResolved, RightResolved: TPasResolverResult); override;
+    // built-in functions
     procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
       Params: TParamsExpr; out ResolvedEl: TPasResolverResult); override;
+    function BI_Debugger_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
   public
     constructor Create; reintroduce;
     destructor Destroy; override;
@@ -1748,6 +1752,7 @@ type
     Function ConvertBuiltIn_New(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_Dispose(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_Default(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Debugger(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertSelfExpression(El: TSelfExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBinaryExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
@@ -4231,6 +4236,16 @@ begin
   if Proc=nil then ;
 end;
 
+function TPas2JSResolver.BI_Debugger_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// debugger;
+begin
+  if Expr is TParamsExpr then
+    Result:=CheckBuiltInMaxParamCount(Proc,TParamsExpr(Expr),0,RaiseOnError)
+  else
+    Result:=cExact;
+end;
+
 constructor TPas2JSResolver.Create;
 var
   bt: TPas2jsBaseType;
@@ -4321,6 +4336,9 @@ begin
     AddBaseType(Pas2JSBuiltInNames[pbitnUIntDouble],btUIntDouble);
   if btIntDouble in TheBaseTypes then
     AddBaseType(Pas2JSBuiltInNames[pbitnIntDouble],btIntDouble);
+  AddBuiltInProc('Debugger','procedure Debugger',
+      @BI_Debugger_OnGetCallCompatibility,nil,
+      nil,nil,bfCustom,[bipfCanBeStatement]);
 end;
 
 function TPas2JSResolver.CheckTypeCastRes(const FromResolved,
@@ -7284,6 +7302,12 @@ begin
       bfBreak: Result:=ConvertBuiltInBreak(El,AContext);
       bfContinue: Result:=ConvertBuiltInContinue(El,AContext);
       bfExit: Result:=ConvertBuiltIn_Exit(El,AContext);
+      bfCustom:
+        case BuiltInProc.Element.Name of
+        'Debugger': Result:=ConvertBuiltIn_Debugger(El,AContext);
+        else
+          RaiseNotSupported(El,AContext,20181126102554,'built in custom proc '+BuiltInProc.Element.Name);
+        end
     else
       RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
     end;
@@ -8383,6 +8407,12 @@ begin
             if Result=nil then exit;
             end;
           bfDefault: Result:=ConvertBuiltIn_Default(El,AContext);
+          bfCustom:
+            case BuiltInProc.Element.Name of
+            'Debugger': Result:=ConvertBuiltIn_Debugger(El,AContext);
+            else
+              RaiseNotSupported(El,AContext,20181126101801,'built in custom proc '+BuiltInProc.Element.Name);
+            end;
         else
           RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
         end;
@@ -10973,6 +11003,13 @@ begin
     AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param);
 end;
 
+function TPasToJSConverter.ConvertBuiltIn_Debugger(El: TPasExpr;
+  AContext: TConvertContext): TJSElement;
+begin
+  Result:=CreateLiteralCustomValue(El,'debugger');
+  if AContext=nil then ;
+end;
+
 function TPasToJSConverter.ConvertRecordValues(El: TRecordValues;
   AContext: TConvertContext): TJSElement;
 var

+ 1 - 0
packages/pastojs/src/pas2jscompiler.pp

@@ -2406,6 +2406,7 @@ end;
 procedure TPas2jsCompiler.SetWorkingDir(const aDir: String);
 begin
   // Do nothing
+  if aDir='' then ;
 end;
 
 procedure TPas2jsCompiler.Terminate(TheExitCode: integer);

+ 2 - 1
packages/pastojs/src/pas2jsfiler.pp

@@ -295,7 +295,8 @@ const
     'List',
     'Inherited',
     'Self',
-    'Specialize');
+    'Specialize',
+    'Procedure');
 
   PCUExprOpCodeNames: array[TExprOpCode] of string = (
     'None',

+ 5 - 1
packages/pastojs/src/pas2jsfs.pp

@@ -224,6 +224,7 @@ end;
 function TPas2JSFS.File1IsNewer(const File1, File2: String): Boolean;
 begin
   Result:=False;
+  if File1=File2 then ;
 end;
 
 function TPas2JSFS.ExpandDirectory(const Filename : String): string;
@@ -248,7 +249,7 @@ end;
 
 function TPas2JSFS.DirectoryExists(const aDirectory: string): boolean;
 begin
-  Result:=False;
+  Result:=aDirectory='';
 end;
 
 function TPas2JSFS.TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String
@@ -256,6 +257,7 @@ function TPas2JSFS.TryCreateRelativePath(const Filename, BaseDirectory: String;
 begin
   Result:=True;
   RelPath:=FileName;
+  if (BaseDirectory='') or UsePointDirectory then ;
 end;
 
 procedure TPas2JSFS.WriteFoldersAndSearchPaths;
@@ -271,11 +273,13 @@ end;
 function TPas2JSFS.AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String;
 begin
   Result:='';
+  if (aValue='') or FromCmdLine then ;
 end;
 
 function TPas2JSFS.HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String;
 begin
   Result:='Invalid parameter : -F'+C+aValue;
+  if FromCmdLine then ;
 end;
 
 constructor TPas2JSFS.Create;

+ 25 - 0
packages/pastojs/tests/tcmodules.pas

@@ -381,6 +381,7 @@ type
     Procedure TestCaseOfRange;
     Procedure TestCaseOfString;
     Procedure TestCaseOfExternalClassConst;
+    Procedure TestDebugger;
 
     // arrays
     Procedure TestArray_Dynamic;
@@ -7081,6 +7082,30 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestDebugger;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'begin',
+  '  deBugger;',
+  '  DeBugger();',
+  'end;',
+  'begin',
+  '  Debugger;']);
+  ConvertProgram;
+  CheckSource('TestDebugger',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  debugger;',
+    '  debugger;',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    'debugger;',
+    '']));
+end;
+
 procedure TTestModule.TestArray_Dynamic;
 begin
   StartProgram(false);