diff --git a/compiler/aoptobj.pas b/compiler/aoptobj.pas index 8b10fd0091..f1058e4d07 100644 --- a/compiler/aoptobj.pas +++ b/compiler/aoptobj.pas @@ -1400,6 +1400,8 @@ Unit AoptObj; reg:=newreg(R_FPUREGISTER,getsupreg(reg),R_SUBWHOLE); R_ADDRESSREGISTER: reg:=newreg(R_ADDRESSREGISTER,getsupreg(reg),R_SUBWHOLE); + R_SPECIALREGISTER: + reg:=newreg(R_SPECIALREGISTER,getsupreg(reg),R_SUBWHOLE); else Internalerror(2018030701); end; diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index c61b7d603e..360cf1aff1 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -360,8 +360,8 @@ implementation { Generate temp procdefs to search for matching read/write procedures. the readprocdef will store all definitions } paranr:=0; - readprocdef:=cprocdef.create(normal_function_level,true); - writeprocdef:=cprocdef.create(normal_function_level,true); + readprocdef:=cprocdef.create(normal_function_level,false); + writeprocdef:=cprocdef.create(normal_function_level,false); readprocdef.struct:=astruct; writeprocdef.struct:=astruct; @@ -857,11 +857,14 @@ implementation message1(parser_e_implements_uses_non_implemented_interface,def.typename); until not try_to_consume(_COMMA); - { remove unneeded procdefs } - if readprocdef.proctypeoption<>potype_propgetter then - readprocdef.owner.deletedef(readprocdef); - if writeprocdef.proctypeoption<>potype_propsetter then - writeprocdef.owner.deletedef(writeprocdef); + { register propgetter and propsetter procdefs } + if assigned(current_module) and current_module.in_interface then + begin + if readprocdef.proctypeoption=potype_propgetter then + readprocdef.register_def; + if writeprocdef.proctypeoption=potype_propsetter then + writeprocdef.register_def; + end; result:=p; end; diff --git a/compiler/riscv/aoptcpurv.pas b/compiler/riscv/aoptcpurv.pas index d044f29293..8d78baea66 100644 --- a/compiler/riscv/aoptcpurv.pas +++ b/compiler/riscv/aoptcpurv.pas @@ -47,6 +47,7 @@ type procedure DebugMsg(const s: string; p: tai); function PeepHoleOptPass1Cpu(var p: tai): boolean; override; + function OptPass1OP(var p: tai): boolean; end; implementation @@ -175,6 +176,40 @@ implementation end; + function TRVCpuAsmOptimizer.OptPass1OP(var p : tai) : boolean; + var + hp1 : tai; + begin + result:=false; + { replace + %reg3,%mreg2,%mreg1 + addi %reg4,%reg3,0 + dealloc %reg3 + + by + %reg4,%reg2,%reg1 + ? + } + if GetNextInstruction(p,hp1) and + { we mix single and double operations here because we assume that the compiler + generates vmovapd only after double operations and vmovaps only after single operations } + MatchInstruction(hp1,A_ADDI) and + (taicpu(hp1).oper[2]^.val=0) and + MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[1]^) then + begin + TransferUsedRegs(TmpUsedRegs); + UpdateUsedRegs(TmpUsedRegs, tai(p.next)); + if not(RegUsedAfterInstruction(taicpu(hp1).oper[1]^.reg,hp1,TmpUsedRegs)) then + begin + taicpu(p).loadoper(0,taicpu(hp1).oper[0]^); + DebugMsg('Peephole OpAddi02Op done',p); + RemoveInstruction(hp1); + result:=true; + end; + end; + end; + + function TRVCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean; procedure RemoveInstr(var orig: tai; moveback: boolean = true); @@ -440,6 +475,9 @@ implementation result:=true; end; end; + A_SRLI, + A_SLLI: + result:=OptPass1OP(p); A_SLTI: begin { diff --git a/compiler/wasm32/hlcgcpu.pas b/compiler/wasm32/hlcgcpu.pas index c3fe60082b..808bbe5d2b 100644 --- a/compiler/wasm32/hlcgcpu.pas +++ b/compiler/wasm32/hlcgcpu.pas @@ -102,6 +102,8 @@ uses procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override; procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override; + procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); override; + procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override; procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override; @@ -1471,6 +1473,222 @@ implementation list.concat(taicpu.op_none(a_end_function)); end; + procedure thlcgwasm.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef); + var +{$if defined(cpuhighleveltarget)} + aintmax: tcgint; +{$elseif defined(cpu64bitalu) or defined(cpu32bitalu)} + aintmax: aint; +{$else} + aintmax: longint; +{$endif} + //neglabel : tasmlabel; + //hreg : tregister; + lto,hto, + lfrom,hfrom : TConstExprInt; + fromsize, tosize: cardinal; + maxdef: tdef; + from_signed, to_signed: boolean; + begin + { range checking on and range checkable value? } + if not(cs_check_range in current_settings.localswitches) or + not(fromdef.typ in [orddef,enumdef]) or + { C-style booleans can't really fail range checks, } + { all values are always valid } + is_cbool(todef) then + exit; +{$if not defined(cpuhighleveltarget) and not defined(cpu64bitalu)} + { handle 64bit rangechecks separate for 32bit processors } + if is_64bit(fromdef) or is_64bit(todef) then + begin + cg64.g_rangecheck64(list,l,fromdef,todef); + exit; + end; +{$endif ndef cpuhighleveltarget and ndef cpu64bitalu} + { only check when assigning to scalar, subranges are different, } + { when todef=fromdef then the check is always generated } + getrange(fromdef,lfrom,hfrom); + getrange(todef,lto,hto); + from_signed := is_signed(fromdef); + to_signed := is_signed(todef); + { check the rangedef of the array, not the array itself } + { (only change now, since getrange needs the arraydef) } + if (todef.typ = arraydef) then + todef := tarraydef(todef).rangedef; + { no range check if from and to are equal and are both longint/dword } + { (if we have a 32bit processor) or int64/qword, since such } + { operations can at most cause overflows (JM) } + { Note that these checks are mostly processor independent, they only } + { have to be changed once we introduce 64bit subrange types } +{$if defined(cpuhighleveltarget) or defined(cpu64bitalu)} + if (fromdef=todef) and + (fromdef.typ=orddef) and + (((((torddef(fromdef).ordtype=s64bit) and + (lfrom = low(int64)) and + (hfrom = high(int64))) or + ((torddef(fromdef).ordtype=u64bit) and + (lfrom = low(qword)) and + (hfrom = high(qword))) or + ((torddef(fromdef).ordtype=scurrency) and + (lfrom = low(int64)) and + (hfrom = high(int64)))))) then + exit; +{$endif cpuhighleveltarget or cpu64bitalu} + { 32 bit operations are automatically widened to 64 bit on 64 bit addr + targets } +{$ifdef cpu32bitaddr} + if (fromdef = todef) and + (fromdef.typ=orddef) and + (((((torddef(fromdef).ordtype = s32bit) and + (lfrom = int64(low(longint))) and + (hfrom = int64(high(longint)))) or + ((torddef(fromdef).ordtype = u32bit) and + (lfrom = low(cardinal)) and + (hfrom = high(cardinal)))))) then + exit; +{$endif cpu32bitaddr} + + { optimize some range checks away in safe cases } + fromsize := fromdef.size; + tosize := todef.size; + if ((from_signed = to_signed) or + (not from_signed)) and + (lto<=lfrom) and (hto>=hfrom) and + (fromsize <= tosize) then + begin + { if fromsize < tosize, and both have the same signed-ness or } + { fromdef is unsigned, then all bit patterns from fromdef are } + { valid for todef as well } + if (fromsize < tosize) then + exit; + if (fromsize = tosize) and + (from_signed = to_signed) then + { only optimize away if all bit patterns which fit in fromsize } + { are valid for the todef } + begin +{$ifopt Q+} +{$define overflowon} +{$Q-} +{$endif} +{$ifopt R+} +{$define rangeon} +{$R-} +{$endif} + if to_signed then + begin + { calculation of the low/high ranges must not overflow 64 bit + otherwise we end up comparing with zero for 64 bit data types on + 64 bit processors } + if (lto = (int64(-1) << (tosize * 8 - 1))) and + (hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then + exit + end + else + begin + { calculation of the low/high ranges must not overflow 64 bit + otherwise we end up having all zeros for 64 bit data types on + 64 bit processors } + if (lto = 0) and + (qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then + exit + end; +{$ifdef overflowon} +{$Q+} +{$undef overflowon} +{$endif} +{$ifdef rangeon} +{$R+} +{$undef rangeon} +{$endif} + end + end; + + { depending on the types involved, we perform the range check for 64 or + for 32 bit } + if fromsize=8 then + maxdef:=fromdef + else + maxdef:=todef; +{$if sizeof(aintmax) = 8} + if maxdef.size=8 then + aintmax:=high(int64) + else +{$endif} + begin + aintmax:=high(longint); + maxdef:=u32inttype; + end; + + { generate the rangecheck code for the def where we are going to } + { store the result } + + { use the trick that } + { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) } + + { To be able to do that, we have to make sure however that either } + { fromdef and todef are both signed or unsigned, or that we leave } + { the parts < 0 and > maxlongint out } + + if from_signed xor to_signed then + begin + if from_signed then + { from is signed, to is unsigned } + begin + { if high(from) < 0 -> always range error } + if (hfrom < 0) or + { if low(to) > maxlongint also range error } + (lto > aintmax) then + begin + g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp; + exit + end; + { from is signed and to is unsigned -> when looking at to } + { as an signed value, it must be < maxaint (otherwise } + { it will become negative, which is invalid since "to" is unsigned) } + if hto > aintmax then + hto := aintmax; + end + else + { from is unsigned, to is signed } + begin + if (lfrom > aintmax) or + (hto < 0) then + begin + g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp; + exit + end; + { from is unsigned and to is signed -> when looking at to } + { as an unsigned value, it must be >= 0 (since negative } + { values are the same as values > maxlongint) } + if lto < 0 then + lto := 0; + end; + end; + a_load_loc_stack(list,fromdef,l); + resize_stack_int_val(list,fromdef,maxdef,false); + a_load_const_stack(list,maxdef,tcgint(int64(lto)),R_INTREGISTER); + a_op_stack(list,OP_SUB,maxdef); + { + if from_signed then + a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel) + else + } + if qword(hto-lto)>qword(aintmax) then + a_load_const_stack(list,maxdef,aintmax,R_INTREGISTER) + else + a_load_const_stack(list,maxdef,tcgint(int64(hto-lto)),R_INTREGISTER); + a_cmp_stack_stack(list,maxdef,OC_A); + + current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if)); + thlcgwasm(hlcg).incblock; + thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1); + + g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp; + + current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if)); + thlcgwasm(hlcg).decblock; + end; + procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); begin { not possible, need the original operands } diff --git a/compiler/x86/aoptx86.pas b/compiler/x86/aoptx86.pas index 6eeb6b7e6a..44e2363b91 100644 --- a/compiler/x86/aoptx86.pas +++ b/compiler/x86/aoptx86.pas @@ -5867,7 +5867,7 @@ unit aoptx86; var hp1,hp2: tai; {$ifndef i8086} - hp3,hp4,hpmov2: tai; + hp3,hp4,hpmov2, hp5: tai; l : Longint; condition : TAsmCond; {$endif i8086} @@ -6084,6 +6084,76 @@ unit aoptx86; end; {$ifndef i8086} end + { + convert + j .L1 + mov 1,reg + jmp .L2 + .L1 + mov 0,reg + .L2 + + into + mov 0,reg + set reg + + take care of alignment and that the mov 0,reg is not converted into a xor as this + would destroy the flag contents + } + else if MatchInstruction(hp1,A_MOV,[]) and + MatchOpType(taicpu(hp1),top_const,top_reg) and +{$ifdef i386} + ( + { Under i386, ESI, EDI, EBP and ESP + don't have an 8-bit representation } + not (getsupreg(taicpu(hp1).oper[1]^.reg) in [RS_ESI, RS_EDI, RS_EBP, RS_ESP]) + ) and +{$endif i386} + (taicpu(hp1).oper[0]^.val=1) and + GetNextInstruction(hp1,hp2) and + MatchInstruction(hp2,A_JMP,[]) and (taicpu(hp2).oper[0]^.ref^.refaddr=addr_full) and + GetNextInstruction(hp2,hp3) and + { skip align } + ((hp3.typ<>ait_align) or GetNextInstruction(hp3,hp3)) and + (hp3.typ=ait_label) and + (tasmlabel(taicpu(p).oper[0]^.ref^.symbol)=tai_label(hp3).labsym) and + (tai_label(hp3).labsym.getrefs=1) and + GetNextInstruction(hp3,hp4) and + MatchInstruction(hp4,A_MOV,[]) and + MatchOpType(taicpu(hp4),top_const,top_reg) and + (taicpu(hp4).oper[0]^.val=0) and + MatchOperand(taicpu(hp1).oper[1]^,taicpu(hp4).oper[1]^) and + GetNextInstruction(hp4,hp5) and + (hp5.typ=ait_label) and + (tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol)=tai_label(hp5).labsym) and + (tai_label(hp5).labsym.getrefs=1) then + begin + AllocRegBetween(NR_FLAGS,p,hp4,UsedRegs); + DebugMsg(SPeepholeOptimization+'JccMovJmpMov2MovSetcc',p); + { remove last label } + RemoveInstruction(hp5); + { remove second albel } + RemoveInstruction(hp3); + { if align is present remove it } + if GetNextInstruction(hp2,hp3) and (hp3.typ=ait_align) then + RemoveInstruction(hp3); + { remove jmp } + RemoveInstruction(hp2); + if taicpu(hp1).opsize=S_B then + RemoveInstruction(hp1) + else + taicpu(hp1).loadconst(0,0); + taicpu(hp4).opcode:=A_SETcc; + taicpu(hp4).opsize:=S_B; + taicpu(hp4).condition:=inverse_cond(taicpu(p).condition); + taicpu(hp4).loadreg(0,newreg(R_INTREGISTER,getsupreg(taicpu(hp4).oper[1]^.reg),R_SUBL)); + taicpu(hp4).opercnt:=1; + taicpu(hp4).ops:=1; + taicpu(hp4).freeop(1); + RemoveCurrentP(p); + Result:=true; + exit; + end else if CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype] then begin { check for diff --git a/packages/amunits/src/coreunits/exec.pas b/packages/amunits/src/coreunits/exec.pas index a4a28ec93e..433c3d07e2 100644 --- a/packages/amunits/src/coreunits/exec.pas +++ b/packages/amunits/src/coreunits/exec.pas @@ -1173,7 +1173,8 @@ CONST PAVLKEYCOMP = ^AVLKEYCOMP; AVLKEYCOMP = APTR; - +var + ExecBase: PExecBase absolute _ExecBase; PROCEDURE AbortIO(ioRequest : pIORequest location 'a1'); syscall _ExecBase 480; PROCEDURE AddDevice(device : pDevice location 'a1'); syscall _ExecBase 432; diff --git a/packages/arosunits/src/exec.pas b/packages/arosunits/src/exec.pas index 94d21574c8..e271fba0ac 100644 --- a/packages/arosunits/src/exec.pas +++ b/packages/arosunits/src/exec.pas @@ -1213,6 +1213,9 @@ const RAWFMTFUNC_SERIAL = 1; // Output to debug log (usually serial port) RAWFMTFUNC_COUNT = 2; // Just count characters, PutChData is a pointer to the counter (ULONG *) +var + ExecBase: PExecBase absolute AOS_ExecBase; + // function headers function Supervisor(UserFunction: TProcedure): ULONG; syscall AOS_ExecBase 5; procedure Reschedule(Task: PTask); syscall AOS_ExecBase 8; diff --git a/packages/fcl-json/src/jsonscanner.pp b/packages/fcl-json/src/jsonscanner.pp index fc47237d02..f466d92b48 100644 --- a/packages/fcl-json/src/jsonscanner.pp +++ b/packages/fcl-json/src/jsonscanner.pp @@ -147,7 +147,7 @@ constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions); Header : array[0..3] of byte; begin OldPos := Source.Position; - FillChar(Header, SizeOf(Header), 0); + FillChar(Header{%H-}, SizeOf(Header), 0); if Source.Read(Header, 3) = 3 then if (Header[0]=$EF) and (Header[1]=$BB) and (Header[2]=$BF) then exit; diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 5c2b99c479..4ab775a5a3 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -5487,7 +5487,9 @@ begin if (Proc.Visibility=visStrictPrivate) or ((Proc.Visibility=visPrivate) and (Proc.GetModule<>Data^.Proc.GetModule)) then - // a private private is hidden by definition -> no hint + // a private method is hidden by definition -> no hint + else if (Proc.Visibility=visPublished) then + // a published can hide (used for overloading rtti) -> no hint else if (ProcScope.ImplProc<>nil) // not abstract, external and (not ProcHasImplElements(ProcScope.ImplProc)) then // hidden method has implementation, but no statements -> useless diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp index fdecc9e0af..9449c0ddea 100644 --- a/packages/fcl-web/src/base/fphttpclient.pp +++ b/packages/fcl-web/src/base/fphttpclient.pp @@ -231,6 +231,17 @@ Type Class Procedure SimpleDelete(const URL: string; Response : TStrings); Class Procedure SimpleDelete(const URL: string; const LocalFileName: String); Class function SimpleDelete(const URL: string) : RawByteString; + // Simple Patch + // Put URL, and Requestbody. Return response in Stream, File, TstringList or String; + Procedure Patch(const URL: string; const Response: TStream); + Procedure Patch(const URL: string; Response : TStrings); + Procedure Patch(const URL: string; const LocalFileName: String); + function Patch(const URL: string) : RawByteString; + // Simple class methods. + Class Procedure SimplePatch(const URL: string; const Response: TStream); + Class Procedure SimplePatch(const URL: string; Response : TStrings); + Class Procedure SimplePatch(const URL: string; const LocalFileName: String); + Class function SimplePatch(const URL: string) : RawByteString; // Simple Options // Options from URL, and Requestbody. Return response in Stream, File, TstringList or String; Procedure Options(const URL: string; const Response: TStream); @@ -1846,6 +1857,103 @@ begin end; end; + + + + +procedure TFPCustomHTTPClient.Patch(const URL: string; const Response: TStream); +begin + HTTPMethod('PATCH',URL,Response,[]); +end; + +procedure TFPCustomHTTPClient.Patch(const URL: string; Response: TStrings); +begin + Response.Text:=Patch(URL); +end; + +procedure TFPCustomHTTPClient.Patch(const URL: string; const LocalFileName: String + ); + +Var + F : TFileStream; + +begin + F:=TFileStream.Create(LocalFileName,fmCreate); + try + Patch(URL,F); + finally + F.Free; + end; +end; + +function TFPCustomHTTPClient.Patch(const URL: string): RawByteString; +Var + SS : TRawByteStringStream; +begin + SS:=TRawByteStringStream.Create(); + try + Patch(URL,SS); + Result:=SS.Datastring; + finally + SS.Free; + end; +end; + +class procedure TFPCustomHTTPClient.SimplePatch(const URL: string; + const Response: TStream); + +begin + With Self.Create(nil) do + try + KeepConnection := False; + Patch(URL,Response); + finally + Free; + end; +end; + +class procedure TFPCustomHTTPClient.SimplePatch(const URL: string; + Response: TStrings); + +begin + With Self.Create(nil) do + try + KeepConnection := False; + Patch(URL,Response); + finally + Free; + end; +end; + +class procedure TFPCustomHTTPClient.SimplePatch(const URL: string; + const LocalFileName: String); + +begin + With Self.Create(nil) do + try + KeepConnection := False; + Patch(URL,LocalFileName); + finally + Free; + end; +end; + +class function TFPCustomHTTPClient.SimplePatch(const URL: string): RawByteString; + +begin + With Self.Create(nil) do + try + KeepConnection := False; + Result:=Patch(URL); + finally + Free; + end; +end; + + + + + procedure TFPCustomHTTPClient.Options(const URL: string; const Response: TStream ); begin diff --git a/packages/morphunits/src/exec.pas b/packages/morphunits/src/exec.pas index b582709190..ad3e04470b 100644 --- a/packages/morphunits/src/exec.pas +++ b/packages/morphunits/src/exec.pas @@ -20,10 +20,6 @@ unit exec; interface -var - ExecBase: Pointer; - - { Some types for classic Amiga and AROS compatibility } type STRPTR = PChar; @@ -1760,6 +1756,9 @@ const TLSTAG_DESTRUCTOR = TLSTAG_DUMMY + $0; // Destructor function to call on task termination if the TLS value is non-nil. The function is called with as: procedure(value: APTR; userdata: APTR); TLSTAG_USERDATA = TLSTAG_DUMMY + $1; // Userdata for the destructor function. Defaults to nil. +var + ExecBase: PExecBase absolute MOS_ExecBase; + function Supervisor(userFunction: Pointer location 'a5'): Cardinal; SysCall MOS_ExecBase 030; diff --git a/packages/os4units/src/exec.pas b/packages/os4units/src/exec.pas index db73811374..ade506a82c 100644 --- a/packages/os4units/src/exec.pas +++ b/packages/os4units/src/exec.pas @@ -1736,6 +1736,9 @@ const //********************************************************************** +var + ExecBase: PExecBase absolute AOS_ExecBase; + function ExecObtain(): LongWord; syscall IExec 60; function ExecRelease(): LongWord; syscall IExec 64; procedure ExecExpunge(); syscall IExec 68; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 21498b9f86..23e3f9c08a 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -15586,6 +15586,7 @@ begin else if El.IsExternal then exit(ConvertExtClassType(El,AContext)); + IsTObject:=false; if El.CustomData is TPas2JSClassScope then begin Scope:=TPas2JSClassScope(El.CustomData); diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 8731d86b8f..0522c4d144 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -816,6 +816,7 @@ type Procedure TestRTTI_DynArray; Procedure TestRTTI_ArrayNestedAnonymous; Procedure TestRTTI_PublishedMethodOverloadFail; + Procedure TestRTTI_PublishedMethodHideNoHint; Procedure TestRTTI_PublishedMethodExternalFail; Procedure TestRTTI_PublishedClassPropertyFail; Procedure TestRTTI_PublishedClassFieldFail; @@ -29497,6 +29498,59 @@ begin ConvertProgram; end; +procedure TTestModule.TestRTTI_PublishedMethodHideNoHint; +begin + WithTypeInfo:=true; + StartUnit(false); + Add([ + 'interface', + 'type', + ' TObject = class', + ' end;', + ' {$M+}', + ' TBird = class', + ' procedure Fly;', + ' end;', + ' {$M-}', + 'type', + ' TEagle = class(TBird)', + ' procedure Fly;', + ' end;', + 'implementation', + 'procedure TBird.Fly;', + 'begin', + 'end;', + 'procedure TEagle.Fly;', + 'begin', + 'end;', + '']); + ConvertUnit; + CheckSource('TestRTTI_PublishedMethodHideNoHint', + LinesToStr([ // statements + 'rtl.createClass(this, "TObject", null, function () {', + ' this.$init = function () {', + ' };', + ' this.$final = function () {', + ' };', + '});', + 'rtl.createClass(this, "TBird", this.TObject, function () {', + ' this.Fly = function () {', + ' };', + ' var $r = this.$rtti;', + ' $r.addMethod("Fly", 0, null);', + '});', + 'rtl.createClass(this, "TEagle", this.TBird, function () {', + ' this.Fly = function () {', + ' };', + ' var $r = this.$rtti;', + ' $r.addMethod("Fly", 0, null);', + '});', + '']), + LinesToStr([ // $mod.$main + ])); + CheckResolverUnexpectedHints(true); +end; + procedure TTestModule.TestRTTI_PublishedMethodExternalFail; begin WithTypeInfo:=true; diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index ccefcd71fe..e8830f9438 100644 --- a/rtl/inc/generic.inc +++ b/rtl/inc/generic.inc @@ -1401,14 +1401,13 @@ end; function fpc_mul_word(f1,f2 : word;checkoverflow : boolean) : word;[public,alias: 'FPC_MUL_WORD']; compilerproc; var _f1,bitpos : word; - b : byte; f1overflowed : boolean; begin fpc_mul_word:=0; bitpos:=1; f1overflowed:=false; - for b:=0 to 15 do + while f1<>0 do begin if (f2 and bitpos)<>0 then begin @@ -1487,14 +1486,13 @@ end; function fpc_mul_dword(f1,f2 : dword;checkoverflow : boolean) : dword;[public,alias: 'FPC_MUL_DWORD']; compilerproc; var _f1,bitpos : dword; - b : byte; f1overflowed : boolean; begin fpc_mul_dword:=0; bitpos:=1; f1overflowed:=false; - for b:=0 to 31 do + while f1<>0 do begin if (f2 and bitpos)<>0 then begin @@ -1598,14 +1596,13 @@ end; function fpc_mul_byte_checkoverflow(f1,f2 : byte) : byte;[public,alias: 'FPC_MUL_BYTE_CHECKOVERFLOW']; compilerproc; var _f1, bitpos : byte; - b : byte; f1overflowed : boolean; begin fpc_mul_byte_checkoverflow := 0; bitpos := 1; f1overflowed := false; - for b := 0 to 7 do + while f1<>0 do begin if (f2 and bitpos) <> 0 then begin @@ -1708,14 +1705,13 @@ end; function fpc_mul_word_checkoverflow(f1,f2 : word) : word;[public,alias: 'FPC_MUL_WORD_CHECKOVERFLOW']; compilerproc; var _f1,bitpos : word; - b : byte; f1overflowed : boolean; begin fpc_mul_word_checkoverflow:=0; bitpos:=1; f1overflowed:=false; - for b:=0 to 15 do + while f1<>0 do begin if (f2 and bitpos)<>0 then begin @@ -1819,14 +1815,13 @@ end; function fpc_mul_dword_checkoverflow(f1,f2 : dword) : dword;[public,alias: 'FPC_MUL_DWORD_CHECKOVERFLOW']; compilerproc; var _f1,bitpos : dword; - b : byte; f1overflowed : boolean; begin fpc_mul_dword_checkoverflow:=0; bitpos:=1; f1overflowed:=false; - for b:=0 to 31 do + while f1<>0 do begin if (f2 and bitpos)<>0 then begin diff --git a/rtl/macos/Makefile b/rtl/macos/Makefile index 77b05a0ef6..671ed5b2f6 100644 --- a/rtl/macos/Makefile +++ b/rtl/macos/Makefile @@ -3261,12 +3261,10 @@ strings$(PPUEXT) : $(INC)/strings.pp system$(PPUEXT) uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp $(COMPILER) $(INC)/uuchar.pp objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT) - $(COPY) $(OBJPASDIR)/objpas.pp . - $(COMPILER) objpas $(REDIR) - $(DEL) objpas.pp + $(COMPILER) $(OBJPASDIR)/objpas.pp $(REDIR) sysutils$(PPUEXT) : sysutils.pp objpas$(PPUEXT) system$(PPUEXT) sysconst$(PPUEXT) macostp$(PPUEXT) macutils$(PPUEXT) $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) softfpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) +sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) softfpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) $(OBJPASDIR)/sysconst.pp rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) $(OBJPASDIR)/rtlconsts.pp @@ -3285,7 +3283,7 @@ types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) math$(PPUEXT) $(SYSTEMUNI macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT) $(COMPILER) $(INC)/macpas.pp $(REDIR) dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT) - $(COMPILER) dos $(REDIR) + $(COMPILER) dos.pp $(REDIR) iso7185$(PPUEXT) : $(INC)/iso7185.pp heaptrc$(PPUEXT) $(COMPILER) $(INC)/iso7185.pp extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) diff --git a/rtl/macos/Makefile.fpc b/rtl/macos/Makefile.fpc index e52d1ceef6..0a7e67e7d5 100644 --- a/rtl/macos/Makefile.fpc +++ b/rtl/macos/Makefile.fpc @@ -24,7 +24,7 @@ implicitunits=cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \ rsts=sysconst # math typinfo sysconst rtlconsts - + [require] nortl=y @@ -114,14 +114,12 @@ uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp $(COMPILER) $(INC)/uuchar.pp objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT) - $(COPY) $(OBJPASDIR)/objpas.pp . - $(COMPILER) objpas $(REDIR) - $(DEL) objpas.pp + $(COMPILER) $(OBJPASDIR)/objpas.pp $(REDIR) sysutils$(PPUEXT) : sysutils.pp objpas$(PPUEXT) system$(PPUEXT) sysconst$(PPUEXT) macostp$(PPUEXT) macutils$(PPUEXT) $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) softfpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) +sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) softfpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) $(OBJPASDIR)/sysconst.pp rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) @@ -160,13 +158,13 @@ macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT) # dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT) - $(COMPILER) dos $(REDIR) + $(COMPILER) dos.pp $(REDIR) #crt$(PPUEXT) : crt.pp $(INC)/textrec.inc system$(PPUEXT) -# $(COMPILER) crt $(REDIR) +# $(COMPILER) crt.pp $(REDIR) #printer$(PPUEXT) : printer.pp system$(PPUEXT) -# $(COMPILER) printer $(REDIR) +# $(COMPILER) printer.pp $(REDIR) # # Other system-independent RTL Units diff --git a/rtl/unix/timezone.inc b/rtl/unix/timezone.inc index 24f9aa07fa..d1d4fe24e3 100644 --- a/rtl/unix/timezone.inc +++ b/rtl/unix/timezone.inc @@ -210,7 +210,7 @@ var NewTZInfoEx: TTZInfoEx; begin LockTZInfo; - if GetLocalTimezone(fptime,false,NewTZInfo,NewTZInfoEx) then + if GetLocalTimezone(fptime,true,NewTZInfo,NewTZInfoEx) then SetTZInfo(NewTZInfo,NewTZInfoEx); UnlockTZInfo; end; diff --git a/utils/ihxutil/fpmake.pp b/utils/ihxutil/fpmake.pp index d01096b293..2ca4655214 100644 --- a/utils/ihxutil/fpmake.pp +++ b/utils/ihxutil/fpmake.pp @@ -15,7 +15,7 @@ begin With Installer do begin P:=AddPackage('utils-ihxutil'); - P.ShortName:='ihxutil'; + P.ShortName:='ihxu'; P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc]; if Defaults.CPU=jvm then P.OSes := P.OSes - [java,android];