* synchronized with trunk

git-svn-id: branches/wasm@47067 -

.gitattributes

@@ -3898,6 +3898,7 @@ packages/fcl-passrc/tests/tcgenerics.pp svneol=native#text/plain
 packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcpassrcutil.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcpaswritestatements.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcprocfunc.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcresolvegenerics.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcresolver.pas svneol=native#text/plain
@@ -18406,6 +18407,7 @@ tests/webtbs/tw3578.pp svneol=native#text/plain
 tests/webtbs/tw3579.pp svneol=native#text/plain
 tests/webtbs/tw35820.pp svneol=native#text/pascal
 tests/webtbs/tw3583.pp svneol=native#text/plain
+tests/webtbs/tw35841.pp svneol=native#text/pascal
 tests/webtbs/tw35862.pp svneol=native#text/pascal
 tests/webtbs/tw35878.pp svneol=native#text/plain
 tests/webtbs/tw35878a.pp svneol=native#text/plain

compiler/ncal.pas

@@ -5203,18 +5203,7 @@ implementation
         inlineinitstatement:=nil;
         inlinecleanupstatement:=nil;
 
-        { we cannot replace the whole block by a single assignment if the call
+        n:=optimize_funcret_assignment(inlineblock);
-          has an init/cleanup block
-
-          we could though (not yet done), convert this into a bew block
-          consisting of the init code, the single assignment and the cleanup block
-          This might even enable new transformations }
-        if not(assigned(callinitblock)) and not(assigned(callcleanupblock)) then
-          { if all that's left of the inlined function is an constant assignment
-            to the result, replace the whole block with the constant only }
-          n:=optimize_funcret_assignment(inlineblock)
-        else
-          n:=nil;
         if assigned(n) then
           begin
             inlineblock.free;

compiler/x86/aoptx86.pas

@@ -4166,7 +4166,7 @@ unit aoptx86;
        if MatchOperand(taicpu(p).oper[0]^,taicpu(p).oper[1]^) and
          MatchOpType(taicpu(p),top_reg,top_reg) and
          GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-         MatchInstruction(taicpu(hp1),taicpu(p).opcode,[taicpu(p).opsize]) and
+         MatchInstruction(hp1,taicpu(p).opcode,[taicpu(p).opsize]) and
          MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[0]^) and
          MatchOperand(taicpu(hp1).oper[0]^,taicpu(hp1).oper[1]^) then
          begin
@@ -4174,7 +4174,37 @@ unit aoptx86;
            RemoveInstruction(hp1);
            Result:=true;
            Exit;
-         end;
+         end
+        {
+           replace
+             pxor reg1,reg1
+             movapd/s reg1,reg2
+             dealloc reg1
+
+             by
+
+             pxor reg2,reg2
+        }
+        else if GetNextInstruction(p,hp1) and
+          { we mix single and double opperations here because we assume that the compiler
+            generates vmovapd only after double operations and vmovaps only after single operations }
+          MatchInstruction(hp1,A_MOVAPD,A_MOVAPS,[S_NO]) and
+          MatchOperand(taicpu(p).oper[0]^,taicpu(p).oper[1]^) and
+          MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) and
+          (taicpu(p).oper[0]^.typ=top_reg) then
+          begin
+            TransferUsedRegs(TmpUsedRegs);
+            UpdateUsedRegs(TmpUsedRegs, tai(p.next));
+            if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
+              begin
+                taicpu(p).loadoper(0,taicpu(hp1).oper[1]^);
+                taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
+                DebugMsg(SPeepholeOptimization + 'PXorMovapd2PXor done',p);
+                RemoveInstruction(hp1);
+                result:=true;
+              end;
+          end;
+
      end;
 
 
@@ -4193,7 +4223,7 @@ unit aoptx86;
        if MatchOperand(taicpu(p).oper[0]^,taicpu(p).oper[1]^,taicpu(p).oper[2]^) and
          MatchOpType(taicpu(p),top_reg,top_reg,top_reg) and
          GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-         MatchInstruction(taicpu(hp1),taicpu(p).opcode,[taicpu(p).opsize]) and
+         MatchInstruction(hp1,taicpu(p).opcode,[taicpu(p).opsize]) and
          MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[0]^) and
          MatchOperand(taicpu(hp1).oper[0]^,taicpu(hp1).oper[1]^,taicpu(hp1).oper[2]^) then
          begin
@@ -4201,7 +4231,9 @@ unit aoptx86;
            RemoveInstruction(hp1);
            Result:=true;
            Exit;
-         end;
+         end
+       else
+         Result:=OptPass1VOP(p);
      end;
 
    function TX86AsmOptimizer.OptPass1Imul(var p: tai): boolean;
@@ -6005,7 +6037,7 @@ unit aoptx86;
     function TX86AsmOptimizer.SkipSimpleInstructions(var hp1 : tai) : Boolean;
       begin
         { we can skip all instructions not messing with the stack pointer }
-        while assigned(hp1) and {MatchInstruction(taicpu(hp1),[A_LEA,A_MOV,A_MOVQ,A_MOVSQ,A_MOVSX,A_MOVSXD,A_MOVZX,
+        while assigned(hp1) and {MatchInstruction(hp1,[A_LEA,A_MOV,A_MOVQ,A_MOVSQ,A_MOVSX,A_MOVSXD,A_MOVZX,
           A_AND,A_OR,A_XOR,A_ADD,A_SHR,A_SHL,A_IMUL,A_SETcc,A_SAR,A_SUB,A_TEST,A_CMOVcc,
           A_MOVSS,A_MOVSD,A_MOVAPS,A_MOVUPD,A_MOVAPD,A_MOVUPS,
           A_VMOVSS,A_VMOVSD,A_VMOVAPS,A_VMOVUPD,A_VMOVAPD,A_VMOVUPS],[]) and}

compiler/x86/nx86con.pas

@@ -41,6 +41,7 @@ implementation
       symdef,
       defutil,
       cpubase,
+      aasmdata,
       cga,cgx86,cgobj,cgbase,cgutils;
 
 {*****************************************************************************
@@ -68,14 +69,26 @@ implementation
                   location.register:=NR_ST;
                   tcgx86(cg).inc_fpu_stack;
                end
-             else if (value_real=0.0) and not(use_vectorfpu(resultdef)) then
+             else if value_real=0.0 then
                begin
-                  emit_none(A_FLDZ,S_NO);
+                 if use_vectorfpu(resultdef) then
-                  if (get_real_sign(value_real) < 0) then
+                   begin
-                    emit_none(A_FCHS,S_NO);
+                     location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));
-                  location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+                     location.register:=cg.getmmregister(current_asmdata.CurrAsmList,def_cgsize(resultdef));
-                  location.register:=NR_ST;
+                     if UseAVX then
-                  tcgx86(cg).inc_fpu_stack;
+                       emit_reg_reg_reg(A_VPXOR,S_NO,location.register,location.register,location.register)
+                     else
+                       emit_reg_reg(A_PXOR,S_NO,location.register,location.register);
+                   end
+                 else
+                   begin
+                      emit_none(A_FLDZ,S_NO);
+                      if (get_real_sign(value_real) < 0) then
+                        emit_none(A_FCHS,S_NO);
+                      location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+                      location.register:=NR_ST;
+                      tcgx86(cg).inc_fpu_stack;
+                   end;
                end
             else
               inherited pass_generate_code;

compiler/x86_64/nx64flw.pas

@@ -321,6 +321,12 @@ procedure tx64tryfinallynode.pass_generate_code;
         cg.a_label(current_asmdata.CurrAsmList,endtrylabel);
       end;
 
+    { i32913 - if the try..finally block is also inside a try..finally or
+      try..except block, make a note of any Exit calls so all necessary labels
+      are generated. [Kit] }
+    if (fc_exit in flowcontrol) and (fc_inflowcontrol in oldflowcontrol) then
+      Include(oldflowcontrol, fc_exit);
+
     flowcontrol:=[fc_inflowcontrol];
     { generate finally code as a separate procedure }
     if not implicitframe then
@@ -431,6 +437,12 @@ procedure tx64tryexceptnode.pass_generate_code;
         current_procinfo.CurrBreakLabel:=breakexceptlabel;
       end;
 
+    { i32913 - if the try..finally block is also inside a try..finally or
+      try..except block, make a note of any Exit calls so all necessary labels
+      are generated. [Kit] }
+    if (fc_exit in flowcontrol) and (fc_inflowcontrol in oldflowcontrol) then
+      Include(oldflowcontrol, fc_exit);
+
     flowcontrol:=[fc_inflowcontrol];
     { on statements }
     if assigned(right) then
@@ -521,6 +533,12 @@ errorexit:
     { restore all saved labels }
     endexceptlabel:=oldendexceptlabel;
 
+    { i32913 - if the try..finally block is also inside a try..finally or
+      try..except block, make a note of any Exit calls so all necessary labels
+      are generated. [Kit] }
+    if (fc_exit in flowcontrol) and (fc_inflowcontrol in oldflowcontrol) then
+      Include(oldflowcontrol, fc_exit);
+
     { restore the control flow labels }
     current_procinfo.CurrExitLabel:=oldCurrExitLabel;
     if assigned(oldBreakLabel) then

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -44,7 +44,6 @@ type
   TArrayStringArray = Array of TStringArray;
   PArrayStringArray = ^TArrayStringArray;
 
-  // VFS not supported at this time.
   // Do not change the order. See NativeFlags constant in GetSQLiteOpenFlags.
 
   TSQLiteOpenFlag = (
@@ -69,8 +68,10 @@ Type
   private
     fhandle: psqlite3;
     FOpenFlags: TSQLiteOpenFlags;
+    FVFS: String;
     function GetSQLiteOpenFlags: Integer;
     procedure SetOpenFlags(AValue: TSQLiteOpenFlags);
+    procedure SetVFS(const AValue: String);
   protected
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
@@ -125,6 +126,7 @@ Type
     procedure LoadExtension(const LibraryFile: string);
   Published
     Property OpenFlags : TSQLiteOpenFlags Read FOpenFlags Write SetOpenFlags default DefaultOpenFlags;
+    Property VFS : String Read FVFS Write SetVFS;
     Property AlwaysUseBigint : Boolean Read GetAlwaysUseBigint Write SetAlwaysUseBigint;
   end;
 
@@ -857,16 +859,28 @@ begin
   FOpenFlags:=AValue;
 end;
 
+procedure TSQLite3Connection.SetVFS(const AValue: String);
+begin
+  if FVFS=AValue then Exit;
+  CheckDisConnected;
+  FVFS:=AValue;
+end;
+
 procedure TSQLite3Connection.DoInternalConnect;
 var
   filename: ansistring;
+  pvfs: PChar;
 begin
   Inherited;
   if DatabaseName = '' then
     DatabaseError(SErrNoDatabaseName,self);
   InitializeSQLite;
   filename := DatabaseName;
-  checkerror(sqlite3_open_v2(PAnsiChar(filename),@fhandle,GetSQLiteOpenFlags,Nil));
+  if FVFS <> '' then
+    pvfs := PAnsiChar(FVFS)
+  else
+    pvfs := Nil;
+  checkerror(sqlite3_open_v2(PAnsiChar(filename),@fhandle,GetSQLiteOpenFlags,pvfs));
   if (Length(Password)>0) and assigned(sqlite3_key) then
     checkerror(sqlite3_key(fhandle,PChar(Password),StrLen(PChar(Password))));
   if Params.IndexOfName('foreign_keys') <> -1 then

packages/fcl-passrc/src/pasresolver.pp

@@ -9577,59 +9577,42 @@ type
     var ValueSet: TResEvalSet): boolean;
   var
     CaseExprType: TPasType;
+    bt: TResolverBaseType;
+    ElTypeResolved: TPasResolverResult;
   begin
     Result:=false;
-    if ResolvedEl.BaseType in btAllInteger then
+    bt:=ResolvedEl.BaseType;
+    if bt in btAllStrings then
+      exit(true)
+    else if bt=btRange then
+      bt:=ResolvedEl.SubType;
+    if bt in btAllInteger then
       begin
       ValueSet:=TResEvalSet.CreateEmpty(revskInt);
       Result:=true;
       end
-    else if ResolvedEl.BaseType in btAllBooleans then
+    else if bt in btAllBooleans then
       begin
       ValueSet:=TResEvalSet.CreateEmpty(revskBool);
       Result:=true;
       end
-    else if ResolvedEl.BaseType in btAllChars then
+    else if bt in btAllChars then
       begin
       ValueSet:=TResEvalSet.CreateEmpty(revskChar);
       Result:=true;
       end
-    else if ResolvedEl.BaseType in btAllStrings then
+    else if bt=btContext then
-      Result:=true
-    else if ResolvedEl.BaseType=btContext then
       begin
       CaseExprType:=ResolvedEl.LoTypeEl;
       if CaseExprType.ClassType=TPasEnumType then
         begin
         ValueSet:=TResEvalSet.CreateEmpty(revskEnum,CaseExprType);
         Result:=true;
-        end;
-      end
-    else if ResolvedEl.BaseType=btRange then
-      begin
-      if ResolvedEl.SubType in btAllInteger then
-        begin
-        ValueSet:=TResEvalSet.CreateEmpty(revskInt);
-        Result:=true;
         end
-      else if ResolvedEl.SubType in btAllBooleans then
+      else if CaseExprType.ClassType=TPasRangeType then
         begin
-        ValueSet:=TResEvalSet.CreateEmpty(revskBool);
+        ComputeElement(TPasRangeType(CaseExprType).RangeExpr.left,ElTypeResolved,[rcConstant]);
-        Result:=true;
+        Result:=CreateValues(ElTypeResolved,ValueSet);
-        end
-      else if ResolvedEl.SubType in btAllChars then
-        begin
-        ValueSet:=TResEvalSet.CreateEmpty(revskChar);
-        Result:=true;
-        end
-      else if ResolvedEl.SubType=btContext then
-        begin
-        CaseExprType:=ResolvedEl.LoTypeEl;
-        if CaseExprType.ClassType=TPasEnumType then
-          begin
-          ValueSet:=TResEvalSet.CreateEmpty(revskEnum,CaseExprType);
-          Result:=true;
-          end;
         end;
       end;
   end;
@@ -18853,6 +18836,7 @@ var
   Param: TPasExpr;
   ParamResolved, IncrResolved: TPasResolverResult;
   TypeEl: TPasType;
+  bt: TResolverBaseType;
 begin
   if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
     exit(cIncompatible);
@@ -18872,18 +18856,23 @@ begin
       RaiseVarExpected(20170216152319,Expr,ParamResolved.IdentEl);
     exit;
     end;
-  if ParamResolved.BaseType in btAllInteger then
+  bt:=ParamResolved.BaseType;
+  if bt=btRange then
+    bt:=ParamResolved.SubType;
+  if bt in btAllInteger then
     Result:=cExact
-  else if ParamResolved.BaseType=btPointer then
+  else if bt=btPointer then
     begin
     if ElHasBoolSwitch(Expr,bsPointerMath) then
       Result:=cExact;
     end
-  else if ParamResolved.BaseType=btContext then
+  else if bt=btContext then
     begin
     TypeEl:=ParamResolved.LoTypeEl;
     if (TypeEl.ClassType=TPasPointerType)
         and ElHasBoolSwitch(Expr,bsPointerMath) then
+      Result:=cExact
+    else if TypeEl.ClassType=TPasRangeType then
       Result:=cExact;
     end;
   if Result=cIncompatible then
@@ -19493,18 +19482,22 @@ function TPasResolver.BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
   end;
 
 var
-  TypeEl: TPasType;
+  bt: TResolverBaseType;
+  C: TClass;
 begin
   Result:=cIncompatible;
-  if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
+  bt:=ParamResolved.BaseType;
+  if bt=btRange then
+    bt:=ParamResolved.SubType;
+  if bt in (btAllInteger+btAllBooleans+btAllFloats) then
     Result:=cExact
-  else if IsFunc and (ParamResolved.BaseType in btAllStringAndChars) then
+  else if IsFunc and (bt in btAllStringAndChars) then
     Result:=cExact
-  else if ParamResolved.BaseType=btContext then
+  else if bt=btContext then
     begin
-      TypeEl:=ParamResolved.LoTypeEl;
+    C:=ParamResolved.LoTypeEl.ClassType;
-      if TypeEl.ClassType=TPasEnumType then
+    if (C=TPasEnumType) or (C=TPasRangeType) then
-        Result:=cExact
+      Result:=cExact
     end;
   if Result=cIncompatible then
     exit(CheckRaiseTypeArgNo(20170319220517,ArgNo,Param,ParamResolved,'boolean, integer, enum value',RaiseOnError));
@@ -19673,6 +19666,8 @@ var
   Params: TParamsExpr;
   Param: TPasExpr;
   ParamResolved: TPasResolverResult;
+  bt: TResolverBaseType;
+  C: TClass;
 begin
   if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
     exit(cIncompatible);
@@ -19693,11 +19688,15 @@ begin
   Result:=cIncompatible;
   if ResolvedElCanBeVarParam(ParamResolved,Expr) then
     begin
-    if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
+    bt:=ParamResolved.BaseType;
+    if bt=btRange then
+      bt:=ParamResolved.SubType;
+    if bt in (btAllInteger+btAllBooleans+btAllFloats) then
       Result:=cExact
-    else if ParamResolved.BaseType=btContext then
+    else if bt=btContext then
       begin
-      if ParamResolved.LoTypeEl is TPasEnumType then
+      C:=ParamResolved.LoTypeEl.ClassType;
+      if (C=TPasEnumType) or (C=TPasRangeType) then
         Result:=cExact;
       end;
     end;
@@ -29730,8 +29729,8 @@ function TPasResolver.CheckClassIsClass(SrcType, DestType: TPasType): integer;
     DestParams:=DestSpecializedFromItem.Params;
     for i:=0 to length(SrcParams)-1 do
       begin
-      SrcParam:=SrcParams[i];
+      SrcParam:=ResolveAliasType(SrcParams[i]);
-      DestParam:=DestParams[i];
+      DestParam:=ResolveAliasType(DestParams[i]);
       if (SrcParam is TPasGenericTemplateType)
           or (DestParam is TPasGenericTemplateType)
           or (SrcParam=DestParam)

packages/fcl-passrc/src/pastree.pp

@@ -5848,6 +5848,10 @@ begin
     If (Result<>'')  then
       Result:=Result+', ';
     Result:=Result+Params[I].GetDeclaration(Full);
+    if Assigned(Params[I].format1) then
+      Result:=Result+':'+Params[I].format1.GetDeclaration(false);
+    if Assigned(Params[I].format2) then
+      Result:=Result+':'+Params[I].format2.GetDeclaration(false);
     end;
   if Kind in [pekSet,pekArrayParams] then
     Result := '[' + Result + ']'

packages/fcl-passrc/src/paswrite.pp

@@ -122,6 +122,9 @@ type
     procedure WriteImplCommand(ACommand: TPasImplCommand);virtual;
     procedure WriteImplCommands(ACommands: TPasImplCommands); virtual;
     procedure WriteImplIfElse(AIfElse: TPasImplIfElse); virtual;
+    procedure WriteImplCaseOf(ACaseOf: TPasImplCaseOf); virtual;
+    procedure WriteImplCaseStatement(ACaseStatement: TPasImplCaseStatement;
+      AAutoInsertBeginEnd: boolean=true); virtual;
     procedure WriteImplForLoop(AForLoop: TPasImplForLoop); virtual;
     procedure WriteImplWhileDo(aWhileDo : TPasImplWhileDo); virtual;
     procedure WriteImplRepeatUntil(aRepeatUntil : TPasImplRepeatUntil); virtual;
@@ -1196,6 +1199,8 @@ begin
     end
   else if AElement.ClassType = TPasImplIfElse then
     WriteImplIfElse(TPasImplIfElse(AElement))
+  else if AElement.InheritsFrom(TPasImplCaseOf) then
+    WriteImplCaseOf(TPasImplCaseOf(aElement))
   else if AElement.ClassType = TPasImplForLoop then
     WriteImplForLoop(TPasImplForLoop(AElement))
   else if AElement.InheritsFrom(TPasImplWhileDo) then
@@ -1295,6 +1300,72 @@ begin
     end;
 end;
 
+procedure TPasWriter.WriteImplCaseStatement(ACaseStatement: TPasImplCaseStatement;AAutoInsertBeginEnd:boolean=true);
+var
+  i: Integer;
+begin
+  for i := 0 to ACaseStatement.Expressions.Count - 1 do
+     begin
+       if i>0 then add(', ');
+       add(GetExpr(TPasExpr(ACaseStatement.Expressions[i])))
+     end;
+  add(': ');
+  IncIndent;
+  //JC: If no body is assigned, omit the whole block
+  if assigned(ACaseStatement.Body) then
+    begin
+      if AAutoInsertBeginEnd then
+        begin
+          addLn('begin');
+          IncIndent;
+        end;
+      //JC: if the body already is a begin-end-Block, the begin of that block is omitted
+      if ACaseStatement.Body is TPasImplBeginBlock then
+         WriteImplBlock(TPasImplBeginBlock(ACaseStatement.Body))
+       else
+         WriteImplElement(ACaseStatement.Body,false);
+      if AAutoInsertBeginEnd then
+        begin
+          DecIndent;
+          Add('end'); //JC: No semicolon or Linefeed here !
+          // Otherwise there would be a problem with th else-statement.
+        end;
+    end;
+  DecIndent;
+end;
+
+procedure TPasWriter.WriteImplCaseOf(ACaseOf: TPasImplCaseOf);
+var
+  i: Integer;
+
+begin
+  Add('case %s of', [GetExpr(ACaseOf.CaseExpr)]);
+  IncIndent;
+  for i := 0 to ACaseOf.Elements.Count - 1 do
+  begin
+    if TPasElement(ACaseOf.Elements[i]) is TPasImplCaseStatement then
+      begin
+        if i >0 then
+          AddLn(';')
+        else
+          AddLn;
+        WriteImplCaseStatement(TPasImplCaseStatement(ACaseOf.Elements[i]),True);
+      end;
+  end;
+  if assigned(ACaseOf.ElseBranch) then
+    begin
+      AddLn;
+      AddLn('else');
+      IncIndent;
+      WriteImplBlock(ACaseOf.ElseBranch);
+      DecIndent;
+    end
+  else
+    AddLn(';');
+  DecIndent;
+  AddLn('end;');
+end;
+
 
 procedure TPasWriter.WriteImplRepeatUntil(aRepeatUntil: TPasImplRepeatUntil);
 
@@ -1337,9 +1408,14 @@ end;
 
 procedure TPasWriter.WriteImplRaise(aRaise: TPasImplRaise);
 begin
-  Add('raise %s',[GetExpr(aRaise.ExceptObject)]);
+  if  assigned(aRaise.ExceptObject) then
-  if aRaise.ExceptAddr<>Nil then
+    begin
-    Add(' at %s',[GetExpr(aRaise.ExceptAddr)]);
+      Add('raise %s',[GetExpr(aRaise.ExceptObject)]);
+      if aRaise.ExceptAddr<>Nil then
+        Add(' at %s',[GetExpr(aRaise.ExceptAddr)]);
+    end
+  else
+    Add('raise');
   Addln(';');
 end;
 
@@ -1391,15 +1467,21 @@ begin
   With aForLoop do
     begin
     If LoopType=ltIn then
-      AddLn('for %s in %s do',[GetExpr(VariableName),GetExpr(StartExpr)])
+      Add('for %s in %s do',[GetExpr(VariableName),GetExpr(StartExpr)])
     else
-      AddLn('for %s:=%s %s %s do',[GetExpr(VariableName),GetExpr(StartExpr),
+      Add('for %s:=%s %s %s do',[GetExpr(VariableName),GetExpr(StartExpr),
                                    ToNames[Down],GetExpr(EndExpr)]);
-    IncIndent;
+    if assigned(Body) then
-    WriteImplElement(Body, True);
+      begin
-    DecIndent;
+        AddLn;
-    if (Body is TPasImplBlock) and
+        IncIndent;
-       (Body is TPasImplCommands) then
+        WriteImplElement(Body, True);
+        DecIndent;
+        if (Body is TPasImplBlock) and
+           (Body is TPasImplCommands) then
+          AddLn(';');
+      end
+    else
       AddLn(';');
     end;
 end;
@@ -1410,12 +1492,18 @@ procedure TPasWriter.WriteImplWhileDo(aWhileDo: TPasImplWhileDo);
 begin
   With aWhileDo do
     begin
-    AddLn('While %s do',[GetExpr(ConditionExpr)]);
+    Add('While %s do',[GetExpr(ConditionExpr)]);
-    IncIndent;
+    if assigned(Body) then
-    WriteImplElement(Body, True);
+      begin
-    DecIndent;
+        AddLn;
-    if (Body.InheritsFrom(TPasImplBlock)) and
+        IncIndent;
-       (Body.InheritsFrom(TPasImplCommands)) then
+        WriteImplElement(Body, True);
+        DecIndent;
+        if (Body.InheritsFrom(TPasImplBlock)) and
+           (Body.InheritsFrom(TPasImplCommands)) then
+          AddLn(';');
+      end
+    else
       AddLn(';');
     end;
 end;

packages/fcl-passrc/src/pparser.pp

@@ -451,7 +451,8 @@ type
     procedure ParseArgList(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
       EndToken: TToken);
-    procedure ParseProcedureOrFunction(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
+    procedure ParseProcedureOrFunction(Parent: TPasElement;
+      Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
     procedure ParseProcedureBody(Parent: TPasElement);
     function ParseMethodResolution(Parent: TPasElement): TPasMethodResolution;
     // Properties for external access
@@ -4998,7 +4999,7 @@ begin
     ptAnonymousProcedure,ptAnonymousFunction:
       case CurToken of
       tkIdentifier, // e.g. procedure assembler
-      tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction:
+      tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction,tkasm:
         UngetToken;
       tkColon:
         if ProcType=ptAnonymousFunction then
@@ -5300,7 +5301,7 @@ begin
         ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
       end;
   else
-    resultEl:=Nil;
+    ResultEl:=Nil;
   end;
   if OfObjectPossible then
     begin
@@ -5312,7 +5313,7 @@ begin
       end
     else if (CurToken = tkIs) then
       begin
-      expectToken(tkIdentifier);
+      ExpectToken(tkIdentifier);
       if (lowerCase(CurTokenString)<>'nested') then
         ParseExc(nParserExpectedNested,SParserExpectedNested);
       Element.IsNested:=True;

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -661,9 +661,11 @@ begin
     FFileName:=MainFilename;
   FResolver.AddStream(FFileName,TStringStream.Create(FSource.Text));
   FScanner.OpenFile(FFileName);
+  {$ifndef NOCONSOLE} // JC: To get the tests to run with GUI
   Writeln('// Test : ',Self.TestName);
   for i:=0 to FSource.Count-1 do
     Writeln(Format('%:4d: ',[i+1]),FSource[i]);
+  {$EndIf}
 end;
 
 procedure TTestParser.ParseDeclarations;

packages/fcl-passrc/tests/tcresolver.pas

@@ -4281,6 +4281,15 @@ begin
   '  i:=longint(er);',
   '  if b in sr then ;',
   '  if er in sr then ;',
+  '  er:=low(TEnumRg);',
+  '  er:=high(TEnumRg);',
+  '  er:=succ(er);',
+  '  er:=pred(er);',
+  '  inc(er);',
+  '  dec(er);',
+  '  case er of',
+  '  c: ;',
+  '  end;',
   '']);
   ParseProgram;
   CheckResolverUnexpectedHints;

packages/pastojs/src/fppas2js.pp

@@ -5524,15 +5524,21 @@ var
   Params: TParamsExpr;
   Param: TPasExpr;
   ParamResolved: TPasResolverResult;
+  bt: TResolverBaseType;
+  C: TClass;
 begin
   Result:=inherited;
   Params:=TParamsExpr(Expr);
   Param:=Params.Params[1];
   ComputeElement(Param,ParamResolved,[]);
   Result:=cIncompatible;
-  if ParamResolved.BaseType=btContext then
+  bt:=ParamResolved.BaseType;
+  if bt=btRange then
+    bt:=ParamResolved.SubType;
+  if bt=btContext then
     begin
-    if ParamResolved.LoTypeEl is TPasEnumType then
+    C:=ParamResolved.LoTypeEl.ClassType;
+    if (C=TPasEnumType) or (C=TPasRangeType) then
       Result:=cExact
     end;
   if Result=cIncompatible then
@@ -11831,6 +11837,9 @@ var
   AddExpr: TJSAdditiveExpressionPlus;
   Int: TMaxPrecInt;
   aResolver: TPas2JSResolver;
+  from_bt: TResolverBaseType;
+  FromTypeEl: TPasType;
+  ElTypeResolved: TPasResolverResult;
 begin
   Result:=nil;
   Param:=El.Params[0];
@@ -11839,8 +11848,16 @@ begin
   JSBaseTypeData:=nil;
   JSBaseType:=pbtNone;
 
+  from_bt:=ParamResolved.BaseType;
+  FromTypeEl:=ParamResolved.LoTypeEl;
+  if from_bt=btRange then
+    begin
+    from_bt:=ParamResolved.SubType;
+    aResolver.ComputeElement(TPasRangeType(FromTypeEl).RangeExpr.left,ElTypeResolved,[rcConstant]);
+    FromTypeEl:=ElTypeResolved.LoTypeEl;
+    end;
   to_bt:=ToBaseTypeData.BaseType;
-  if to_bt=ParamResolved.BaseType then
+  if from_bt=to_bt then
     begin
     Result:=ConvertExpression(Param,AContext);
     exit;
@@ -11848,14 +11865,14 @@ begin
 
   if to_bt in btAllJSInteger then
     begin
-    if ParamResolved.BaseType in btAllJSInteger then
+    if from_bt in btAllJSInteger then
       begin
       // integer to integer -> value
       Result:=ConvertExpression(Param,AContext);
-      Result:=ConvertIntToInt(Result,ParamResolved.BaseType,to_bt,El,AContext);
+      Result:=ConvertIntToInt(Result,from_bt,to_bt,El,AContext);
       exit;
       end
-    else if ParamResolved.BaseType in btAllJSBooleans then
+    else if from_bt in btAllJSBooleans then
       begin
       // boolean to integer -> value?1:0
       Result:=ConvertExpression(Param,AContext);
@@ -11870,7 +11887,7 @@ begin
       Result:=CondExpr;
       exit;
       end
-    else if ParamResolved.BaseType in btAllJSChars then
+    else if from_bt in btAllJSChars then
       begin
       // char to integer
       Result:=ConvertExpression(Param,AContext);
@@ -11878,9 +11895,9 @@ begin
       Result:=ConvertIntToInt(Result,btWord,to_bt,El,AContext);
       exit;
       end
-    else if ParamResolved.BaseType=btContext then
+    else if from_bt=btContext then
       begin
-      if ParamResolved.LoTypeEl.ClassType=TPasEnumType then
+      if FromTypeEl.ClassType=TPasEnumType then
         begin
         // e.g. longint(TEnum) -> value
         Result:=ConvertExpression(Param,AContext);
@@ -11904,7 +11921,7 @@ begin
         exit;
         end;
       end
-    else if (to_bt=btCurrency) and (ParamResolved.BaseType in btAllJSFloats) then
+    else if (to_bt=btCurrency) and (from_bt in btAllJSFloats) then
       begin
       // currency(double)  ->  double*10000
       Result:=ConvertExpression(Param,AContext);
@@ -11914,13 +11931,13 @@ begin
     end
   else if to_bt in btAllJSBooleans then
     begin
-    if ParamResolved.BaseType in btAllJSBooleans then
+    if from_bt in btAllJSBooleans then
       begin
       // boolean to boolean -> value
       Result:=ConvertExpression(Param,AContext);
       exit;
       end
-    else if ParamResolved.BaseType in btAllJSInteger then
+    else if from_bt in btAllJSInteger then
       begin
       // integer to boolean -> value!=0
       Result:=ConvertExpression(Param,AContext);
@@ -11949,7 +11966,7 @@ begin
     end
   else if to_bt in btAllJSFloats then
     begin
-    if ParamResolved.BaseType in (btAllJSFloats+btAllJSInteger) then
+    if from_bt in (btAllJSFloats+btAllJSInteger) then
       begin
       // int to double -> value
       Result:=ConvertExpression(Param,AContext);
@@ -11975,13 +11992,13 @@ begin
     end
   else if to_bt in btAllJSStrings then
     begin
-    if ParamResolved.BaseType in btAllJSStringAndChars then
+    if from_bt in btAllJSStringAndChars then
       begin
       // string or char to string -> value
       Result:=ConvertExpression(Param,AContext);
       exit;
       end
-    else if ParamResolved.BaseType=btPointer then
+    else if from_bt=btPointer then
       begin
       // string(aPointer) -> value
       Result:=ConvertExpression(Param,AContext);
@@ -12004,15 +12021,15 @@ begin
     end
   else if to_bt=btChar then
     begin
-    if ParamResolved.BaseType=btChar then
+    if from_bt=btChar then
       begin
       // char to char
       Result:=ConvertExpression(Param,AContext);
       exit;
       end
-    else if (ParamResolved.BaseType in btAllJSInteger)
+    else if (from_bt in btAllJSInteger)
-        or ((ParamResolved.BaseType=btContext)
+        or ((from_bt=btContext)
-          and (aResolver.ResolveAliasType(ParamResolved.LoTypeEl).ClassType=TPasEnumType))
+          and (FromTypeEl.ClassType=TPasEnumType))
         then
       begin
       // Note: convert value first in case it raises an exception
@@ -12030,7 +12047,7 @@ begin
         end;
       exit;
       end
-    else if (ParamResolved.BaseType in (btArrayRangeTypes+[btRange]))
+    else if (from_bt in (btArrayRangeTypes+[btRange]))
         or (IsParamPas2JSBaseType and (JSBaseType=pbtJSValue)) then
       begin
       // convert value to char -> rtl.getChar(value)
@@ -12071,13 +12088,13 @@ begin
         exit;
         end;
       end
-    else if ParamResolved.BaseType in btAllJSStrings then
+    else if from_bt in btAllJSStrings then
       begin
       // pointer(aString) -> value
       Result:=ConvertExpression(Param,AContext);
       exit;
       end
-    else if ParamResolved.BaseType=btContext then
+    else if from_bt=btContext then
       begin
       // convert user type/value to pointer -> value
       Result:=ConvertExpression(Param,AContext);
@@ -12753,6 +12770,8 @@ var
   Minus: TJSAdditiveExpressionMinus;
   Add: TJSAdditiveExpressionPlus;
   aResolver: TPas2JSResolver;
+  bt: TResolverBaseType;
+  C: TClass;
 begin
   Result:=nil;
   aResolver:=AContext.Resolver;
@@ -12760,7 +12779,10 @@ begin
     RaiseInconsistency(20170210105235,El);
   Param:=El.Params[0];
   aResolver.ComputeElement(Param,ParamResolved,[]);
-  if ParamResolved.BaseType=btChar then
+  bt:=ParamResolved.BaseType;
+  if bt=btRange then
+    bt:=ParamResolved.SubType;
+  if bt=btChar then
     begin
     if Param is TParamsExpr then
       begin
@@ -12805,7 +12827,7 @@ begin
     Result:=CreateCallCharCodeAt(Result,0,El);
     exit;
     end
-  else if ParamResolved.BaseType in btAllJSBooleans then
+  else if bt in btAllJSBooleans then
     begin
     // ord(bool)
     Result:=CheckOrdConstant(aResolver,Param);
@@ -12819,9 +12841,10 @@ begin
     Result:=Add;
     exit;
     end
-  else if ParamResolved.BaseType=btContext then
+  else if bt=btContext then
     begin
-    if ParamResolved.LoTypeEl.ClassType=TPasEnumType then
+    C:=ParamResolved.LoTypeEl.ClassType;
+    if (C=TPasEnumType) or (C=TPasRangeType) then
       begin
       // ord(enum) -> enum
       Result:=ConvertExpression(Param,AContext);
@@ -12856,25 +12879,39 @@ function TPasToJSConverter.ConvertBuiltIn_LowHigh(El: TParamsExpr;
   end;
 
 var
-  ResolvedEl: TPasResolverResult;
   Param: TPasExpr;
+  aResolver: TPas2JSResolver;
+  ResolvedEl: TPasResolverResult;
   TypeEl: TPasType;
   Ranges: TPasExprArray;
   Value: TResEvalValue;
   Call: TJSCallExpression;
   MinusExpr: TJSAdditiveExpressionMinus;
   MinVal, MaxVal: TMaxPrecInt;
+  bt: TResolverBaseType;
 begin
   Result:=nil;
   if AContext.Resolver=nil then
     RaiseInconsistency(20170210120659,El);
   Param:=El.Params[0];
-  AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
+  aResolver:=AContext.Resolver;
-  case ResolvedEl.BaseType of
+  aResolver.ComputeElement(Param,ResolvedEl,[]);
+  bt:=ResolvedEl.BaseType;
+  if bt=btRange then
+    bt:=ResolvedEl.SubType;
+  case bt of
     btContext:
       begin
       TypeEl:=ResolvedEl.LoTypeEl;
-      if TypeEl.ClassType=TPasEnumType then
+      if TypeEl.ClassType=TPasRangeType then
+        begin
+        if IsLow then
+          Result:=ConvertElement(TPasRangeType(TypeEl).RangeExpr.left,AContext)
+        else
+          Result:=ConvertElement(TPasRangeType(TypeEl).RangeExpr.right,AContext);
+        exit;
+        end
+      else if TypeEl.ClassType=TPasEnumType then
         begin
         CreateEnumValue(TPasEnumType(TypeEl));
         exit;
@@ -13261,25 +13298,32 @@ var
   end;
 
 var
-  ResolvedEl: TPasResolverResult;
+  aResolver: TPas2JSResolver;
+  ResolvedEl, ElTypeResolved: TPasResolverResult;
   NeedStrLit: Boolean;
   Call: TJSCallExpression;
   Bracket: TJSBracketMemberExpression;
   Arg: TJSElement;
+  bt: TResolverBaseType;
+  TypeEl: TPasType;
 begin
   Result:=nil;
-  AContext.Resolver.ComputeElement(El,ResolvedEl,[]);
+  aResolver:=AContext.Resolver;
+  aResolver.ComputeElement(El,ResolvedEl,[]);
   Add:=nil;
   Call:=nil;
   Bracket:=nil;
   try
     NeedStrLit:=false;
-    if ResolvedEl.BaseType in (btAllJSBooleans+btAllJSInteger-[btCurrency]) then
+    bt:=ResolvedEl.BaseType;
+    if bt=btRange then
+      bt:=ResolvedEl.SubType;
+    if bt in (btAllJSBooleans+btAllJSInteger-[btCurrency]) then
       begin
       NeedStrLit:=true;
       Add:=ConvertExpression(El,AContext);
       end
-    else if ResolvedEl.BaseType in (btAllJSFloats+[btCurrency]) then
+    else if bt in (btAllJSFloats+[btCurrency]) then
       begin
       // convert to rtl.floatToStr(El,width,precision)
       Call:=CreateCallExpression(El);
@@ -13296,15 +13340,21 @@ begin
       Call:=nil;
       exit;
       end
-    else if IsStrFunc and (ResolvedEl.BaseType in btAllJSStringAndChars) then
+    else if IsStrFunc and (bt in btAllJSStringAndChars) then
       Add:=ConvertExpression(El,AContext)
-    else if ResolvedEl.BaseType=btContext then
+    else if bt=btContext then
       begin
-      if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
+      TypeEl:=ResolvedEl.LoTypeEl;
+      if TypeEl.ClassType=TPasRangeType then
+        begin
+        aResolver.ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ElTypeResolved,[rcConstant]);
+        TypeEl:=ElTypeResolved.LoTypeEl;
+        end;
+      if TypeEl.ClassType=TPasEnumType then
         begin
         // create enumtype[enumvalue]
         Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
-        Bracket.MExpr:=CreateReferencePathExpr(TPasEnumType(ResolvedEl.LoTypeEl),AContext);
+        Bracket.MExpr:=CreateReferencePathExpr(TPasEnumType(TypeEl),AContext);
         Bracket.Name:=ConvertExpression(El,AContext);
         Add:=Bracket;
         Bracket:=nil;
@@ -13389,28 +13439,32 @@ function TPasToJSConverter.ConvertBuiltIn_Val(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
 // val(const s: string; out value: valuetype; out Code: integertype)
 // for enum it is converted to
-//   value = rtl.valEnum(s,enumTupe,function(c){ Code=c; })
+//   value = rtl.valEnum(s,enumType,function(c){ Code=c; })
 var
+  aResolver: TPas2JSResolver;
   AssignContext: TAssignContext;
   ValueExpr, CodeExpr: TPasExpr;
   Call: TJSCallExpression;
   Params: TPasExprArray;
   EnumType: TPasEnumType;
   Fun: TJSFunctionDeclarationStatement;
-  ExprResolved: TPasResolverResult;
+  ExprResolved, ElTypeResolved: TPasResolverResult;
   ExprArg: TPasArgument;
   AssignSt: TJSSimpleAssignStatement;
   SetterArgName: String;
   ArgJS, SetExpr: TJSElement;
+  bt: TResolverBaseType;
+  LoTypeEl: TPasType;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
   Params:=El.Params;
   Call:=nil;
   AssignContext:=TAssignContext.Create(El,nil,AContext);
   try
     //
     ValueExpr:=Params[1];
-    AContext.Resolver.ComputeElement(ValueExpr,AssignContext.LeftResolved,[rcNoImplicitProc]);
+    aResolver.ComputeElement(ValueExpr,AssignContext.LeftResolved,[rcNoImplicitProc]);
 
     // rtl.valEnum()
     Call:=CreateCallExpression(El);
@@ -13419,11 +13473,20 @@ begin
     // add arg string
     Call.AddArg(ConvertExpression(Params[0],AContext));
     // add arg enumtype
-    if AssignContext.LeftResolved.BaseType=btContext then
+    bt:=AssignContext.LeftResolved.BaseType;
+    if bt=btRange then
+      bt:=AssignContext.LeftResolved.SubType;
+    if bt=btContext then
       begin
-      if AssignContext.LeftResolved.LoTypeEl is TPasEnumType then
+      LoTypeEl:=AssignContext.LeftResolved.LoTypeEl;
+      if LoTypeEl.ClassType=TPasRangeType then
         begin
-        EnumType:=TPasEnumType(AssignContext.LeftResolved.LoTypeEl);
+        aResolver.ComputeElement(TPasRangeType(LoTypeEl).RangeExpr.left,ElTypeResolved,[rcConstant]);
+        LoTypeEl:=ElTypeResolved.LoTypeEl;
+        end;
+      if LoTypeEl.ClassType=TPasEnumType then
+        begin
+        EnumType:=TPasEnumType(LoTypeEl);
         Call.AddArg(CreateReferencePathExpr(EnumType,AContext));
         end else
           RaiseNotSupported(Params[1],AContext,20181214145226,GetResolverResultDbg(AssignContext.LeftResolved));
@@ -23321,6 +23384,8 @@ var
   Call: TJSCallExpression;
   DotExpr: TJSDotMemberExpression;
   aResolver: TPas2JSResolver;
+  bt: TResolverBaseType;
+  C: TClass;
 begin
   Result:=ConvertExpression(Expr,AContext);
   if Result=nil then
@@ -23374,19 +23439,22 @@ begin
   if aResolver<>nil then
     begin
     aResolver.ComputeElement(Expr,ExprResolved,[]);
-    if (ExprResolved.BaseType in btAllJSStringAndChars)
+    bt:=ExprResolved.BaseType;
-        or ((ExprResolved.BaseType=btRange) and (ExprResolved.SubType in btAllJSChars)) then
+    if bt=btRange then
+      bt:=ExprResolved.SubType;
+    if bt in btAllJSStringAndChars then
       begin
       // aChar -> aChar.charCodeAt()
       Result:=CreateCallCharCodeAt(Result,0,Expr);
       end
-    else if ExprResolved.BaseType in btAllJSInteger then
+    else if bt in btAllJSInteger then
       begin
       // ok
       end
-    else if ExprResolved.BaseType=btContext then
+    else if bt=btContext then
       begin
-      if ExprResolved.LoTypeEl.ClassType=TPasEnumType then
+      C:=ExprResolved.LoTypeEl.ClassType;
+      if (C=TPasEnumType) or (C=TPasRangeType) then
         // ok
       else
         RaiseNotSupported(Expr,AContext,20170415191933);

packages/pastojs/src/pas2jslibcompiler.pp

@@ -67,6 +67,8 @@ Type
     FOnWriteJSCallBack: TWriteJSCallBack;
     FOnWriteJSData: Pointer;
     FReadBufferLen: Cardinal;
+    function GetLogEncoding: String;
+    procedure SetLogEncoding(AValue: String);
   Protected
     Function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; override;
     Procedure GetLastError(AError : PAnsiChar; Var AErrorLength : Longint;
@@ -80,6 +82,7 @@ Type
     Function LibraryRun(ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) :Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
     Property LastError : String Read FLastError Write FLastError;
     Property LastErrorClass : String Read FLastErrorClass Write FLastErrorClass;
+    property LogEncoding: String  read GetLogEncoding write SetLogEncoding;
     Property OnLibLogCallBack : TLibLogCallBack Read FOnLibLogCallBack Write FOnLibLogCallBack;
     Property OnLibLogData : Pointer Read FOnLibLogData Write FOnLibLogData;
     Property OnWriteJSCallBack : TWriteJSCallBack Read FOnWriteJSCallBack Write FOnWriteJSCallBack;
@@ -107,6 +110,7 @@ Function RunPas2JSCompiler(P : PPas2JSCompiler; ACompilerExe, AWorkingDir : PAns
 Procedure FreePas2JSCompiler(P : PPas2JSCompiler); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 Function GetPas2JSCompiler : PPas2JSCompiler; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 Procedure GetPas2JSCompilerLastError(P : PPas2JSCompiler; AError : PAnsiChar; Var AErrorLength : Longint; AErrorClass : PAnsiChar; Var AErrorClassLength : Longint); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+procedure SetPas2JSLogEncoding(P : PPas2JSCompiler; Enconding: PAnsiChar); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 implementation
 
@@ -120,6 +124,16 @@ begin
     Result:=OnReadDir(FOnReadDirData,Dir,PAnsiChar(Dir.Path));
 end;
 
+function TLibraryPas2JSCompiler.GetLogEncoding: String;
+begin
+  Result := Log.Encoding;
+end;
+
+procedure TLibraryPas2JSCompiler.SetLogEncoding(AValue: String);
+begin
+  Log.Encoding := AValue;
+end;
+
 function TLibraryPas2JSCompiler.DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean;
 
 Var
@@ -344,5 +358,10 @@ begin
   TLibraryPas2JSCompiler(P).GetLastError(AError,AErrorLength,AErrorClass,AErrorClassLength);
 end;
 
+procedure SetPas2JSLogEncoding(P : PPas2JSCompiler; Enconding: PAnsiChar); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+  TLibraryPas2JSCompiler(P).LogEncoding := Enconding;
+end;
+
 end.
 

packages/pastojs/tests/tcfiler.pas

@@ -2730,7 +2730,7 @@ begin
   'implementation',
   'generic function Run<T>(a: T): T;',
   'var b: T;',
-  '  var i: word;',
+  '  i: word;',
   'begin',
   '  b:=a;',
   '  Result:=b;',

packages/pastojs/tests/tcmodules.pas

@@ -358,12 +358,14 @@ type
     Procedure TestAnonymousProc_NestedAssignResult;
     Procedure TestAnonymousProc_Class;
     Procedure TestAnonymousProc_ForLoop;
+    Procedure TestAnonymousProc_AsmDelphi;
 
     // enums, sets
     Procedure TestEnum_Name;
     Procedure TestEnum_Number;
     Procedure TestEnum_ConstFail;
     Procedure TestEnum_Functions;
+    Procedure TestEnumRg_Functions;
     Procedure TestEnum_AsParams;
     Procedure TestEnumRange_Array;
     Procedure TestEnum_ForIn;
@@ -5256,6 +5258,51 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestAnonymousProc_AsmDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TProc = reference to procedure;',
+  '  TFunc = reference to function(x: word): word;',
+  'procedure Run;',
+  'asm',
+  'end;',
+  'procedure Walk(p: TProc; f: TFunc);',
+  'begin',
+  '  Walk(procedure asm end, function(b:word): word asm return 1+b; end);',
+  'end;',
+  'begin',
+  '  Walk(procedure',
+  '    asm',
+  '      console.log("a");',
+  '    end,',
+  '    function(x: word): word asm',
+  '      console.log("c");',
+  '    end);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_AsmDelphi',
+    LinesToStr([ // statements
+    'this.Run = function () {',
+    '};',
+    'this.Walk = function (p, f) {',
+    '  $mod.Walk(function () {',
+    '  }, function (b) {',
+    '    return 1+b;',
+    '  });',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.Walk(function () {',
+    '  console.log("a");',
+    '}, function (x) {',
+    '  console.log("c");',
+    '});',
+    '']));
+end;
+
 procedure TTestModule.TestEnum_Name;
 begin
   StartProgram(false);
@@ -5373,7 +5420,6 @@ begin
   '  s:=str(e:3);',
   '  writestr(s,e:3,red);',
   '  val(s,e,i);',
-  '  e:=TMyEnum(i);',
   '  i:=longint(e);']);
   ConvertProgram;
   CheckSource('TestEnum_Functions',
@@ -5424,7 +5470,93 @@ begin
     '$mod.e = rtl.valEnum($mod.s, $mod.TMyEnum, function (v) {',
     '  $mod.i = v;',
     '});',
+    '$mod.i=$mod.e;',
+    '']));
+end;
+
+procedure TTestModule.TestEnumRg_Functions;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEnum = (Red, Green, Blue);',
+  '  TEnumRg = Green..Blue;',
+  'procedure DoIt(var e: TEnumRg; var i: word);',
+  'var',
+  '  v: longint;',
+  '  s: string;',
+  'begin',
+  '  val(s,e,v);',
+  '  val(s,e,i);',
+  'end;',
+  'var',
+  '  e: TEnumRg;',
+  '  i: longint;',
+  '  s: string;',
+  'begin',
+  '  i:=ord(green);',
+  '  i:=ord(e);',
+  '  e:=low(tenumrg);',
+  '  e:=low(e);',
+  '  e:=high(tenumrg);',
+  '  e:=high(e);',
+  '  e:=pred(blue);',
+  '  e:=pred(e);',
+  '  e:=succ(green);',
+  '  e:=succ(e);',
+  '  e:=tenumrg(1);',
+  '  e:=tenumrg(i);',
+  '  s:=str(e);',
+  '  str(e,s);',
+  '  str(red,s);',
+  '  s:=str(e:3);',
+  '  writestr(s,e:3,blue);',
+  '  val(s,e,i);',
+  '  i:=longint(e);']);
+  ConvertProgram;
+  CheckSource('TestEnumRg_Functions',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1,',
+    '  "2":"Blue",',
+    '  Blue:2',
+    '  };',
+    'this.DoIt = function (e, i) {',
+    '  var v = 0;',
+    '  var s = "";',
+    '  e.set(rtl.valEnum(s, $mod.TEnum, function (w) {',
+    '    v = w;',
+    '  }));',
+    '  e.set(rtl.valEnum(s, $mod.TEnum, i.set));',
+    '};',
+    'this.e = this.TEnum.Green;',
+    'this.i = 0;',
+    'this.s = "";',
+    '']),
+    LinesToStr([
+    '$mod.i=$mod.TEnum.Green;',
+    '$mod.i=$mod.e;',
+    '$mod.e=$mod.TEnum.Green;',
+    '$mod.e=$mod.TEnum.Green;',
+    '$mod.e=$mod.TEnum.Blue;',
+    '$mod.e=$mod.TEnum.Blue;',
+    '$mod.e=$mod.TEnum.Blue-1;',
+    '$mod.e=$mod.e-1;',
+    '$mod.e=$mod.TEnum.Green+1;',
+    '$mod.e=$mod.e+1;',
+    '$mod.e=1;',
     '$mod.e=$mod.i;',
+    '$mod.s = $mod.TEnum[$mod.e];',
+    '$mod.s = $mod.TEnum[$mod.e];',
+    '$mod.s = $mod.TEnum[$mod.TEnum.Red];',
+    '$mod.s = rtl.spaceLeft($mod.TEnum[$mod.e], 3);',
+    '$mod.s = rtl.spaceLeft($mod.TEnum[$mod.e], 3)+$mod.TEnum[$mod.TEnum.Blue];',
+    '$mod.e = rtl.valEnum($mod.s, $mod.TEnum, function (v) {',
+    '  $mod.i = v;',
+    '});',
     '$mod.i=$mod.e;',
     '']));
 end;
@@ -5824,23 +5956,28 @@ end;
 procedure TTestModule.TestSet_Operator_In;
 begin
   StartProgram(false);
-  Add('type');
+  Add([
-  Add('  TColor = (Red, Green, Blue);');
+  'type',
-  Add('  TColors = set of tcolor;');
+  '  TColor = (Red, Green, Blue);',
-  Add('var');
+  '  TColors = set of tcolor;',
-  Add('  vC: tcolor;');
+  '  TColorRg = green..blue;',
-  Add('  vT: tcolors;');
+  'var',
-  Add('  B: boolean;');
+  '  vC: tcolor;',
-  Add('begin');
+  '  vT: tcolors;',
-  Add('  b:=red in vt;');
+  '  B: boolean;',
-  Add('  b:=vc in vt;');
+  '  rg: TColorRg;',
-  Add('  b:=green in [red..blue];');
+  'begin',
-  Add('  b:=vc in [red..blue];');
+  '  b:=red in vt;',
-  Add('  ');
+  '  b:=vc in vt;',
-  Add('  if red in vt then ;');
+  '  b:=green in [red..blue];',
-  Add('  while vC in vt do ;');
+  '  b:=vc in [red..blue];',
-  Add('  repeat');
+  '  ',
-  Add('  until vC in vt;');
+  '  if red in vt then ;',
+  '  while vC in vt do ;',
+  '  repeat',
+  '  until vC in vt;',
+  '  if rg in [green..blue] then ;',
+  '']);
   ConvertProgram;
   CheckSource('TestSet_Operator_In',
     LinesToStr([ // statements
@@ -5854,8 +5991,9 @@ begin
     '  };',
     'this.vC = 0;',
     'this.vT = {};',
-    'this.B = false;'
+    'this.B = false;',
-    ]),
+    'this.rg = this.TColor.Green;',
+    '']),
     LinesToStr([
     '$mod.B = $mod.TColor.Red in $mod.vT;',
     '$mod.B = $mod.vC in $mod.vT;',
@@ -5866,6 +6004,7 @@ begin
     '};',
     'do {',
     '} while (!($mod.vC in $mod.vT));',
+    'if ($mod.rg in rtl.createSet(null, $mod.TColor.Green, $mod.TColor.Blue)) ;',
     '']));
 end;
 

rtl/inc/except.inc

@@ -101,40 +101,43 @@ begin
   writeln ('In PushExceptObject');
 {$endif}
   _ExceptObjectStack:=@ExceptObjectStack;
-  New(NewObj);
+  NewObj:=AllocMem(sizeof(TExceptObject));
   NewObj^.Next:=_ExceptObjectStack^;
   _ExceptObjectStack^:=NewObj;
 
   NewObj^.FObject:=Obj;
   NewObj^.Addr:=AnAddr;
-  NewObj^.refcount:=0;
+  if assigned(get_frame) then
+    begin
+	  NewObj^.refcount:=0;
 
-  { Backtrace }
+	  { Backtrace }
-  curr_frame:=AFrame;
+	  curr_frame:=AFrame;
-  curr_addr:=AnAddr;
+	  curr_addr:=AnAddr;
-  frames:=nil;
+	  frames:=nil;
-  framecount:=0;
+	  framecount:=0;
-  framebufsize:=0;
+      framebufsize:=0;
-  { The frame pointer of this procedure is used as initial stack bottom value. }
+      { The frame pointer of this procedure is used as initial stack bottom value. }
-  prev_frame:=get_frame;
+      prev_frame:=get_frame;
-  while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) and
+      while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) and
-        (curr_frame<StackTop) do
+            (curr_frame<StackTop) do
-    Begin
+        Begin
-      prev_frame:=curr_frame;
+          prev_frame:=curr_frame;
-      get_caller_stackinfo(curr_frame,curr_addr);
+          get_caller_stackinfo(curr_frame,curr_addr);
-      if (curr_addr=nil) or
+          if (curr_addr=nil) or
-         (curr_frame=nil) then
+             (curr_frame=nil) then
-        break;
+            break;
-      if (framecount>=framebufsize) then
+          if (framecount>=framebufsize) then
-        begin
+            begin
-          inc(framebufsize,16);
+              inc(framebufsize,16);
-          reallocmem(frames,framebufsize*sizeof(codepointer));
+              reallocmem(frames,framebufsize*sizeof(codepointer));
-        end;
+            end;
-      frames[framecount]:=curr_addr;
+          frames[framecount]:=curr_addr;
-      inc(framecount);
+          inc(framecount);
-    End;
+        End;
-  NewObj^.framecount:=framecount;
+	  NewObj^.framecount:=framecount;
-  NewObj^.frames:=frames;
+	  NewObj^.frames:=frames;
+    end;
   Result:=NewObj;
 end;
 

rtl/inc/system.inc

@@ -1399,7 +1399,7 @@ end;
 
 Procedure dump_stack(var f : text;fp : Pointer; addr : CodePointer);
 var
-  i : Longint;
+  i : ObjpasInt;
   prevfp : Pointer;
   is_dev : boolean;
 Begin
@@ -1435,7 +1435,7 @@ End;
 
 procedure dump_stack(var f: text; skipframes: longint);
 var
-  i,count: longint;
+  i,count: ObjpasInt;
   frames: array [0..255] of codepointer;
 begin
   if do_isdevice(textrec(f).handle) then
@@ -1459,7 +1459,7 @@ end;
 procedure DumpExceptionBackTrace(var f:text);
 var
   FrameNumber,
-  FrameCount   : longint;
+  FrameCount   : ObjpasInt;
   Frames       : PCodePointer;
 begin
   if RaiseList=nil then
@@ -1525,7 +1525,7 @@ end;
 // if "s" goes out of scope in the parent procedure, the pointer is dangling.
 
 var p   : ppchar;
-    i   : LongInt;
+    i   : ObjpasInt;
 begin
   if High(s)<Low(s) Then Exit(NIL);
   Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2));  // one more for NIL, one more
@@ -1560,7 +1560,7 @@ end;
 Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
 
 var
-  i,nr  : longint;
+  i,nr  : ObjpasInt;
   Buf : ^char;
   p   : ppchar;
 
@@ -1731,7 +1731,7 @@ end;
 { Allow slash and backslash as separators }
 procedure DoDirSeparators(var p: pchar; inplace: boolean = true);
 var
-  i : longint;
+  i : ObjpasInt;
   len : sizeint;
   newp : pchar;
 begin
@@ -1753,7 +1753,7 @@ end;
 
 procedure DoDirSeparators(var p: pwidechar; inplace: boolean = true);
 var
-  i : longint;
+  i : ObjpasInt;
   len : sizeint;
   newp : pwidechar;
 begin
@@ -1776,7 +1776,7 @@ end;
 
 procedure DoDirSeparators(var p:shortstring);
 var
-  i : longint;
+  i : ObjpasInt;
 begin
   for i:=1 to length(p) do
     if p[i] in AllowDirectorySeparators then
@@ -1787,7 +1787,7 @@ end;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 procedure DoDirSeparators(var ps:RawByteString);
 var
-  i : longint;
+  i : ObjpasInt;
   p : pchar;
   unique : boolean;
 begin
@@ -1810,7 +1810,7 @@ end;
 {$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
 procedure DoDirSeparators(var ps:UnicodeString);
 var
-  i : longint;
+  i : ObjpasInt;
   p : pwidechar;
   unique : boolean;
 begin

rtl/objpas/classes/classesh.inc

@@ -1124,7 +1124,7 @@ type
     procedure WriteWord(w : Word);
     procedure WriteDWord(d : Cardinal);
     procedure WriteQWord(q : QWord);
-    Procedure WriteAnsiString (const S : String);
+    Procedure WriteAnsiString (const S : String); virtual;
     property Position: Int64 read GetPosition write SetPosition;
     property Size: Int64 read GetSize write SetSize64;
   end;
@@ -1260,8 +1260,8 @@ type
     Destructor Destroy; override;
     function ReadUnicodeString(Count: Longint): UnicodeString;
     procedure WriteUnicodeString(const AString: UnicodeString);
-    function ReadAnsiString(Count: Longint): AnsiString;
+    function ReadAnsiString(Count: Longint): AnsiString; overload;
-    procedure WriteAnsiString(const AString: AnsiString);
+    procedure WriteAnsiString(const AString: AnsiString); override;
     function ReadString(Count: Longint): string; 
     procedure WriteString(const AString: string);
     property DataString: string read GetDataString;

rtl/objpas/classes/streams.inc

@@ -1655,6 +1655,7 @@ begin
   NewLen:=Size-FPosition;
   If NewLen>Count then NewLen:=Count;
   Result:=FEncoding.GetAnsiString(FBytes,FPosition,NewLen);
+  Inc(FPosition,NewLen);
 end;
 
 procedure TStringStream.WriteAnsiString(const AString: AnsiString);
@@ -1704,6 +1705,7 @@ begin
     begin
     SetLength(Result, NewLen);
     Move(FBytes[FPosition],Result[1],NewLen);
+    inc(FPosition,Newlen);
     end;
 end;
 

rtl/objpas/sysconst.pp

@@ -100,6 +100,7 @@ const
   SSafecallException     = 'Exception in safecall method';
   SiconvError            = 'iconv error';
   SThreadError           = 'Thread error';
+  SSeekFailed            = 'Seek operation failed';
 
   STooManyOpenFiles      = 'Too many open files';
   SUnKnownRunTimeError   = 'Unknown Run-Time error : %3.3d';

rtl/objpas/sysutils/filutil.inc

@@ -670,3 +670,80 @@ begin
   Result:= False;
 end;
 {$endif}
+
+Function GetFileContents(Const aFileName : RawByteString) : TBytes;
+
+Var
+  H : Thandle;
+
+begin
+  H:=FileOpen(aFileName,fmOpenRead or fmShareDenyWrite);
+  if H<0 then
+    Raise EFileNotFoundException.Create(SFileNotFound);
+  try
+    Result:=GetFileContents(H);
+  finally
+    FileClose(H);
+  end;
+end;
+
+Function GetFileContents(Const aFileName : UnicodeString) : TBytes;
+
+Var
+  H : Thandle;
+
+begin
+  H:=FileOpen(aFileName,fmOpenRead or fmShareDenyWrite);
+  if H<0 then
+    Raise EFileNotFoundException.Create(SFileNotFound);
+  try
+    Result:=GetFileContents(H);
+  finally
+    FileClose(H);
+  end;
+end;
+
+Function GetFileContents(Const aHandle : THandle) : TBytes;
+
+Var
+  aLen,aOffset,aRead : Int64;
+  aBuf : PByte;
+
+begin
+  aLen:=FileSeek(aHandle,0,fsFromEnd);
+  if aLen<0 then
+    Raise EInOutError.Create(SSeekFailed);
+  if FileSeek(aHandle,0,fsFromBeginning)<0 then
+    Raise EInOutError.Create(SSeekFailed);
+  SetLength(Result,aLen);
+  aOffset:=0;
+  Repeat
+    aBuf:=@Result[aOffset];
+    aRead:=FileRead(aHandle,aBuf^,aLen-aOffset);
+    aOffset:=aOffset+aRead;
+  Until (aOffset>=aLen) or (aRead<=0);
+  if aRead<0 then
+    RaiseLastOSError;
+end;
+
+Function GetFileAsString(Const aFileName : RawByteString; aEncoding : TEncoding) : RawByteString;
+
+begin
+  Result:=aEncoding.GetAnsiString(GetFileContents(aFileName));
+end;
+
+Function GetFileAsString(Const aFileName : RawByteString) : RawByteString;
+
+begin
+  Result:=GetFileAsString(aFileName,TEncoding.SystemEncoding);
+end;
+
+Function GetFileAsString(Const aFileName : UnicodeString) : UnicodeString;
+begin
+  Result:=GetFileAsString(aFileName, TEncoding.Unicode);
+end;
+
+Function GetFileAsString(Const aFileName : UnicodeString; aEncoding : TEncoding) : UnicodeString;
+begin
+  Result:=aEncoding.GetString(GetFileContents(aFileName))
+end;

rtl/objpas/sysutils/filutilh.inc

@@ -229,3 +229,12 @@ Function FileGetDate (Handle : THandle) : Int64;
 Function FileSetDate (Handle : THandle;Age : Int64) : Longint;
 Function GetFileHandle(var f : File):THandle;
 Function GetFileHandle(var f : Text):THandle;
+
+Function GetFileContents(Const aFileName : RawByteString) : TBytes;
+Function GetFileContents(Const aFileName : UnicodeString) : TBytes;
+Function GetFileContents(Const aHandle : THandle) : TBytes;
+Function GetFileAsString(Const aFileName : RawByteString) : RawByteString;
+Function GetFileAsString(Const aFileName : RawByteString; aEncoding : TEncoding) : RawByteString;
+Function GetFileAsString(Const aFileName : UnicodeString) : UnicodeString;
+Function GetFileAsString(Const aFileName : UnicodeString; aEncoding : TEncoding) : UnicodeString;
+

rtl/unix/bunxovl.inc

@@ -248,10 +248,16 @@ begin
 end;
 {$endif}
 
+const
+  { read/write permission for everyone }
+  MODE_FPOPEN = S_IWUSR OR S_IRUSR OR
+                S_IWGRP OR S_IRGRP OR
+                S_IWOTH OR S_IROTH;
+
 Function  FpOpen    (path : pChar; flags : cInt):cInt; {$ifdef VER2_0}inline;{$endif}
 
 begin
- FpOpen:=FpOpen(path,flags,438);
+ FpOpen:=FpOpen(path,flags,MODE_FPOPEN);
 end;
 
 Function  FpOpen    (const path : RawByteString; flags : cInt):cInt; {$ifdef VER2_0}inline;{$endif}
@@ -259,14 +265,14 @@ var
   SystemPath: RawByteString;
 Begin
   SystemPath:=ToSingleByteFileSystemEncodedFileName(path);
-  FpOpen:=FpOpen(pchar(SystemPath),flags,438);
+  FpOpen:=FpOpen(pchar(SystemPath),flags,MODE_FPOPEN);
 end;
 
 Function  FpOpen    (path : String; flags : cInt):cInt;
 
 begin
  path:=path+#0;
- FpOpen:=FpOpen(@path[1],flags,438);
+ FpOpen:=FpOpen(@path[1],flags,MODE_FPOPEN);
 end;
 
 Function  FpOpen    (path : String; flags : cInt; Mode: TMode):cInt;

tests/webtbs/tw35841.pp

@@ -0,0 +1,18 @@
+{ %norun }
+{$mode objfpc}
+procedure p;
+  begin
+    try
+      writeln
+    except
+      try
+        writeln;
+        Exit;
+      finally
+        writeln;
+      end;
+    end;
+  end;
+
+begin
+end.

utils/pas2js/pas2jslib.pp

@@ -17,7 +17,8 @@ exports
   AddPas2JSDirectoryEntry,
   SetPas2JSUnitAliasCallBack,
   SetPas2JSCompilerLogCallBack,
-  GetPas2JSCompilerLastError;
+  GetPas2JSCompilerLastError,
+  SetPas2JSLogEncoding;
 
 end.