Ver código fonte

* synchronize with trunk

git-svn-id: branches/unicodekvm@41531 -
nickysn 6 anos atrás
pai
commit
3c91abe123

+ 1 - 1
compiler/hlcg2ll.pas

@@ -1550,7 +1550,7 @@ implementation
 {$else cpu64bitalu}
 {$else cpu64bitalu}
             { use cg64 only for int64, not for 8 byte records; in particular,
             { use cg64 only for int64, not for 8 byte records; in particular,
               filter out records passed in fpu/mm register}
               filter out records passed in fpu/mm register}
-            if (l.size in [OS_64,OS_S64]) and (cgpara.Size in [OS_64,OS_S64]) and (cgpara.location^.loc=LOC_REGISTER) then
+            if (l.size in [OS_64,OS_S64]) and (cgpara.Size in [OS_64,OS_S64]) and (cgpara.location^.loc in [LOC_REGISTER,LOC_REFERENCE]) then
               cg64.a_load64_loc_cgpara(list,l,cgpara)
               cg64.a_load64_loc_cgpara(list,l,cgpara)
             else
             else
 {$endif cpu64bitalu}
 {$endif cpu64bitalu}

+ 2 - 2
packages/fcl-passrc/src/pasresolveeval.pas

@@ -181,7 +181,7 @@ const
   nDerivedXMustExtendASubClassY = 3115;
   nDerivedXMustExtendASubClassY = 3115;
   nDefaultPropertyNotAllowedInHelperForX = 3116;
   nDefaultPropertyNotAllowedInHelperForX = 3116;
   nHelpersCannotBeUsedAsTypes = 3117;
   nHelpersCannotBeUsedAsTypes = 3117;
-  nBitWiseOperationsAre32Bit = 3118;
+  // free 3118
   nImplictConversionUnicodeToAnsi = 3119;
   nImplictConversionUnicodeToAnsi = 3119;
   nWrongTypeXInArrayConstructor = 3120;
   nWrongTypeXInArrayConstructor = 3120;
   nUnknownCustomAttributeX = 3121;
   nUnknownCustomAttributeX = 3121;
@@ -315,7 +315,7 @@ resourcestring
   sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
   sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
   sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
   sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
   sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
   sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
-  sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
+  // was 3118
   sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
   sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
   sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
   sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
   sUnknownCustomAttributeX = 'Unknown custom attribute "%s"';
   sUnknownCustomAttributeX = 'Unknown custom attribute "%s"';

+ 1 - 3
packages/fcl-passrc/src/pscanner.pp

@@ -3271,10 +3271,8 @@ begin
       DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[Identifier]);
       DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[Identifier]);
       exit;
       exit;
       end;
       end;
-    end;
-
-  if Number>=0 then
     SetWarnMsgState(Number,State);
     SetWarnMsgState(Number,State);
+    end;
 end;
 end;
 
 
 procedure TPascalScanner.HandleDefine(Param: String);
 procedure TPascalScanner.HandleDefine(Param: String);

+ 25 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -930,6 +930,7 @@ type
     Procedure TestTypeHelper_Enumerator;
     Procedure TestTypeHelper_Enumerator;
     Procedure TestTypeHelper_String;
     Procedure TestTypeHelper_String;
     Procedure TestTypeHelper_Boolean;
     Procedure TestTypeHelper_Boolean;
+    Procedure TestTypeHelper_Double;
     Procedure TestTypeHelper_Constructor_NewInstance;
     Procedure TestTypeHelper_Constructor_NewInstance;
     Procedure TestTypeHelper_InterfaceFail;
     Procedure TestTypeHelper_InterfaceFail;
 
 
@@ -17488,6 +17489,30 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestTypeHelper_Double;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  Float = type double;',
+  '  THelper = type helper for float',
+  '    const NPI = 3.141592;',
+  '    function ToStr: String;',
+  '  end;',
+  'function THelper.ToStr: String;',
+  'begin',
+  'end;',
+  'var',
+  '  a,b: Float;',
+  '  s: string;',
+  'begin',
+  '  s:=(a * b.NPI).ToStr;',
+  '  s:=(a * float.NPI).ToStr;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestTypeHelper_Constructor_NewInstance;
 procedure TTestResolver.TestTypeHelper_Constructor_NewInstance;
 var
 var
   aMarker: PSrcMarker;
   aMarker: PSrcMarker;

+ 107 - 35
packages/pastojs/src/fppas2js.pp

@@ -520,6 +520,7 @@ const
   nCantCallExtBracketAccessor = 4025;
   nCantCallExtBracketAccessor = 4025;
   nJSNewNotSupported = 4026;
   nJSNewNotSupported = 4026;
   nHelperClassMethodForExtClassMustBeStatic = 4027;
   nHelperClassMethodForExtClassMustBeStatic = 4027;
+  nBitWiseOperationIs32Bit = 4028;
 // resourcestring patterns of messages
 // resourcestring patterns of messages
 resourcestring
 resourcestring
   sPasElementNotSupported = 'Pascal element not supported: %s';
   sPasElementNotSupported = 'Pascal element not supported: %s';
@@ -549,6 +550,7 @@ resourcestring
   sCantCallExtBracketAccessor = 'cannot call external bracket accessor, use a property instead';
   sCantCallExtBracketAccessor = 'cannot call external bracket accessor, use a property instead';
   sJSNewNotSupported = 'Pascal class does not support the "new" constructor';
   sJSNewNotSupported = 'Pascal class does not support the "new" constructor';
   sHelperClassMethodForExtClassMustBeStatic = 'Helper class method for external class must be static';
   sHelperClassMethodForExtClassMustBeStatic = 'Helper class method for external class must be static';
+  sBitWiseOperationIs32Bit = 'Bitwise operation is 32-bit';
 
 
 const
 const
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
@@ -566,6 +568,9 @@ type
     pbifnArray_Static_Clone,
     pbifnArray_Static_Clone,
     pbifnAs,
     pbifnAs,
     pbifnAsExt,
     pbifnAsExt,
+    pbifnBitwiseNativeIntAnd,
+    pbifnBitwiseNativeIntOr,
+    pbifnBitwiseNativeIntXor,
     pbifnCheckMethodCall,
     pbifnCheckMethodCall,
     pbifnCheckVersion,
     pbifnCheckVersion,
     pbifnClassInstanceFree,
     pbifnClassInstanceFree,
@@ -725,6 +730,9 @@ const
     '$clone',
     '$clone',
     'as', // rtl.as
     'as', // rtl.as
     'asExt', // rtl.asExt
     'asExt', // rtl.asExt
+    'and', // pbifnBitwiseNativeIntAnd,
+    'or', // pbifnBitwiseNativeIntOr,
+    'xor', // pbifnBitwiseNativeIntXor,
     'checkMethodCall',
     'checkMethodCall',
     'checkVersion',
     'checkVersion',
     '$destroy',
     '$destroy',
@@ -6678,6 +6686,7 @@ var
   ModeSwitches: TModeSwitches;
   ModeSwitches: TModeSwitches;
   aResolver: TPas2JSResolver;
   aResolver: TPas2JSResolver;
   LeftTypeEl, RightTypeEl: TPasType;
   LeftTypeEl, RightTypeEl: TPasType;
+  OldAccess: TCtxAccess;
 begin
 begin
   Result:=Nil;
   Result:=Nil;
   aResolver:=AContext.Resolver;
   aResolver:=AContext.Resolver;
@@ -6696,14 +6705,8 @@ begin
       end;
       end;
   end;
   end;
 
 
-  if AContext.Access<>caRead then
-    begin
-    {$IFDEF VerbosePas2JS}
-    writeln('TPasToJSConverter.ConvertBinaryExpression OpCode=',El.OpCode,' AContext.Access=',AContext.Access);
-    {$ENDIF}
-    DoError(20170209152633,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El);
-    end;
-
+  OldAccess:=AContext.Access;
+  AContext.Access:=caRead;
   Call:=nil;
   Call:=nil;
   A:=ConvertExpression(El.left,AContext);
   A:=ConvertExpression(El.left,AContext);
   B:=nil;
   B:=nil;
@@ -6812,9 +6815,7 @@ begin
         Result:=Call;
         Result:=Call;
         exit;
         exit;
         end;
         end;
-      eopAnd,
-      eopOr,
-      eopXor:
+      eopAnd:
         begin
         begin
         if aResolver<>nil then
         if aResolver<>nil then
           begin
           begin
@@ -6823,26 +6824,74 @@ begin
           if UseBitwiseOp
           if UseBitwiseOp
               and (LeftResolved.BaseType in [btIntDouble,btUIntDouble])
               and (LeftResolved.BaseType in [btIntDouble,btUIntDouble])
               and (RightResolved.BaseType in [btIntDouble,btUIntDouble]) then
               and (RightResolved.BaseType in [btIntDouble,btUIntDouble]) then
-            aResolver.LogMsg(20190124233439,mtWarning,nBitWiseOperationsAre32Bit,
-              sBitWiseOperationsAre32Bit,[],El);
+            begin
+            Call:=CreateCallExpression(El);
+            Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnBitwiseNativeIntAnd)]);
+            Call.AddArg(A);
+            Call.AddArg(B);
+            Result:=Call;
+            exit;
+            end;
           end
           end
         else
         else
           UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
           UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
             or (GetExpressionValueType(El.right,AContext)=jstNumber);
             or (GetExpressionValueType(El.right,AContext)=jstNumber);
         if UseBitwiseOp then
         if UseBitwiseOp then
-          Case El.OpCode of
-            eopAnd : C:=TJSBitwiseAndExpression;
-            eopOr : C:=TJSBitwiseOrExpression;
-            eopXor : C:=TJSBitwiseXOrExpression;
+          C:=TJSBitwiseAndExpression
+        else
+          C:=TJSLogicalAndExpression;
+        end;
+      eopOr:
+        begin
+        if aResolver<>nil then
+          begin
+          UseBitwiseOp:=((LeftResolved.BaseType in btAllJSInteger)
+                     or (RightResolved.BaseType in btAllJSInteger));
+          if UseBitwiseOp
+              and ((LeftResolved.BaseType in [btIntDouble,btUIntDouble])
+                or (RightResolved.BaseType in [btIntDouble,btUIntDouble])) then
+            begin
+            Call:=CreateCallExpression(El);
+            Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnBitwiseNativeIntOr)]);
+            Call.AddArg(A);
+            Call.AddArg(B);
+            Result:=Call;
+            exit;
+            end;
           end
           end
         else
         else
-          Case El.OpCode of
-            eopAnd : C:=TJSLogicalAndExpression;
-            eopOr : C:=TJSLogicalOrExpression;
-            eopXor : C:=TJSBitwiseXOrExpression;
-          else
-            DoError(20161024191234,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,['logical XOR'],El);
-          end;
+          UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
+            or (GetExpressionValueType(El.right,AContext)=jstNumber);
+        if UseBitwiseOp then
+          C:=TJSBitwiseOrExpression
+        else
+          C:=TJSLogicalOrExpression;
+        end;
+      eopXor:
+        begin
+        if aResolver<>nil then
+          begin
+          UseBitwiseOp:=((LeftResolved.BaseType in btAllJSInteger)
+                     or (RightResolved.BaseType in btAllJSInteger));
+          if UseBitwiseOp
+              and ((LeftResolved.BaseType in [btIntDouble,btUIntDouble])
+                or (RightResolved.BaseType in [btIntDouble,btUIntDouble])) then
+            begin
+            Call:=CreateCallExpression(El);
+            Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnBitwiseNativeIntXor)]);
+            Call.AddArg(A);
+            Call.AddArg(B);
+            Result:=Call;
+            exit;
+            end;
+          end
+        else
+          UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
+            or (GetExpressionValueType(El.right,AContext)=jstNumber);
+        if UseBitwiseOp then
+          C:=TJSBitwiseXOrExpression
+        else
+          C:=TJSBitwiseXOrExpression;
         end;
         end;
       eopPower:
       eopPower:
         begin
         begin
@@ -6851,7 +6900,7 @@ begin
         Call.AddArg(A);
         Call.AddArg(A);
         Call.AddArg(B);
         Call.AddArg(B);
         Result:=Call;
         Result:=Call;
-        end
+        end;
       else
       else
         if C=nil then
         if C=nil then
           DoError(20161024191244,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
           DoError(20161024191244,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
@@ -6863,11 +6912,17 @@ begin
       R.B:=B; B:=nil;
       R.B:=B; B:=nil;
       Result:=R;
       Result:=R;
 
 
-      if El.OpCode=eopDiv then
+      case El.OpCode of
+      eopDiv:
         begin
         begin
         // convert "a div b" to "Math.floor(a/b)"
         // convert "a div b" to "Math.floor(a/b)"
         Result:=CreateMathFloor(El,Result);
         Result:=CreateMathFloor(El,Result);
         end;
         end;
+      eopShl,eopShr:
+        if (aResolver<>nil) and (LeftResolved.BaseType in [btIntDouble,btUIntDouble]) then
+          aResolver.LogMsg(20190228220225,mtWarning,nBitWiseOperationIs32Bit,
+            sBitWiseOperationIs32Bit,[],El);
+      end;
 
 
       if (bsOverflowChecks in AContext.ScannerBoolSwitches) and (aResolver<>nil) then
       if (bsOverflowChecks in AContext.ScannerBoolSwitches) and (aResolver<>nil) then
         case El.OpCode of
         case El.OpCode of
@@ -6882,6 +6937,7 @@ begin
         end;
         end;
       end;
       end;
   finally
   finally
+    AContext.Access:=OldAccess;
     if Result=nil then
     if Result=nil then
       begin
       begin
       A.Free;
       A.Free;
@@ -18140,7 +18196,7 @@ begin
 
 
     // append args
     // append args
     ProcType:=Proc.ProcType;
     ProcType:=Proc.ProcType;
-    if Expr.Parent is TParamsExpr then
+    if (Expr.Parent is TParamsExpr) and (TParamsExpr(Expr.Parent).Value=Expr) then
       ParamsExpr:=TParamsExpr(Expr.Parent)
       ParamsExpr:=TParamsExpr(Expr.Parent)
     else
     else
       ParamsExpr:=nil;
       ParamsExpr:=nil;
@@ -21292,7 +21348,7 @@ begin
         begin
         begin
         // pass set with argDefault  -> create reference   rtl.refSet(right)
         // pass set with argDefault  -> create reference   rtl.refSet(right)
         {$IFDEF VerbosePas2JS}
         {$IFDEF VerbosePas2JS}
-        writeln('TPasToJSConverter.CreateProcedureCallArg create reference of SET variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
+        writeln('TPasToJSConverter.CreateProcCallArg create reference of SET variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
         {$ENDIF}
         {$ENDIF}
         Result:=CreateReferencedSet(El,Result);
         Result:=CreateReferencedSet(El,Result);
         end;
         end;
@@ -21370,7 +21426,7 @@ begin
               begin
               begin
               // pass record with argDefault ->  "TGuid.$clone(RightRecord)"
               // pass record with argDefault ->  "TGuid.$clone(RightRecord)"
               {$IFDEF VerbosePas2JS}
               {$IFDEF VerbosePas2JS}
-              writeln('TPasToJSConverter.CreateProcedureCallArg clone RECORD TGuid variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
+              writeln('TPasToJSConverter.CreateProcCallArg clone RECORD TGuid variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
               {$ENDIF}
               {$ENDIF}
               Result:=CreateRecordCallClone(El,TPasRecordType(ArgTypeEl),Result,AContext);
               Result:=CreateRecordCallClone(El,TPasRecordType(ArgTypeEl),Result,AContext);
               end;
               end;
@@ -21439,7 +21495,7 @@ begin
           begin
           begin
           // pass record with argDefault ->  "RightRecord.$clone(RightRecord)"
           // pass record with argDefault ->  "RightRecord.$clone(RightRecord)"
           {$IFDEF VerbosePas2JS}
           {$IFDEF VerbosePas2JS}
-          writeln('TPasToJSConverter.CreateProcedureCallArg clone RECORD variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
+          writeln('TPasToJSConverter.CreateProcCallArg clone RECORD variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
           {$ENDIF}
           {$ENDIF}
           Result:=CreateRecordCallClone(El,TPasRecordType(ExprTypeEl),Result,AContext);
           Result:=CreateRecordCallClone(El,TPasRecordType(ExprTypeEl),Result,AContext);
           end;
           end;
@@ -21550,6 +21606,7 @@ begin
     ParamContext.Arg:=TargetArg;
     ParamContext.Arg:=TargetArg;
     ParamContext.Expr:=El;
     ParamContext.Expr:=El;
     ParamContext.ResolvedExpr:=ResolvedEl;
     ParamContext.ResolvedExpr:=ResolvedEl;
+    writeln('AAA1 TPasToJSConverter.CreateProcCallArgRef ',GetObjName(El));
     FullGetter:=ConvertExpression(El,ParamContext);
     FullGetter:=ConvertExpression(El,ParamContext);
     // FullGetter is now a full JS expression to retrieve the value.
     // FullGetter is now a full JS expression to retrieve the value.
     if ParamContext.ReusingReference then
     if ParamContext.ReusingReference then
@@ -21563,7 +21620,7 @@ begin
     // ParamContext.Getter is the last part of the FullGetter
     // ParamContext.Getter is the last part of the FullGetter
     // FullSetter is created from FullGetter by replacing the Getter with the Setter
     // FullSetter is created from FullGetter by replacing the Getter with the Setter
     {$IFDEF VerbosePas2JS}
     {$IFDEF VerbosePas2JS}
-    writeln('TPasToJSConverter.CreateProcedureCallArg VAR FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter),' ',GetResolverResultDbg(ResolvedEl));
+    writeln('TPasToJSConverter.CreateProcCallArgRef VAR El=',GetObjName(El),' FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter),' ',GetResolverResultDbg(ResolvedEl));
     {$ENDIF}
     {$ENDIF}
 
 
     // create "{p:path,get:function(){return this.p.Getter},set:function(v){this.p.Setter(v);}}"
     // create "{p:path,get:function(){return this.p.Getter},set:function(v){this.p.Setter(v);}}"
@@ -21707,12 +21764,23 @@ begin
       end
       end
     else
     else
       begin
       begin
-      {$IFDEF VerbosePas2JS}
-      writeln('TPasToJSConverter.CreateProcedureCallArg FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter));
-      {$ENDIF}
-      RaiseNotSupported(El,AContext,20170213230336);
+      // getter is the result of an operation
+
+      // create "p:FullGetter"
+      AddVar(TempRefParamName,FullGetter);
+      FullGetter:=nil;
+
+      // GetExpr  "this.a"
+      GetExpr:=CreatePrimitiveDotExpr('this.'+TempRefParamName,El);
+
+      // SetExpr  "raise EPropReadOnly"
+      SetExpr:=CreateRaisePropReadOnly(El);
       end;
       end;
 
 
+    {$IFDEF VerbosePas2JS}
+    //writeln('TPasToJSConverter.CreateProcCallArgRef GetExpr=',GetObjName(GetExpr),' SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName);
+    {$ENDIF}
+
     if (SetExpr.ClassType=TJSPrimaryExpressionIdent)
     if (SetExpr.ClassType=TJSPrimaryExpressionIdent)
         or (SetExpr.ClassType=TJSDotMemberExpression)
         or (SetExpr.ClassType=TJSDotMemberExpression)
         or (SetExpr.ClassType=TJSBracketMemberExpression) then
         or (SetExpr.ClassType=TJSBracketMemberExpression) then
@@ -21767,6 +21835,10 @@ begin
     else
     else
       RaiseInconsistency(20170213225940,El);
       RaiseInconsistency(20170213225940,El);
 
 
+    {$IFDEF VerbosePas2JS}
+    //writeln('TPasToJSConverter.CreateProcCallArgRef created full SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName);
+    {$ENDIF}
+
     // add   p:GetPathExpr
     // add   p:GetPathExpr
     AddVar(TempRefGetPathName,GetPathExpr);
     AddVar(TempRefGetPathName,GetPathExpr);
 
 

+ 119 - 23
packages/pastojs/tests/tcmodules.pas

@@ -263,7 +263,7 @@ type
     Procedure TestInteger;
     Procedure TestInteger;
     Procedure TestIntegerRange;
     Procedure TestIntegerRange;
     Procedure TestIntegerTypecasts;
     Procedure TestIntegerTypecasts;
-    Procedure TestBitwiseAndNativeIntWarn;
+    Procedure TestBitwiseShlNativeIntWarn;
     Procedure TestCurrency;
     Procedure TestCurrency;
     Procedure TestForBoolDo;
     Procedure TestForBoolDo;
     Procedure TestForIntDo;
     Procedure TestForIntDo;
@@ -676,6 +676,7 @@ type
     Procedure TestTypeHelper_ClassMethod;
     Procedure TestTypeHelper_ClassMethod;
     Procedure TestTypeHelper_Constructor;
     Procedure TestTypeHelper_Constructor;
     Procedure TestTypeHelper_Word;
     Procedure TestTypeHelper_Word;
+    Procedure TestTypeHelper_Double;
     Procedure TestTypeHelper_StringChar;
     Procedure TestTypeHelper_StringChar;
     Procedure TestTypeHelper_Array;
     Procedure TestTypeHelper_Array;
     Procedure TestTypeHelper_EnumType;
     Procedure TestTypeHelper_EnumType;
@@ -3080,24 +3081,36 @@ end;
 procedure TTestModule.TestBitwiseOperators;
 procedure TTestModule.TestBitwiseOperators;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
-  Add('var');
-  Add('  vA,vB,vC:longint;');
-  Add('begin');
-  Add('  va:=vb and vc;');
-  Add('  va:=vb or vc;');
-  Add('  va:=vb xor vc;');
-  Add('  va:=vb shl vc;');
-  Add('  va:=vb shr vc;');
-  Add('  va:=3 and vc;');
-  Add('  va:=(vb and vc) or (va and vb);');
-  Add('  va:=not vb;');
+  Add([
+  'var',
+  '  vA,vB,vC:longint;',
+  '  X,Y,Z: nativeint;',
+  'begin',
+  '  va:=vb and vc;',
+  '  va:=vb or vc;',
+  '  va:=vb xor vc;',
+  '  va:=vb shl vc;',
+  '  va:=vb shr vc;',
+  '  va:=3 and vc;',
+  '  va:=(vb and vc) or (va and vb);',
+  '  va:=not vb;',
+  '  X:=Y and Z;',
+  '  X:=Y and va;',
+  '  X:=Y or Z;',
+  '  X:=Y or va;',
+  '  X:=Y xor Z;',
+  '  X:=Y xor va;',
+  '']);
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestBitwiseOperators',
   CheckSource('TestBitwiseOperators',
     LinesToStr([ // statements
     LinesToStr([ // statements
     'this.vA = 0;',
     'this.vA = 0;',
     'this.vB = 0;',
     'this.vB = 0;',
-    'this.vC = 0;'
-    ]),
+    'this.vC = 0;',
+    'this.X = 0;',
+    'this.Y = 0;',
+    'this.Z = 0;',
+    '']),
     LinesToStr([ // this.$main
     LinesToStr([ // this.$main
     '$mod.vA = $mod.vB & $mod.vC;',
     '$mod.vA = $mod.vB & $mod.vC;',
     '$mod.vA = $mod.vB | $mod.vC;',
     '$mod.vA = $mod.vB | $mod.vC;',
@@ -3106,8 +3119,14 @@ begin
     '$mod.vA = $mod.vB >>> $mod.vC;',
     '$mod.vA = $mod.vB >>> $mod.vC;',
     '$mod.vA = 3 & $mod.vC;',
     '$mod.vA = 3 & $mod.vC;',
     '$mod.vA = ($mod.vB & $mod.vC) | ($mod.vA & $mod.vB);',
     '$mod.vA = ($mod.vB & $mod.vC) | ($mod.vA & $mod.vB);',
-    '$mod.vA = ~$mod.vB;'
-    ]));
+    '$mod.vA = ~$mod.vB;',
+    '$mod.X = rtl.and($mod.Y, $mod.Z);',
+    '$mod.X = $mod.Y & $mod.vA;',
+    '$mod.X = rtl.or($mod.Y, $mod.Z);',
+    '$mod.X = rtl.or($mod.Y, $mod.vA);',
+    '$mod.X = rtl.xor($mod.Y, $mod.Z);',
+    '$mod.X = rtl.xor($mod.Y, $mod.vA);',
+    '']));
 end;
 end;
 
 
 procedure TTestModule.TestPrgProcVar;
 procedure TTestModule.TestPrgProcVar;
@@ -6414,25 +6433,24 @@ begin
     '']));
     '']));
 end;
 end;
 
 
-procedure TTestModule.TestBitwiseAndNativeIntWarn;
+procedure TTestModule.TestBitwiseShlNativeIntWarn;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
   'var',
   'var',
-  '  i,j: nativeint;',
+  '  i: nativeint;',
   'begin',
   'begin',
-  '  i:=i and j;',
+  '  i:=i shl 3;',
   '']);
   '']);
   ConvertProgram;
   ConvertProgram;
-  CheckSource('TestBitwiseAndNativeIntWarn',
+  CheckSource('TestBitwiseShlNativeIntWarn',
     LinesToStr([
     LinesToStr([
     'this.i = 0;',
     'this.i = 0;',
-    'this.j = 0;',
     '']),
     '']),
     LinesToStr([
     LinesToStr([
-    '$mod.i = $mod.i & $mod.j;',
+    '$mod.i = $mod.i << 3;',
     '']));
     '']));
-  CheckHint(mtWarning,nBitWiseOperationsAre32Bit,sBitWiseOperationsAre32Bit);
+  CheckHint(mtWarning,nBitWiseOperationIs32Bit,sBitWiseOperationIs32Bit);
 end;
 end;
 
 
 procedure TTestModule.TestCurrency;
 procedure TTestModule.TestCurrency;
@@ -22876,6 +22894,84 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestTypeHelper_Double;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  Float = type double;',
+  '  THelper = type helper for double',
+  '    const NPI = 3.141592;',
+  '    function ToStr: String;',
+  '  end;',
+  'function THelper.ToStr: String;',
+  'begin',
+  'end;',
+  'procedure DoIt(s: string);',
+  'begin',
+  'end;',
+  'var f: Float;',
+  'begin',
+  '  DoIt(f.toStr);',
+  '  DoIt(f.toStr());',
+  '  (f*f).toStr;',
+  '  DoIt((f*f).toStr);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_Double',
+    LinesToStr([ // statements
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.NPI = 3.141592;',
+    '  this.ToStr = function () {',
+    '    var Result = "";',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.DoIt = function (s) {',
+    '};',
+    'this.f = 0.0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.THelper.ToStr.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.f;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.f = v;',
+    '    }',
+    '}));',
+    '$mod.DoIt($mod.THelper.ToStr.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.f;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.f = v;',
+    '    }',
+    '}));',
+    '$mod.THelper.ToStr.call({',
+    '  a: $mod.f * $mod.f,',
+    '  get: function () {',
+    '      return this.a;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.raiseE("EPropReadOnly");',
+    '    }',
+    '});',
+    '$mod.DoIt($mod.THelper.ToStr.call({',
+    '  a: $mod.f * $mod.f,',
+    '  get: function () {',
+    '      return this.a;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.raiseE("EPropReadOnly");',
+    '    }',
+    '}));',
+    '']));
+end;
+
 procedure TTestModule.TestTypeHelper_StringChar;
 procedure TTestModule.TestTypeHelper_StringChar;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

+ 24 - 0
utils/pas2js/dist/rtl.js

@@ -1065,6 +1065,30 @@ var rtl = {
     return 0;
     return 0;
   },
   },
 
 
+  and: function(a,b){
+    var hi = 0x80000000;
+    var low = 0x7fffffff;
+    var h = (a / hi) & (b / hi);
+    var l = (a & low) & (b & low);
+    return h*hi + l;
+  },
+
+  or: function(a,b){
+    var hi = 0x80000000;
+    var low = 0x7fffffff;
+    var h = (a / hi) | (b / hi);
+    var l = (a & low) | (b & low);
+    return h*hi + l;
+  },
+
+  xor: function(a,b){
+    var hi = 0x80000000;
+    var low = 0x7fffffff;
+    var h = (a / hi) ^ (b / hi);
+    var l = (a & low) ^ (b & low);
+    return h*hi + l;
+  },
+
   initRTTI: function(){
   initRTTI: function(){
     if (rtl.debug_rtti) rtl.debug('initRTTI');
     if (rtl.debug_rtti) rtl.debug('initRTTI');