pastojs: assert() without sysutils

git-svn-id: trunk@37988 -

packages/pastojs/src/fppas2js.pp

@@ -839,6 +839,7 @@ const
     msIgnoreAttributes];
 
   msAllPas2jsBoolSwitches = [
+    bsAssertions,
     bsHints,
     bsNotes,
     bsWarnings,
@@ -1350,6 +1351,7 @@ type
     Function ConvertBuiltIn_InsertArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_DeleteArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_TypeInfo(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Assert(El: TParamsExpr; 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;
@@ -5851,6 +5853,11 @@ begin
           bfInsertArray: Result:=ConvertBuiltIn_InsertArray(El,AContext);
           bfDeleteArray: Result:=ConvertBuiltIn_DeleteArray(El,AContext);
           bfTypeInfo: Result:=ConvertBuiltIn_TypeInfo(El,AContext);
+          bfAssert:
+            begin
+            Result:=ConvertBuiltIn_Assert(El,AContext);
+            if Result=nil then exit;
+            end
         else
           RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
         end;
@@ -7577,6 +7584,51 @@ begin
     Result:=CreateTypeInfoRef(TypeEl,AContext,Param);
 end;
 
+function TPasToJSConverter.ConvertBuiltIn_Assert(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// throw pas.SysUtils.EAssertionFailed.$create("Create");
+// throw pas.SysUtils.EAssertionFailed.$create("Create$1",["text"]);
+var
+  CtxEl: TPasElement;
+  ProcScope: TPasProcedureScope;
+  IfSt: TJSIfStatement;
+  ThrowSt: TJSThrowStatement;
+begin
+  Result:=nil;
+
+  // check if assertions are enabled
+  CtxEl:=El;
+  while CtxEl<>nil do
+    begin
+    if CtxEl is TPasProcedure then
+      begin
+      ProcScope:=CtxEl.CustomData as TPasProcedureScope;
+      if not (ppsfAssertions in ProcScope.Flags) then exit;
+      break;
+      end;
+    CtxEl:=CtxEl.Parent;
+    end;
+
+  IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
+  try
+    IfSt.Cond:=ConvertExpression(El.Params[0],AContext);
+    ThrowSt:=TJSThrowStatement(CreateElement(TJSThrowStatement,El.Params[0]));
+    IfSt.BTrue:=ThrowSt;
+    // ToDo: find sysutils.EAssertionFailed
+    if length(El.Params)>1 then
+      begin
+      ThrowSt.A:=ConvertExpression(El.Params[1],AContext);
+      end
+    else
+      ThrowSt.A:=CreateLiteralJSString(El.Params[0],'assert failed');
+
+    Result:=IfSt;
+  finally
+    if Result=nil then
+      IfSt.Free;
+  end;
+end;
+
 function TPasToJSConverter.ConvertRecordValues(El: TRecordValues;
   AContext: TConvertContext): TJSElement;
 

packages/pastojs/tests/tcmodules.pas

@@ -102,6 +102,7 @@ type
   protected
     procedure SetUp; override;
     function CreateConverter: TPasToJSConverter; virtual;
+    procedure InitScanner(aScanner: TPascalScanner); virtual;
     procedure TearDown; override;
     Procedure Add(Line: string); virtual;
     Procedure Add(const Lines: array of string);
@@ -555,6 +556,9 @@ type
 
     // Attributes
     Procedure TestAtributes_Ignore;
+
+    // Assertions
+    procedure TestAssert;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -710,6 +714,7 @@ begin
       //writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
       CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
       CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
+      InitScanner(CurEngine.Scanner);
       CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
       CurEngine.Parser.Options:=CurEngine.Parser.Options+po_pas2js+[po_KeepScannerError];
       if CompareText(CurUnitName,'System')=0 then
@@ -741,12 +746,7 @@ begin
   FFileResolver.OwnsStreams:=True;
 
   FScanner:=TPascalScanner.Create(FFileResolver);
-
-  FScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
-  FScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
-  FScanner.CurrentModeSwitches:=OBJFPCModeSwitches*msAllPas2jsModeSwitches+msAllPas2jsModeSwitchesReadOnly;
-
-  FScanner.AllowedBoolSwitches:=msAllPas2jsBoolSwitches;
+  InitScanner(FScanner);
 
   FEngine:=AddModule(Filename);
 
@@ -765,6 +765,16 @@ begin
   Result.Options:=co_tcmodules;
 end;
 
+procedure TCustomTestModule.InitScanner(aScanner: TPascalScanner);
+begin
+  aScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
+  aScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
+  aScanner.CurrentModeSwitches:=OBJFPCModeSwitches*msAllPas2jsModeSwitches+msAllPas2jsModeSwitchesReadOnly;
+
+  aScanner.AllowedBoolSwitches:=msAllPas2jsBoolSwitches;
+  aScanner.CurrentBoolSwitches:=[bsHints,bsNotes,bsWarnings];
+end;
+
 procedure TCustomTestModule.TearDown;
 begin
   FSkipTests:=false;
@@ -15820,6 +15830,35 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestAssert;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'var',
+  '  b: boolean;',
+  '  s: string;',
+  'begin',
+  '  {$Assertions on}',
+  '  Assert(b);',
+  'end;',
+  'begin',
+  '  DoIt;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAssert',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  var b = false;',
+    '  var s = "";',
+    '  if (b) throw "assert failed";',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt();',
+    '']));
+end;
+
 Initialization
   RegisterTests([TTestModule]);
 end.