paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 13:39:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: added test for rangecheck currency

Browse Source
This commit is contained in:
mattias 2023-07-12 08:20:16 +02:00
parent ccd445bbd1
commit 9386659286
1 changed files with 47 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
packages/pastojs/tests/tcmodules.pas
View File

@ -940,6 +940,7 @@ type
procedure TestRangeChecks_StringIndex;
procedure TestRangeChecks_TypecastInt;
procedure TestRangeChecks_TypeHelperInt;
procedure TestRangeChecks_AssignCurrency;
// Async/AWait
Procedure TestAsync_Proc;
@ -34809,6 +34810,52 @@ begin
'']));
end;
procedure TTestModule.TestRangeChecks_AssignCurrency;
begin
Scanner.Options:=Scanner.Options+[po_CAssignments];
StartProgram(false);
Add([
'{$R+}',
'var',
' c: currency = 2.34;',
' i: double;',
'procedure DoIt(p: currency);',
'begin',
' c:=i;',
' c+=i;',
' c:=1;',
'end;',
'{$R-}',
'procedure DoSome;',
'begin',
' DoIt(i);',
' c:=i;',
' c:=2;',
'end;',
'begin',
'{$R+}',
'']);
ConvertProgram;
CheckSource('TestRangeChecks_AssignCurrency',
LinesToStr([ // statements
'this.c = 2.34;',
'this.i = 0.0;',
'this.DoIt = function (p) {',
' rtl.rc(p, -922337203685477, 922337203685477);',
' $mod.c = rtl.rc(rtl.trunc($mod.i * 10000), -922337203685477, 922337203685477);',
' rtl.rc($mod.c += rtl.trunc($mod.i * 10000), -922337203685477, 922337203685477);',
' $mod.c = 10000;',
'};',
'this.DoSome = function () {',
' $mod.DoIt($mod.i * 10000);',
' $mod.c = rtl.trunc($mod.i * 10000);',
' $mod.c = 20000;',
'};',
'']),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestModule.TestAsync_Proc;
begin
StartProgram(false);