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

* synchronized with trunk

Browse Source 
git-svn-id: branches/wasm@48654 -
This commit is contained in:
nickysn 2021-02-12 01:54:24 +00:00
commit a74024e7d5
30 changed files with 877 additions and 634 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -16106,6 +16106,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
@ -16627,6 +16628,7 @@ tests/webtbf/tw2414.pp svneol=native#text/plain
tests/webtbf/tw24184.pp svneol=native#text/plain
tests/webtbf/tw24428.pp svneol=native#text/plain
tests/webtbf/tw24428a.pp svneol=native#text/plain
tests/webtbf/tw24434.pp svneol=native#text/pascal
tests/webtbf/tw24453.pp svneol=native#text/pascal
tests/webtbf/tw24495.pp svneol=native#text/pascal
tests/webtbf/tw24588.pp svneol=native#text/pascal
@ -16776,6 +16778,7 @@ tests/webtbf/tw3812.pp svneol=native#text/plain
tests/webtbf/tw38287.pp svneol=native#text/pascal
tests/webtbf/tw38289a.pp svneol=native#text/pascal
tests/webtbf/tw38289b.pp svneol=native#text/pascal
tests/webtbf/tw38439.pp svneol=native#text/pascal
tests/webtbf/tw3930a.pp svneol=native#text/plain
tests/webtbf/tw3931b.pp svneol=native#text/plain
tests/webtbf/tw3969.pp svneol=native#text/plain

22
compiler/Makefile
View File

@ -4670,6 +4670,9 @@ ifdef CMP
override DIFF:=$(CMP) -i218
endif
endif
ifeq ($(OS_TARGET), darwin)
CODESIGN?=$(strip $(wildcard $(addsuffix /codesign,$(SEARCHPATH))))
endif
ifneq ($(CYCLELEVEL),1)
ifndef ALLOW_WARNINGS
override LOCALOPT+=-Sew
@ -4974,7 +4977,11 @@ ifdef OLDFPC
ifneq ($(OS_TARGET),darwin)
DIFFRESULT:=$(shell $(DIFF) $(OLDFPC) $(FPC))
else
DIFFRESULT:=$(shell cp $(OLDFPC) $(OLDFPC).tmp; cp $(FPC) $(FPC).tmp; strip -no_uuid $(OLDFPC).tmp; strip -no_uuid $(FPC).tmp; $(DIFF) $(OLDFPC).tmp $(FPC).tmp; rm $(OLDFPC).tmp $(FPC).tmp)
ifneq ($(CODESIGN),)
DIFFRESULT:=$(shell $(COPY) $(OLDFPC) $(OLDFPC).tmp; $(COPY) $(FPC) $(FPC).tmp; strip -no_uuid $(OLDFPC).tmp; strip -no_uuid $(FPC).tmp; $(CODESIGN) --remove-signature $(OLDFPC).tmp; codesign --remove-signature $(FPC).tmp; $(DIFF) $(OLDFPC).tmp $(FPC).tmp; $(RMPROG) $(OLDFPC).tmp $(FPC).tmp)
else
DIFFRESULT:=$(shell $(COPY) $(OLDFPC) $(OLDFPC).tmp; $(COPY) $(FPC) $(FPC).tmp; strip -no_uuid $(OLDFPC).tmp; strip -no_uuid $(FPC).tmp; $(DIFF) $(OLDFPC).tmp $(FPC).tmp; $(RMPROG) $(OLDFPC).tmp $(FPC).tmp)
endif
endif
else
DIFFRESULT=Not equal
@ -5013,7 +5020,20 @@ endif
$(MAKE) tempclean
$(MAKE) $(TEMPNAME3)
$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next CYCLELEVEL=4
ifneq ($(OS_TARGET), darwin)
$(DIFF) $(TEMPNAME3) $(EXENAME)
else
$(COPY) $(TEMPNAME3) $(TEMPNAME3).tmp
$(COPY) $(EXENAME) $(EXENAME).tmp
strip -no_uuid $(TEMPNAME3).tmp
strip -no_uuid $(EXENAME).tmp
ifneq ($(CODESIGN),)
$(CODESIGN) --remove-signature $(TEMPNAME3).tmp
$(CODESIGN) --remove-signature $(EXENAME).tmp
endif
$(DIFF) $(TEMPNAME3).tmp $(EXENAME).tmp
rm $(TEMPNAME3).tmp $(EXENAME).tmp
endif
$(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
$(MAKE) wpocycle
$(MAKE) echotime

23
compiler/Makefile.fpc
View File

@ -446,6 +446,10 @@ override DIFF:=$(CMP) -i218
endif
endif
ifeq ($(OS_TARGET), darwin)
CODESIGN?=$(strip $(wildcard $(addsuffix /codesign,$(SEARCHPATH))))
endif
# Use -Sew option by default
# Allow disabling by setting ALLOW_WARNINGS=1
ifneq ($(CYCLELEVEL),1)
@ -890,7 +894,11 @@ ifdef OLDFPC
ifneq ($(OS_TARGET),darwin)
DIFFRESULT:=$(shell $(DIFF) $(OLDFPC) $(FPC))
else
DIFFRESULT:=$(shell cp $(OLDFPC) $(OLDFPC).tmp; cp $(FPC) $(FPC).tmp; strip -no_uuid $(OLDFPC).tmp; strip -no_uuid $(FPC).tmp; $(DIFF) $(OLDFPC).tmp $(FPC).tmp; rm $(OLDFPC).tmp $(FPC).tmp)
ifneq ($(CODESIGN),)
DIFFRESULT:=$(shell $(COPY) $(OLDFPC) $(OLDFPC).tmp; $(COPY) $(FPC) $(FPC).tmp; strip -no_uuid $(OLDFPC).tmp; strip -no_uuid $(FPC).tmp; $(CODESIGN) --remove-signature $(OLDFPC).tmp; codesign --remove-signature $(FPC).tmp; $(DIFF) $(OLDFPC).tmp $(FPC).tmp; $(RMPROG) $(OLDFPC).tmp $(FPC).tmp)
else
DIFFRESULT:=$(shell $(COPY) $(OLDFPC) $(OLDFPC).tmp; $(COPY) $(FPC) $(FPC).tmp; strip -no_uuid $(OLDFPC).tmp; strip -no_uuid $(FPC).tmp; $(DIFF) $(OLDFPC).tmp $(FPC).tmp; $(RMPROG) $(OLDFPC).tmp $(FPC).tmp)
endif
endif
else
DIFFRESULT=Not equal
@ -934,7 +942,20 @@ endif
$(MAKE) tempclean
$(MAKE) $(TEMPNAME3)
$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3PREFIX)$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next CYCLELEVEL=4
ifneq ($(OS_TARGET), darwin)
$(DIFF) $(TEMPNAME3) $(EXENAME)
else
$(COPY) $(TEMPNAME3) $(TEMPNAME3).tmp
$(COPY) $(EXENAME) $(EXENAME).tmp
strip -no_uuid $(TEMPNAME3).tmp
strip -no_uuid $(EXENAME).tmp
ifneq ($(CODESIGN),)
$(CODESIGN) --remove-signature $(TEMPNAME3).tmp
$(CODESIGN) --remove-signature $(EXENAME).tmp
endif
$(DIFF) $(TEMPNAME3).tmp $(EXENAME).tmp
rm $(TEMPNAME3).tmp $(EXENAME).tmp
endif
$(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
$(MAKE) wpocycle
$(MAKE) echotime

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 =

16
compiler/m68k/ag68kgas.pas
View File

@ -169,7 +169,7 @@ interface
end;
function getopstr(var o:toper) : string;
function getopstr(size: topsize; var o:toper) : string;
var
i : tsuperregister;
begin
@ -220,10 +220,14 @@ interface
getopstr:='#'+tostr(longint(o.val));
top_realconst:
begin
str(o.val_real,getopstr);
if getopstr[1]=' ' then
getopstr[1]:='+';
getopstr:='#0d'+getopstr;
case size of
S_FS:
getopstr:='#0x'+hexstr(longint(single(o.val_real)),sizeof(single)*2);
S_FD:
getopstr:='#0x'+hexstr(BestRealRec(o.val_real).Data,sizeof(bestreal)*2);
else
internalerror(2021020801);
end;
end;
else internalerror(200405021);
end;
@ -337,7 +341,7 @@ interface
sep:=':'
else
sep:=',';
s:=s+sep+getopstr(taicpu(hp).oper[i]^);
s:=s+sep+getopstr(taicpu(hp).opsize,taicpu(hp).oper[i]^);
end;
end;
end;

20
compiler/m68k/cgcpu.pas
View File

@ -1068,15 +1068,17 @@ unit cgcpu;
list.concat(taicpu.op_reg_reg(A_FMOVE, tcgsize2opsize[tosize], reg1, hreg));
list.concat(taicpu.op_reg_reg(A_FMOVE, tcgsize2opsize[tosize], hreg, reg2));
end;
OS_F64:
begin
//list.concat(tai_comment.create(strpnew('a_loadfpu_reg_reg rounding via stack')));
reference_reset_base(href, NR_STACK_POINTER_REG, 0, ctempposinvalid, 0, []);
href.direction:=dir_dec;
list.concat(taicpu.op_reg_ref(A_FMOVE, tcgsize2opsize[tosize], reg1, href));
href.direction:=dir_inc;
list.concat(taicpu.op_ref_reg(A_FMOVE, tcgsize2opsize[tosize], href, reg2));
end;
else
begin
//list.concat(tai_comment.create(strpnew('a_loadfpu_reg_reg rounding via stack')));
reference_reset_base(href, NR_STACK_POINTER_REG, 0, ctempposinvalid, 0, []);
href.direction:=dir_dec;
list.concat(taicpu.op_reg_ref(A_FMOVE, tcgsize2opsize[tosize], reg1, href));
href.direction:=dir_inc;
list.concat(taicpu.op_ref_reg(A_FMOVE, tcgsize2opsize[tosize], href, reg2));
end;
internalerror(2021020802);
end;
end
else
@ -1098,7 +1100,7 @@ unit cgcpu;
fixref(list,href,current_settings.fputype = fpu_coldfire);
list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
if fromsize > tosize then
a_load_reg_reg(list,fromsize,tosize,reg,reg);
a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
end;
procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);

2
compiler/m68k/n68kadd.pas
View File

@ -201,7 +201,7 @@ implementation
hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register);
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,left.location.size,location.size,left.location.register,location.register);
end;
{ emit the actual operation }

6
compiler/m68k/n68kinl.pas
View File

@ -253,7 +253,7 @@ implementation
//current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('second_sqr_real called!: left was cfpuregister!')));
location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
location.loc := LOC_FPUREGISTER;
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register);
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,left.location.size,location.size,left.location.register,location.register);
end;
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FMUL,fpuregopsize,left.location.register,location.register));
end;
@ -333,7 +333,7 @@ implementation
begin
hreg:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register);
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,left.location.size,location.size,left.location.register,location.register);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FINTRZ,fpuregopsize,left.location.register,hreg));
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSUB,fpuregopsize,hreg,location.register));
end;
@ -343,7 +343,7 @@ implementation
location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
href:=left.location.reference;
tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire);
cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmlist,left.location.size,OS_NO,href,location.register);
cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmlist,left.location.size,location.size,href,location.register);
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FINTRZ,fpuregopsize,location.register,hreg));
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSUB,fpuregopsize,hreg,location.register));
end;

7
compiler/msg/errore.msg
View File

@ -2079,6 +2079,9 @@ type_e_generic_const_type_not_allowed=04128_E_Type not allowed for generic const
type_e_cant_read_write_type_in_iso_mode=04129_E_Can't read or write variables of this type in iso mode
% You are trying to \var{read} or \var{write} a variable from or to a
% file of type text, which doesn't support that variable's type in the selected language mode (iso mode).
type_w_array_size_does_not_match_size_of_constant_string=04130_W_The length of the constant string (length is $1) must be equal to the number of array elements ($2 elements)
% ISO Pascal requires that string constants have the same length as the array to which them they are assigned.
%
% \end{description}
#
# Symtable
@ -2579,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
@ -2921,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
#

6
compiler/msgidx.inc
View File

@ -592,6 +592,7 @@ const
type_e_forward_interface_type_does_not_match=04127;
type_e_generic_const_type_not_allowed=04128;
type_e_cant_read_write_type_in_iso_mode=04129;
type_w_array_size_does_not_match_size_of_constant_string=04130;
sym_e_id_not_found=05000;
sym_f_internal_error_in_symtablestack=05001;
sym_e_duplicate_id=05002;
@ -857,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;
@ -1136,9 +1138,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 87048;
MsgTxtSize = 87198;
MsgIdxMax : array[1..20] of longint=(
28,107,361,130,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
);

1085
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;

3
compiler/ncnv.pas
View File

@ -1190,6 +1190,9 @@ implementation
if (left.nodetype = stringconstn) and
(tstringconstnode(left).cst_type=cst_conststring) then
begin
if (m_iso in current_settings.modeswitches) and (arrsize<>tstringconstnode(left).len) and
is_char(tarraydef(resultdef).elementdef) then
Message2(type_w_array_size_does_not_match_size_of_constant_string,tostr(tstringconstnode(left).len),tostr(arrsize));
{ if the array of char is large enough we can use the string
constant directly. This is handled in ncgcnv }
if (arrsize>=tstringconstnode(left).len) and

2
compiler/pmodules.pas
View File

@ -2213,7 +2213,7 @@ type
else
begin
main_procinfo:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable);
main_procinfo.procdef.aliasnames.concat('PASCALMAIN');
//main_procinfo.procdef.aliasnames.concat('PASCALMAIN');
end;
main_procinfo.parse_body;
{ save file pos for debuginfo }

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;

3
compiler/utils/msg2inc.pp
View File

@ -730,6 +730,9 @@ begin
end;
if s[i+k]='_' then
inc(i,k+1);
if number<>'' then
writeln(t,'\index[msgnr]{',number,'}');
writeln(t,'\index[msgtxt]{',escapestring(Copy(s,i,255)),'}');
writeln(t,'\item ['+s1+escapestring(Copy(s,i,255))+'] \hfill \\');
end
else

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);

2
packages/symbolic/src/symbolic.pas
View File

@ -240,7 +240,7 @@ const InfixOperatorName : array[addo..powo] of char= ('+','-','*','/','^');
'LOG10','LOG2','LNXP1','!','ARCTAN2',
'STEP','POWER','HYPOT','LOGN');
LenFunctionNames : array[cosx..lognx] of longint=
(3,3,3,3,3,3,2,3,1,5,6,6,6,4,4,4,7,7,7,5,4,5,1,7,4,5,5,4);
(3,3,3,3,4,3,2,3,1,5,6,6,6,4,4,4,7,7,7,5,4,5,1,7,4,5,5,4);
{$I exprstrs.inc}

9
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
@ -40,7 +40,7 @@ asm
end;
{$endif not CPUTHUMB}
{$if FPC_VERSION >= 30200}
{$if FPC_FULLVERSION >= 30200}
Procedure SignalToHandleErrorAddrFrame_Thumb(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
asm
.thumb_func
@ -57,6 +57,9 @@ asm
mov lr, r0
pop {r0,r1,r2,pc}
.text
{$ifndef CPUTHUMB}
.code 32
{$endif CPUTHUMB}
end;
{$endif}
@ -98,7 +101,7 @@ begin
ucontext^.uc_mcontext.arm_r0:=res;
ucontext^.uc_mcontext.arm_r1:=uContext^.uc_mcontext.arm_pc;
ucontext^.uc_mcontext.arm_r2:=uContext^.uc_mcontext.arm_fp;
{$if FPC_VERSION >= 30200}
{$if FPC_FULLVERSION >= 30200}
{$ifndef CPUTHUMB}
if (ucontext^.uc_mcontext.arm_cpsr and (1 shl 5))=0 then
begin

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';

6
rtl/unix/sysutils.pp
View File

@ -569,7 +569,7 @@ begin
{$ifdef USE_STATX}
{ first try statx }
if (statx(0,pchar(SystemFileName),0,STATX_MTIME or STATX_MODE,Infox)>=0) and not(fpS_ISDIR(Infox.stx_mode)) then
if (statx(AT_FDCWD,pchar(SystemFileName),0,STATX_MTIME or STATX_MODE,Infox)>=0) and not(fpS_ISDIR(Infox.stx_mode)) then
begin
Result:=Infox.stx_mtime.tv_sec;
exit;
@ -1082,10 +1082,12 @@ Var
{$ifdef USE_STATX}
Infox : TStatx;
{$endif USE_STATX}
Char0 : char;
begin
Result:=-1;
{$ifdef USE_STATX}
if statx(Handle,nil,0,STATX_MTIME,Infox)=0 then
Char0:=#0;
if statx(Handle,@Char0,AT_EMPTY_PATH,STATX_MTIME,Infox)=0 then
Result:=Infox.stx_Mtime.tv_sec
else if fpgeterrno=ESysENOSYS then
{$endif USE_STATX}

2
rtl/wasi/si_prc.pp
View File

@ -24,10 +24,12 @@ procedure _start;
implementation
procedure PASCALMAIN; external 'PASCALMAIN';
//procedure main; external 'main';
procedure _start;
begin
PASCALMAIN;
// main;
end;
exports

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.

6
tests/test/units/sysutils/tfile1.pp
View File

@ -39,6 +39,12 @@ BEGIN
do_error(1003);
Close(f);
Assign(f,'datetest.dat');
Reset(f);
if FileGetDate(filerec(f).handle)<>DateTimeToFileDate(dateTime) then
do_error(1004);
Close(f);
if FileExists('datetest.dat') then
begin
Assign(f,'datetest.dat');

8
tests/test/units/sysutils/tfileage.pp
View File

@ -7,4 +7,12 @@ begin
writeln('Compilation time and run time differ too much, SysUtils.FileAge buggy?');
halt(1);
end;
{ test with relative path }
if 3600*24*(now()-FileDateToDateTime(FileAge(ExtractRelativePath(GetCurrentDir+DirectorySeparator,paramstr(0)))))>7200 then
begin
writeln('FileAge returns: ',FileDateToDateTime(FileAge(paramstr(0))));
writeln('Compilation time and run time differ too much, SysUtils.FileAge buggy?');
halt(1);
end;
end.

13
tests/webtbf/tw24434.pp Normal file
View File

@ -0,0 +1,13 @@
{ %fail }
function f(s: string): string;
begin
f := '''' + s + '''';
end;
function f(s: string): integer;
begin
Val(s,f);
end;
begin
end.

13
tests/webtbf/tw38439.pp Normal file
View File

@ -0,0 +1,13 @@
{ %fail }
{ %opt=-Sew }
{$mode iso}
program string1(input, output);
var
c: packed array [1..5] of char;
inline: packed array [1..10] of char;
begin
c := '1234567890';
writeln(c);
inline := '12345';
writeln(inline);
end.