paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-08 10:59:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/unicodekvm@48655 -
This commit is contained in:
nickysn 2021-02-12 01:55:05 +00:00
commit 3799569da0
15 changed files with 552 additions and 375 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -16104,6 +16104,7 @@ tests/test/units/cocoaall/tw36362.pp svneol=native#text/plain
tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
tests/test/units/crt/tcrt.pp svneol=native#text/plain
tests/test/units/crt/tctrlc.pp svneol=native#text/plain
tests/test/units/dateutil/test_scandatetime_ampm.pas svneol=native#text/plain
tests/test/units/dateutil/testscandatetime.pas svneol=native#text/plain
tests/test/units/dateutil/tunitdt1.pp svneol=native#text/pascal
tests/test/units/dos/hello.pp svneol=native#text/plain

1
compiler/arm/aasmcpu.pas
View File

@ -2204,7 +2204,6 @@ implementation
IF_ARMv4,
IF_ARMv4,
IF_ARMv4T or IF_ARMv4,
IF_ARMv4T or IF_ARMv4 or IF_ARMv5,
IF_ARMv4T or IF_ARMv4 or IF_ARMv5 or IF_ARMv5T,
IF_ARMv4T or IF_ARMv4 or IF_ARMv5 or IF_ARMv5T or IF_ARMv5TE,
IF_ARMv4T or IF_ARMv4 or IF_ARMv5 or IF_ARMv5T or IF_ARMv5TE or IF_ARMv5TEJ,

1
compiler/arm/agarmgas.pas
View File

@ -64,7 +64,6 @@ unit agarmgas;
'armv3',
'armv4',
'armv4t',
'armv5',
'armv5t',
'armv5te',
'armv5tej',

13
compiler/arm/cgcpu.pas
View File

@ -294,7 +294,8 @@ unit cgcpu;
rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
[RS_R0,RS_R1,RS_R2,RS_R3,RS_R9,RS_R12,RS_R4,RS_R5,RS_R6,RS_R8,
RS_R10,RS_R11,RS_R14],first_int_imreg,[]);
rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
if FPUARM_HAS_FPA in fpu_capabilities[current_settings.fputype] then
rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
[RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
{ The register allocator currently cannot deal with multiple
non-overlapping subregs per register, so we can only use
@ -306,7 +307,7 @@ unit cgcpu;
RS_D16,RS_D17,RS_D18,RS_D19,RS_D20,RS_D21,RS_D22,RS_D23,RS_D24,RS_D25,RS_D26,RS_D27,RS_D28,RS_D29,RS_D30,RS_D31,
RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15
],first_mm_imreg,[])
else
else if FPUARM_HAS_VFP_EXTENSION in fpu_capabilities[current_settings.fputype] then
rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBFD,
[RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7,RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15],first_mm_imreg,[]);
end;
@ -4329,7 +4330,8 @@ unit cgcpu;
rg[R_INTREGISTER]:=trgintcputhumb2.create(R_INTREGISTER,R_SUBWHOLE,
[RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
RS_R10,RS_R12,RS_R14],first_int_imreg,[]);
rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
if FPUARM_HAS_FPA in fpu_capabilities[current_settings.fputype] then
rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
[RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
if (FPUARM_HAS_32REGS in fpu_capabilities[current_settings.fputype]) and
@ -4349,10 +4351,7 @@ unit cgcpu;
rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBFD,
[RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7,
RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15
],first_mm_imreg,[])
else
rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
[RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]);
],first_mm_imreg,[]);
end;

28
compiler/arm/cpuinfo.pas
View File

@ -40,7 +40,6 @@ Type
cpu_armv3,
cpu_armv4,
cpu_armv4t,
cpu_armv5,
cpu_armv5t,
cpu_armv5te,
cpu_armv5tej,
@ -556,7 +555,6 @@ Const
'ARMV3',
'ARMV4',
'ARMV4T',
'ARMV5',
'ARMV5T',
'ARMV5TE',
'ARMV5TEJ',
@ -1058,7 +1056,8 @@ Const
type
tcpuflags =
(CPUARM_HAS_ALL_MEM, { CPU supports LDRSB/LDRSH/LDRH/STRH instructions }
(CPUARM_HAS_THUMB, { CPU supports THUMB }
CPUARM_HAS_ALL_MEM, { CPU supports LDRSB/LDRSH/LDRH/STRH instructions }
CPUARM_HAS_BX, { CPU supports the BX instruction }
CPUARM_HAS_BLX, { CPU supports the BLX rX instruction }
CPUARM_HAS_BLX_LABEL, { CPU supports the BLX <label> instruction }
@ -1092,22 +1091,21 @@ Const
( { cpu_none } [],
{ cpu_armv3 } [],
{ cpu_armv4 } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_UMULL],
{ cpu_armv4t } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_UMULL],
{ cpu_armv5 } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_CLZ,CPUARM_HAS_UMULL],
{ cpu_armv5t } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_UMULL],
{ cpu_armv5te } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
{ cpu_armv5tej } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
{ cpu_armv4t } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_UMULL],
{ cpu_armv5t } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_UMULL],
{ cpu_armv5te } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
{ cpu_armv5tej } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_UMULL],
{ cpu_armv6 } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
{ cpu_armv6k } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
{ cpu_armv6t2 } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv6z } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
{ cpu_armv6m } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_REV],
{ cpu_armv6t2 } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv6z } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_LDREX,CPUARM_HAS_UMULL],
{ cpu_armv6m } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_REV],
{ the identifier armv7 is should not be used, it is considered being equal to armv7a }
{ cpu_armv7 } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv7a } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv7r } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv7m } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv7em } [CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL]
{ cpu_armv7a } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv7r } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_BLX_LABEL,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv7m } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL],
{ cpu_armv7em } [CPUARM_HAS_THUMB,CPUARM_HAS_ALL_MEM,CPUARM_HAS_BX,CPUARM_HAS_BLX,CPUARM_HAS_CLZ,CPUARM_HAS_EDSP,CPUARM_HAS_REV,CPUARM_HAS_RBIT,CPUARM_HAS_LDREX,CPUARM_HAS_THUMB_IDIV,CPUARM_HAS_DMB,CPUARM_HAS_THUMB2,CPUARM_HAS_UMULL]
);
fpu_capabilities : array[tfputype] of set of tfpuflags =

4
compiler/msg/errore.msg
View File

@ -2582,7 +2582,7 @@ cg_w_interrupt_does_not_save_registers=06062_W_The target CPU does not support p
#
# Assembler reader
#
# 07144 is the last used one
# 07145 is the last used one
#
asmr_d_start_reading=07000_DL_Starting $1 styled assembler parsing
% This informs you that an assembler block is being parsed
@ -2924,6 +2924,8 @@ asmr_w_segment_override_ignored_in_64bit_mode=07141_W_Segment base $1 will be ge
asmr_e_mismatch_broadcasting_elements=07142_E_Mismatch broadcasting elements (expected: {$1} found: {$2})
asmr_e_invalid_arrangement=07143_E_Invalid arrangement specifier "$1"
asmr_e_a64_invalid_regset=07144_E_Registers in a register set must be consecutive.
asmr_e_unknown_field=07145_E_Unknown field identifier
% The internal assembler read cannot find the passed field identifier.
#
# Assembler/binary writers
#

5
compiler/msgidx.inc
View File

@ -858,6 +858,7 @@ const
asmr_e_mismatch_broadcasting_elements=07142;
asmr_e_invalid_arrangement=07143;
asmr_e_a64_invalid_regset=07144;
asmr_e_unknown_field=07145;
asmw_f_too_many_asm_files=08000;
asmw_f_assembler_output_not_supported=08001;
asmw_f_comp_not_supported=08002;
@ -1137,9 +1138,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 87094;
MsgTxtSize = 87127;
MsgIdxMax : array[1..20] of longint=(
28,107,361,131,99,63,145,36,223,68,
28,107,361,131,99,63,146,36,223,68,
63,20,30,1,1,1,1,1,1,1
);

614
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

10
compiler/ncal.pas
View File

@ -1392,6 +1392,16 @@ implementation
else
make_not_regable(left,[ra_addr_regable])
end;
vs_const:
if parasym.vardef.typ=formaldef then
begin
{ compilerprocs never capture the address of their
parameters }
if not(po_compilerproc in aktcallnode.procdefinition.procoptions) then
make_not_regable(left,[ra_addr_regable,ra_addr_taken])
else
make_not_regable(left,[ra_addr_regable])
end;
else
set_varstate(left,vs_read,[vsf_must_be_valid]);
end;

1
compiler/rautils.pas
View File

@ -1645,6 +1645,7 @@ Begin
sym:=search_struct_member(tabstractrecorddef(st.defowner),base);
if not assigned(sym) then
begin
Message(asmr_e_unknown_field);
GetRecordOffsetSize:=false;
exit;
end;

44
packages/fv/examples/testuapp.pas
View File

@ -1,15 +1,57 @@
program testuapp;
{$codepage UTF8}
uses
uapp;
Objects, UDrivers, UViews, UMenus, UApp;
const
cmOrderNew = 200;
cmOrderWin = 201;
cmOrderSave = 202;
cmOrderCancel = 203;
cmOrderNext = 204;
cmOrderPrev = 205;
cmClipShow = 210;
cmAbout = 220;
cmFindOrderWindow = 1002;
cmOptionsVideo = 1502;
cmOptionsSave = 1503;
cmOptionsLoad = 1504;
type
{ TMyUnicodeApp }
TMyUnicodeApp = object(TApplication)
procedure InitStatusLine; virtual;
end;
var
MyUnicodeApp: TMyUnicodeApp;
{ TMyUnicodeApp }
procedure TMyUnicodeApp.InitStatusLine;
var
R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
new(StatusLine, Init(R,
NewStatusDef(0, $EFFF,
NewStatusKey('~F1~ 打开', kbF1, cmHelp,
NewStatusKey('~F3~ Отваряне', kbF3, cmOpen,
NewStatusKey('~F4~ Νέος', kbF4, cmNew,
NewStatusKey('~Alt+F3~ Zavřít', kbAltF3, cmClose,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
nil))))),
NewStatusDef($F000, $FFFF,
NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
NewStatusKey('~Shift+F6~ Pref', kbShiftF6, cmOrderPrev,
nil)),nil))));
end;
begin
MyUnicodeApp.Init;
MyUnicodeApp.Run;

93
packages/rtl-objpas/src/inc/dateutil.inc
View File

@ -2379,6 +2379,8 @@ begin
end;
function scandatetime(const pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime;
const
EPS = 1E-15;
var len ,ind : integer;
yy,mm,dd : integer;
@ -2558,44 +2560,59 @@ begin
end;
end;
'A' : begin
i:=findimatch(AMPMformatting,@ptrn[pind]);
case i of
0: begin
i:=findimatch(['AM','PM'],@s[ind]);
case i of
0: ;
1: timeval:=timeval+12*hrfactor;
else
arraymatcherror
end;
inc(pind,length(AMPMformatting[0]));
inc(ind,2);
end;
1: begin
case upcase(s[ind]) of
'A' : ;
'P' : timeval:=timeval+12*hrfactor;
else
arraymatcherror
end;
inc(pind,length(AMPMformatting[1]));
inc(ind);
end;
2: begin
i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
case i of
0: inc(ind,length(fmt.timeamstring));
1: begin
timeval:=timeval+12*hrfactor;
inc(ind,length(fmt.timepmstring));
end;
else
arraymatcherror
end;
inc(pind,length(AMPMformatting[2]));
end;
else // no AM/PM match. Assume 'a' is simply a char
matchchar(ptrn[pind]);
i:=findimatch(AMPMformatting,@ptrn[pind]);
case i of
0: begin
if timeval >= 13*hrfactor - EPS then
raiseexception(SAMPMError);
i:=findimatch(['AM','PM'],@s[ind]);
case i of
0: if timeval >= 12*hrfactor then
timeval := timeval - 12*hrfactor;
1: if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
timeval:=timeval+12*hrfactor;
else
arraymatcherror
end;
inc(pind,length(AMPMformatting[0]));
inc(ind,2);
end;
1: begin
if timeval >= 13*hrfactor - EPS then
raiseexception(SAMPMError);
case upcase(s[ind]) of
'A' : if timeval >= 12*hrfactor then
timeval := timeval - 12*hrfactor;
'P' : if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
timeval := timeval + 12*hrfactor;
else
arraymatcherror
end;
inc(pind,length(AMPMformatting[1]));
inc(ind);
end;
2: begin
if timeval >= 13*hrfactor - EPS then
raiseexception(SAMPMError);
i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
case i of
0: begin
if timeval >= 12*hrfactor then
timeval := timeval - 12*hrfactor;
inc(ind,length(fmt.timeamstring));
end;
1: begin
if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
timeval:=timeval + 12*hrfactor;
inc(ind,length(fmt.timepmstring));
end;
else
arraymatcherror
end;
inc(pind,length(AMPMformatting[2]));
end;
else // no AM/PM match. Assume 'a' is simply a char
matchchar(ptrn[pind]);
end;
end;
'/' : matchchar(fmt.dateSeparator);

5
rtl/linux/arm/sighnd.inc
View File

@ -23,7 +23,7 @@ end;
{$ifndef CPUTHUMB}
Procedure SignalToHandleErrorAddrFrame_ARM(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
asm
{$if FPC_VERSION >= 30200}
{$if FPC_FULLVERSION >= 30200}
.code 32
{$endif}
// the address is of the faulting instruction, and sigreturn will
@ -57,6 +57,9 @@ asm
mov lr, r0
pop {r0,r1,r2,pc}
.text
{$ifndef CPUTHUMB}
.code 32
{$endif CPUTHUMB}
end;
{$endif}

1
rtl/objpas/sysconst.pp
View File

@ -145,6 +145,7 @@ const
SHHMMError = 'mm in a sequence hh:mm is interpreted as minutes. No longer versions allowed! (Position : %d).' ;
SFullpattern = 'Couldn''t match entire pattern string. Input too short at pattern position %d.';
SPatternCharMismatch = 'Pattern mismatch char "%s" at position %d.';
SAMPMError = 'Hour >= 13 not allowed in AM/PM mode.';
SShortMonthNameJan = 'Jan';
SShortMonthNameFeb = 'Feb';

106
tests/test/units/dateutil/test_scandatetime_ampm.pas Normal file
View File

@ -0,0 +1,106 @@
program test_scandatetime_ampm;
{$mode objfpc}
{$h+}
uses
SysUtils, DateUtils, StrUtils;
Var
ErrCount : Integer;
function SameDateTime(dt1, dt2: TDateTime): Boolean;
const
EPS = 1/(24*60*60*100*10); // 0.1 ms
begin
Result := abs(dt1 - dt2) < EPS;
end;
procedure Test(AExpected: TDateTime; AFormatStr, ADateTimeStr: String; NeedError : Boolean = False);
var
dt: TDateTime;
begin
Write(PadRight(ADateTimeStr, 36), ' ---> ');
Write(PadRight(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', dt), 25));
try
dt := ScanDateTime(AFormatStr, ADateTimeStr);
if dt = AExpected then WriteLn('OK') else
begin
Inc(ErrCount);
WriteLn('ERROR');
end;
except on E:Exception do
begin
if not NeedError then
inc(errcount);
WriteLn('ERROR: ', E.Message);
end;
end;
end;
begin
errCount:=0;
WriteLn('Using current format settings...');
Test(EncodeDateTime(2014, 4, 2, 0, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 am');
Test(EncodeDateTime(2014, 4, 2, 0, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 AM');
Test(EncodeDateTime(2014, 4, 2, 0, 1, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:01 am');
Test(EncodeDateTime(2014, 4, 2, 1, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:00 am');
Test(EncodeDateTime(2014, 4, 2,11, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:00 am');
Test(EncodeDateTime(2014, 4, 2,11,59, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:59 am');
Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 11:59:59.999 am');
Test(EncodeDateTime(2014, 4, 2,12, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 pm');
Test(EncodeDateTime(2014, 4, 2,12, 0, 0, 1), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 12:00:00.001 pm');
Test(EncodeDateTime(2014, 4, 2,13, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:00 pm');
Test(EncodeDateTime(2014, 4, 2,13, 1, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:01 pm');
Test(EncodeDateTime(2014, 4, 2,23, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:00 pm');
Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 11:59:59.999 pm');
WriteLn;
Test(EncodeDateTime(2014, 4, 2, 0, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 a');
Test(EncodeDateTime(2014, 4, 2, 0, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 A');
Test(EncodeDateTime(2014, 4, 2, 0, 1, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:01 a');
Test(EncodeDateTime(2014, 4, 2, 1, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:00 a');
Test(EncodeDateTime(2014, 4, 2,11, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:00 a');
Test(EncodeDateTime(2014, 4, 2,11,59, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:59 a');
Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 11:59:59.999 a');
Test(EncodeDateTime(2014, 4, 2,12, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 p');
Test(EncodeDateTime(2014, 4, 2,12, 0, 0, 1), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 12:00:00.001 p');
Test(EncodeDateTime(2014, 4, 2,13, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:00 p');
Test(EncodeDateTime(2014, 4, 2,13, 1, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:01 p');
Test(EncodeDateTime(2014, 4, 2,23, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:00 p');
Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 11:59:59.999 p');
WriteLn;
FormatSettings.TimeAMString := 'vorm';
FormatSettings.TimePMString := 'nachm';
WriteLn('Using modified format settings with ampm=', FormatSettings.TimeAMString, '/', FormatSettings.TimePMString);
Test(EncodeDateTime(2014, 4, 2, 0, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 vorm');
Test(EncodeDateTime(2014, 4, 2, 0, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 VORM');
Test(EncodeDateTime(2014, 4, 2, 0, 1, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:01 vorm');
Test(EncodeDateTime(2014, 4, 2, 1, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:00 vorm');
Test(EncodeDateTime(2014, 4, 2,11, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:00 vorm');
Test(EncodeDateTime(2014, 4, 2,11,59, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:59 vorm');
Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 11:59:59.999 vorm');
Test(EncodeDateTime(2014, 4, 2,12, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 nachm');
Test(EncodeDateTime(2014, 4, 2,12, 0, 0, 1), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 12:00:00.001 nachm');
Test(EncodeDateTime(2014, 4, 2,13, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:00 nachm');
Test(EncodeDateTime(2014, 4, 2,13, 1, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:01 nachm');
Test(EncodeDateTime(2014, 4, 2,23, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:00 nachm');
Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 11:59:59.999 nachm');
Test(EncodeDateTime(2014, 4, 3,12, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 3rd, 2014, 12:00 nachm');
WriteLn('The next test should raise an exception.');
try
Test(EncodeDateTime(2014, 4, 2,13, 0, 0, 0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 13:00 pm',True);
except on E:Exception do
begin
WriteLn('OK, exception received: ', E.Message);
end;
end;
WriteLn;
WriteLn('Test complete. Press RETURN to exit.');
Halt(Ord(errcount>0));
// ReadLn;
end.