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

* synchronised with trunk till r40398

Browse Source 
git-svn-id: branches/debug_eh@40399 -
This commit is contained in:
Jonas Maebe 2018-11-29 21:19:12 +00:00
commit bc8ed77af1
23 changed files with 206 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/defcmp.pas
View File

@ -187,7 +187,7 @@ implementation
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit,
pasbool, bool8bit,bool16bit,bool32bit,bool64bit,
uchar,uwidechar,scurrency }
uchar,uwidechar,scurrency,customint }
type
tbasedef=(bvoid,bchar,bint,bbool);
@ -198,7 +198,7 @@ implementation
bint,bint,bint,bint,bint,
bbool,bbool,bbool,bbool,bbool,
bbool,bbool,bbool,bbool,
bchar,bchar,bint);
bchar,bchar,bint,bint);
basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
{ void, char, int, bool }
@ -1969,6 +1969,8 @@ implementation
is_subequal:=(torddef(def2).ordtype=uchar);
uwidechar :
is_subequal:=(torddef(def2).ordtype=uwidechar);
customint:
is_subequal:=(torddef(def2).low=torddef(def1).low) and (torddef(def2).high=torddef(def1).high);
end;
end
else

12
compiler/defutil.pas
View File

@ -479,7 +479,7 @@ implementation
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit,
pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
bool8bit,bool16bit,bool32bit,bool64bit];
bool8bit,bool16bit,bool32bit,bool64bit,customint];
end;
enumdef :
is_ordinal:=true;
@ -550,7 +550,8 @@ implementation
begin
result:=(def.typ=orddef) and
(torddef(def).ordtype in [u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit]);
s8bit,s16bit,s32bit,s64bit,
customint]);
end;
@ -948,8 +949,11 @@ implementation
begin
result:=(def1.typ=orddef) and (def2.typ=orddef) and
(torddef(def1).ordtype in [u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit]) and
(torddef(def1).ordtype=torddef(def2).ordtype);
s8bit,s16bit,s32bit,s64bit,customint]) and
(torddef(def1).ordtype=torddef(def2).ordtype) and
((torddef(def1).ordtype<>customint) or
((torddef(def1).low=torddef(def2).low) and
(torddef(def1).high=torddef(def2).high)));
end;

2
compiler/htypechk.pas
View File

@ -3132,7 +3132,7 @@ implementation
tve_shortint,tve_smallint,tve_longint,tve_chari64,tve_incompatible,
tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
tve_chari64,tve_chari64,tve_dblcurrency);
tve_chari64,tve_chari64,tve_dblcurrency,tve_incompatible);
{ TODO: fixme for 128 bit floats }
variantfloatdef_cl: array[tfloattype] of tvariantequaltype =
(tve_single,tve_dblcurrency,tve_extended,tve_extended,

2
compiler/llvm/hlcgllvm.pas
View File

@ -232,7 +232,7 @@ implementation
construction (the record is build from the paraloc
types) }
else if userecord then
a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register)
a_load_ref_reg(list,fielddef,location^.def,tmpref,location^.register)
{ if the parameter is passed in a single paraloc, the
paraloc's type may be different from the declared type
-> use the original complete parameter size as source so

35
compiler/llvm/llvmdef.pas
View File

@ -351,8 +351,10 @@ implementation
passing it as a parameter may result in unexpected behaviour }
else if def=llvmbool1type then
encodedstr:=encodedstr+'i1'
else if torddef(def).ordtype<>customint then
encodedstr:=encodedstr+'i'+tostr(def.size*8)
else
encodedstr:=encodedstr+'i'+tostr(def.size*8);
encodedstr:=encodedstr+'i'+tostr(def.packedbitsize);
end;
pointerdef :
begin
@ -836,6 +838,8 @@ implementation
s64bit,
u64bit:
typename:=typename+'i64';
customint:
typename:=typename+'i'+tostr(torddef(hdef).packedbitsize);
else
{ other types should not appear currently, add as needed }
internalerror(2014012001);
@ -876,6 +880,7 @@ implementation
usedef: tdef;
valueext: tllvmvalueextension;
i: longint;
sizeleft: asizeint;
begin
{ single location }
if not assigned(cgpara.location^.next) then
@ -903,10 +908,36 @@ implementation
{ multiple locations -> create temp record }
retloc:=cgpara.location;
i:=0;
sizeleft:=cgpara.Def.size;
repeat
if i>high(retdeflist) then
internalerror(2016121801);
retdeflist[i]:=retloc^.def;
if assigned(retloc^.next) then
begin
retdeflist[i]:=retloc^.def;
dec(sizeleft,retloc^.def.size);
end
else
begin
case sizeleft of
1:
retdeflist[i]:=u8inttype;
2:
retdeflist[i]:=u16inttype;
3:
retdeflist[i]:=u24inttype;
4:
retdeflist[i]:=u32inttype;
5:
retdeflist[i]:=u40inttype;
6:
retdeflist[i]:=u48inttype;
7:
retdeflist[i]:=u56inttype;
else
retdeflist[i]:=retloc^.def;
end;
end;
inc(i);
retloc:=retloc^.next;
until not assigned(retloc);

29
compiler/ncgrtti.pas
View File

@ -1018,15 +1018,36 @@ implementation
otSByte,otSWord,otSLong,otSQWord,otUByte{otNone},
otUByte,otUByte,otUWord,otULong,otUQWord,
otSByte,otSWord,otSLong,otSQWord,
otUByte,otUWord,otUByte);
otUByte,otUWord,otUByte,255);
var
elesize: string[1];
deftrans: byte;
begin
write_header(tcb,def,typekind);
case trans[def.ordtype] of
deftrans:=trans[def.ordtype];
case deftrans of
otUQWord,
otSQWord:
elesize:='8'
elesize:='8';
255:
begin
if def.packedbitsize<=32 then
begin
elesize:='4';
if def.low<0 then
deftrans:=otSLong
else
deftrans:=otULong;
end
else
begin
elesize:='8';
if def.low<0 then
deftrans:=otSQWord
else
deftrans:=otUQWord;
end;
end
else
elesize:='4'
end;
@ -1042,7 +1063,7 @@ implementation
targetinfos[target_info.system]^.alignment.recordalignmin,
targetinfos[target_info.system]^.alignment.maxCrecordalign);
{Convert to longint to smuggle values in high(longint)+1..high(cardinal) into asmlist.}
case trans[def.ordtype] of
case deftrans of
otUQWord:
begin
tcb.emit_ord_const(min,u64inttype);

24
compiler/psystem.pas
View File

@ -262,8 +262,16 @@ implementation
s8inttype:=corddef.create(s8bit,int64(-128),127,true);
u16inttype:=corddef.create(u16bit,0,65535,true);
s16inttype:=corddef.create(s16bit,int64(-32768),32767,true);
s24inttype:=corddef.create(customint,-(int64(1) shl 23),1 shl 23 - 1,true);
u24inttype:=corddef.create(customint,0,1 shl 24 - 1,true);
u32inttype:=corddef.create(u32bit,0,high(longword),true);
s32inttype:=corddef.create(s32bit,int64(low(longint)),int64(high(longint)),true);
s40inttype:=corddef.create(customint,-(int64(1) shl 39),int64(1) shl 39 - 1,true);
u40inttype:=corddef.create(customint,0,int64(1) shl 40 - 1,true);
s48inttype:=corddef.create(customint,-(int64(1) shl 47),int64(1) shl 47 - 1,true);
u48inttype:=corddef.create(customint,0,int64(1) shl 48 - 1,true);
s56inttype:=corddef.create(customint,-(int64(1) shl 55),int64(1) shl 55 - 1,true);
u56inttype:=corddef.create(customint,0,int64(1) shl 56 - 1,true);
u64inttype:=corddef.create(u64bit,low(qword),high(qword),true);
s64inttype:=corddef.create(s64bit,low(int64),high(int64),true);
{ upper/lower bound not yet properly set for 128 bit types, as we don't
@ -500,8 +508,16 @@ implementation
addtype('$shortint',s8inttype);
addtype('$word',u16inttype);
addtype('$smallint',s16inttype);
addtype('$sint24',s24inttype);
addtype('$uint24',u24inttype);
addtype('$ulong',u32inttype);
addtype('$longint',s32inttype);
addtype('$sint40',s40inttype);
addtype('$uint40',u40inttype);
addtype('$sint48',s48inttype);
addtype('$uint48',u48inttype);
addtype('$sint56',s56inttype);
addtype('$uint56',u56inttype);
addtype('$qword',u64inttype);
addtype('$int64',s64inttype);
addtype('$uint128',u128inttype);
@ -633,8 +649,16 @@ implementation
loadtype('shortint',s8inttype);
loadtype('word',u16inttype);
loadtype('smallint',s16inttype);
loadtype('uint24',u24inttype);
loadtype('sint24',s24inttype);
loadtype('ulong',u32inttype);
loadtype('longint',s32inttype);
loadtype('uint40',u40inttype);
loadtype('sint40',s40inttype);
loadtype('uint48',u48inttype);
loadtype('sint48',s48inttype);
loadtype('uint56',u56inttype);
loadtype('sint56',s56inttype);
loadtype('qword',u64inttype);
loadtype('int64',s64inttype);
loadtype('uint128',u128inttype);

2
compiler/symconst.pas
View File

@ -271,7 +271,7 @@ type
s8bit,s16bit,s32bit,s64bit,s128bit,
pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
bool8bit,bool16bit,bool32bit,bool64bit,
uchar,uwidechar,scurrency
uchar,uwidechar,scurrency,customint
);
tordtypeset = set of tordtype;

26
compiler/symdef.pas
View File

@ -1055,8 +1055,16 @@ interface
s8inttype, { 8-Bit signed integer }
u16inttype, { 16-Bit unsigned integer }
s16inttype, { 16-Bit signed integer }
u24inttype, { 24-Bit unsigned integer }
s24inttype, { 24-Bit signed integer }
u32inttype, { 32-Bit unsigned integer }
s32inttype, { 32-Bit signed integer }
u40inttype, { 40-Bit unsigned integer }
s40inttype, { 40-Bit signed integer }
u48inttype, { 48-Bit unsigned integer }
s48inttype, { 48-Bit signed integer }
u56inttype, { 56-Bit unsigned integer }
s56inttype, { 56-Bit signed integer }
u64inttype, { 64-bit unsigned integer }
s64inttype, { 64-bit signed integer }
u128inttype, { 128-bit unsigned integer }
@ -2887,10 +2895,12 @@ implementation
1,2,4,8,16,
1,1,2,4,8,
1,2,4,8,
1,2,8
1,2,8,system.high(longint)
);
begin
savesize:=sizetbl[ordtype];
if savesize=system.high(longint) then
savesize:=packedbitsize div 8;
end;
@ -2941,9 +2951,11 @@ implementation
varshortint,varsmallint,varinteger,varint64,varUndefined,
varboolean,varboolean,varboolean,varboolean,varboolean,
varboolean,varboolean,varUndefined,varUndefined,
varUndefined,varUndefined,varCurrency);
varUndefined,varUndefined,varCurrency,varEmpty);
begin
result:=basetype2vardef[ordtype];
if result=varEmpty then
result:=basetype2vardef[range_to_basetype(low,high)];
end;
@ -2971,7 +2983,7 @@ implementation
'ShortInt','SmallInt','LongInt','Int64','Int128',
'Boolean','Boolean8','Boolean16','Boolean32','Boolean64',
'ByteBool','WordBool','LongBool','QWordBool',
'Char','WideChar','Currency');
'Char','WideChar','Currency','CustomRange');
begin
GetTypeName:=names[ordtype];
@ -6239,7 +6251,7 @@ implementation
'a','s','i','x','',
'b','b','b','b','b',
'b','b','b','b',
'c','w','x');
'c','w','x','C');
floattype2str : array[tfloattype] of string[1] = (
'f','d','e','e',
@ -6252,7 +6264,11 @@ implementation
begin
case p.typ of
orddef:
s:=ordtype2str[torddef(p).ordtype];
begin
s:=ordtype2str[torddef(p).ordtype];
if s='C' then
s:=ordtype2str[range_to_basetype(torddef(p).low,torddef(p).high)];
end;
pointerdef:
s:='P'+getcppparaname(tpointerdef(p).pointeddef);
{$ifndef NAMEMANGLING_GCC2}

8
compiler/utils/ppuutils/ppudump.pp
View File

@ -2937,7 +2937,7 @@ procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef);
u8bit,u16bit,u32bit,u64bit,u128bit,
s8bit,s16bit,s32bit,s64bit,s128bit,
bool8bit,bool16bit,bool32bit,bool64bit,
uchar,uwidechar,scurrency
uchar,uwidechar,scurrency,customint
); }
{ type tobjecttyp is in symconst unit }
@ -3145,6 +3145,12 @@ begin
orddef.OrdType:=otCurrency;
orddef.Size:=8;
end;
customint:
begin
writeln('customint');
orddef.OrdType:=otSint;
orddef.Size:=sizeof(ASizeInt);
end
else
WriteWarning('Invalid base type: ' + IntToStr(b));
end;

6
packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp
View File

@ -47,6 +47,8 @@ uses
type
TEventAlert = procedure(Sender: TObject; EventName: string; EventCount: longint;
var CancelAlerts: boolean) of object;
TEventAlertPayload = procedure(Sender: TObject; EventName, PayLoad: string; EventCount: longint;
var CancelAlerts: boolean) of object;
TErrorEvent = procedure(Sender: TObject; ErrorCode: integer) of object;
{ TPQEventMonitor }
@ -59,6 +61,7 @@ type
FEvents: TStrings;
FOnError: TErrorEvent;
FOnEventAlert: TEventAlert;
FOnEventAlertPayLoad: TEventAlertPayload;
FRegistered: Boolean;
function GetNativeHandle: pointer;
procedure SetConnection(AValue: TPQConnection);
@ -77,6 +80,7 @@ type
property Events: TStrings read FEvents write SetEvents;
property Registered: Boolean read FRegistered write SetRegistered;
property OnEventAlert: TEventAlert read FOnEventAlert write FOnEventAlert;
property OnEventAlertPayload: TEventAlertPayload read FOnEventAlertPayload write FOnEventAlertPayload;
property OnError: TErrorEvent read FOnError write FOnError;
end;
@ -165,6 +169,8 @@ begin
begin
if assigned(OnEventAlert) then
OnEventAlert(Self,notify^.relname,1,CancelAlerts);
if assigned(OnEventAlertPayLoad) then
OnEventAlertPayLoad(Self,notify^.relname,Notify^.Extra,1,CancelAlerts);
PQfreemem(notify);
end;
until not assigned(notify) or CancelAlerts;

21
packages/fcl-web/src/base/fphttpclient.pp
View File

@ -1376,7 +1376,7 @@ procedure TFPCustomHTTPClient.HTTPMethod(const AMethod, AURL: String;
Stream: TStream; const AllowedResponseCodes: array of Integer);
Var
M,L,NL : String;
M,L,NL,RNL : String;
RC : Integer;
RR : Boolean; // Repeat request ?
@ -1399,17 +1399,22 @@ begin
if (RC>MaxRedirects) then
Raise EHTTPClient.CreateFmt(SErrMaxRedirectsReached,[RC]);
NL:=GetHeader(FResponseHeaders,'Location');
if Not Assigned(FOnRedirect) then
L:=NL
else
if Assigned(FOnRedirect) then
FOnRedirect(Self,L,NL);
if (not IsAbsoluteURI(NL)) and ResolveRelativeURI(L,NL,RNL) then
NL:=RNL;
if (RedirectForcesGET(FResponseStatusCode)) then
M:='GET';
L:=NL;
// Request has saved cookies in sentcookies.
FreeAndNil(FCookies);
FCookies:=FSentCookies;
FSentCookies:=Nil;
if ParseURI(L).Host=ParseURI(NL).Host then
FreeAndNil(FSentCookies)
else
begin
FreeAndNil(FCookies);
FCookies:=FSentCookies;
FSentCookies:=Nil;
end;
L:=NL;
end;
end;
if (FResponseStatusCode=401) then

2
packages/fcl-web/src/base/httproute.pp
View File

@ -422,7 +422,7 @@ Var
begin
Result:=High(TRouteMethod);
MN:=Uppercase(S);
While (Result>=Low(TRouteMethod)) and (RouteMethodNames[Result]<>MN) do
While (Result>Low(TRouteMethod)) and (RouteMethodNames[Result]<>MN) do
Result:=Pred(Result);
if Result=rmAll then Result:=rmUnknown;
end;

43
packages/fpmkunit/src/fpmkunit.pp
View File

@ -1673,7 +1673,6 @@ ResourceString
SWarnSkipPackageTargetProgress = '[%3.0f%%] Skipped package %s which has been disabled for target %s';
SWarnSkipPackageTarget = 'Skipped package %s which has been disabled for target %s';
SWarnInstallationPackagecomplete = 'Installation package %s for target %s succeeded';
SWarnCleanPackagecomplete = 'Clean of package %s completed';
SWarnCanNotGetAccessRights = 'Warning: Failed to copy access-rights from file %s';
SWarnCanNotSetAccessRights = 'Warning: Failed to copy access-rights to file %s';
SWarnCanNotGetFileAge = 'Warning: Failed to get FileAge for %s';
@ -1694,6 +1693,7 @@ ResourceString
SInfoUnInstallingPackage= 'Uninstalling package %s';
SInfoArchivingPackage = 'Archiving package %s in "%s"';
SInfoCleaningPackage = 'Cleaning package %s';
SInfoCleanPackagecomplete = 'Clean of package %s completed';
SInfoManifestPackage = 'Creating manifest for package %s';
SInfoPkgListPackage = 'Adding package %s to the package list';
SInfoCopyingFile = 'Copying file "%s" to "%s"';
@ -1752,7 +1752,7 @@ ResourceString
SDbgDeletedFile = 'Recursively deleted file "%s"';
SDbgRemovedDirectory = 'Recursively removed directory "%s"';
SDbgUnregisteredResource = 'Adding resource file "%s", which is not registered.';
SDbgSearchingDir = 'Searching dir %s.';
// Help messages for usage
SValue = 'Value';
@ -1785,6 +1785,7 @@ ResourceString
SHelpConfig = 'Use indicated config file when compiling.';
SHelpOptions = 'Pass extra options to the compiler.';
SHelpVerbose = 'Be verbose when working.';
SHelpDebug = 'Add debug information when working.';
SHelpInteractive = 'Allow to interact with child processes';
SHelpInstExamples = 'Install the example-sources.';
SHelpSkipCrossProgs = 'Skip programs when cross-compiling/installing';
@ -2538,7 +2539,8 @@ procedure SearchFiles(AFileName, ASearchPathPrefix: string; Recursive: boolean;
var
Info : TSearchRec;
begin
Writeln('Searching ',Searchdir);
if assigned(Installer) then
Installer.Log(VlDebug,Format(SDbgSearchingDir,[SearchDir]));
if FindFirst(SearchDir+AllFilesMask,faAnyFile and faDirectory,Info)=0 then
begin
repeat
@ -3739,6 +3741,7 @@ begin
OB:=IncludeTrailingPathDelimiter(GetBinOutputDir(ACPU,AOS));
OU:=IncludeTrailingPathDelimiter(GetUnitsOutputDir(ACPU,AOS));
List.Add(GetUnitConfigOutputFilename(Defaults.CPU,Defaults.OS));
List.Add(ManifestFile);
AddConditionalStrings(Self, List,CleanFiles,ACPU,AOS);
For I:=0 to FTargets.Count-1 do
FTargets.TargetItems[I].GetCleanFiles(List, OU, OB, ACPU, AOS);
@ -5288,7 +5291,7 @@ begin
Defaults.BuildMode:=bmBuildUnit
else if CheckOption(I,'io','ignoreinvalidoption', true) then
Defaults.IgnoreInvalidOptions:=true
else if CheckOption(I,'d','doc-folder') then
else if CheckOption(I,'df','doc-folder') then
Defaults.FPDocOutputDir:=OptionArg(I)
else if CheckOption(I,'fsp','fpunitsrcpath') then
Defaults.FPUnitSourcePath:=OptionArg(I)
@ -5354,6 +5357,7 @@ begin
LogOption('l','list-commands',SHelpList);
LogOption('n','nofpccfg',SHelpNoFPCCfg);
LogOption('v','verbose',SHelpVerbose);
LogOption('d','debug',SHelpDebug);
LogOption('I','interactive',SHelpInteractive);
{$ifdef HAS_UNIT_PROCESS}
LogOption('e', 'useenv', sHelpUseEnvironment);
@ -5376,7 +5380,7 @@ begin
LogArgOption('r','compiler',SHelpCompiler);
LogArgOption('f','config',SHelpConfig);
LogArgOption('o','options',SHelpOptions);
LogArgOption('d', 'doc-folder', sHelpFpdocOutputDir);
LogArgOption('df', 'doc-folder', sHelpFpdocOutputDir);
LogArgOption('fsp', 'fpunitsrcpath', sHelpFPUnitSrcPath);
LogArgOption('zp', 'zipprefix', sHelpZipPrefix);
{$ifndef NO_THREADING}
@ -7937,14 +7941,20 @@ var
AOS: TOS;
DirectoryList : TStringList;
begin
if not AllTargets and (not(Defaults.OS in APackage.OSes) or
not (Defaults.CPU in APackage.CPUs)) then
exit;
Log(vlInfo,SInfoCleaningPackage,[APackage.Name]);
try
If (APackage.Directory<>'') then
EnterDir(APackage.Directory);
// Check for inherited options (packagevariants) from other packages
ResolveDependencies(APackage.Dependencies, (APackage.Collection as TPackages));
CheckDependencies(APackage, False);
APackage.SetDefaultPackageVariant;
if (Defaults.OS in APackage.OSes) and (Defaults.CPU in APackage.CPUs) then
begin
ResolveDependencies(APackage.Dependencies, (APackage.Collection as TPackages));
CheckDependencies(APackage, False);
APackage.SetDefaultPackageVariant;
end;
DoBeforeClean(Apackage);
AddPackageMacrosToDictionary(APackage, APackage.Dictionary);
if AllTargets then
@ -7956,7 +7966,8 @@ begin
for ACPU:=low(TCpu) to high(TCpu) do if ACPU<>cpuNone then
for AOS:=low(TOS) to high(TOS) do if AOS<>osNone then
begin
if OSCPUSupported[AOS,ACPU] then
if OSCPUSupported[AOS,ACPU] and (AOS in APackage.OSes) and
(ACPU in APackage.CPUs) then
begin
// First perform a normal clean, to be sure that all files
// which are not in the units- or bin-dir are cleaned. (like
@ -7975,6 +7986,7 @@ begin
Clean(APackage, Defaults.CPU, Defaults.OS);
DoAfterClean(Apackage);
Finally
log(vlInfo, SInfoCleanPackagecomplete, [APackage.Name]);
If (APackage.Directory<>'') then
EnterDir('');
end;
@ -7984,6 +7996,8 @@ procedure TBuildEngine.Clean(APackage: TPackage; ACPU: TCPU; AOS: TOS);
Var
List : TStringList;
DirectoryList : TStringList;
RemainingList : TStrings;
i : longint;
begin
List:=TStringList.Create;
try
@ -8012,6 +8026,11 @@ begin
begin
Installer.Log(vlWarning,Format(SWarnRemovedNonEmptyDirectory,[APackage.Directory+APackage.GetBinOutputDir(ACPU,AOS)]));
DirectoryList.Add(APackage.GetBinOutputDir(ACPU,AOS));
RemainingList := TStringList.Create;
SearchFiles(AllFilesMask, APackage.GetBinOutputDir(ACPU,AOS), true, RemainingList);
for i:=0 to RemainingList.Count-1 do
Installer.log(vlDebug,format('File %s still present',[RemainingList[i]]));
RemainingList.Free;
CmdRemoveTrees(DirectoryList);
DirectoryList.Clear;
end;
@ -8020,6 +8039,11 @@ begin
begin
Installer.Log(vlWarning,Format(SWarnRemovedNonEmptyDirectory,[APackage.Directory+APackage.GetUnitsOutputDir(ACPU,AOS)]));
DirectoryList.Add(APackage.GetUnitsOutputDir(ACPU,AOS));
RemainingList := TStringList.Create;
SearchFiles(AllFilesMask, APackage.GetUnitsOutputDir(ACPU,AOS), true, RemainingList);
for i:=0 to RemainingList.Count-1 do
Installer.log(vlDebug,format('File %s still present',[RemainingList[i]]));
RemainingList.Free;
CmdRemoveTrees(DirectoryList);
DirectoryList.Clear;
end;
@ -8374,7 +8398,6 @@ begin
P:=Packages.PackageItems[i];
If AllTargets or PackageOK(P) then
Clean(P, AllTargets);
log(vlWarning, SWarnCleanPackagecomplete, [P.Name]);
end;
NotifyEventCollection.CallEvents(neaAfterClean, Self);
end;

7
packages/gdbint/fpmake.pp
View File

@ -134,11 +134,16 @@ end;
procedure AfterCompile_gdbint(Sender: TObject);
var
L : TStrings;
P : TPackage;
begin
// Remove the generated gdbver.inc
L := TStringList.Create;
P := Sender as TPackage;
try
L.add(IncludeTrailingPathDelimiter(Installer.BuildEngine.StartDir)+'src/gdbver.inc');
if P.Directory<>'' then
L.add(IncludeTrailingPathDelimiter(P.Directory)+'src'+DirectorySeparator+'gdbver.inc')
else
L.add(IncludeTrailingPathDelimiter(Installer.BuildEngine.StartDir)+'src'+DirectorySeparator+'gdbver.inc');
Installer.BuildEngine.CmdDeleteFiles(L);
finally
L.Free;

2
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -437,6 +437,7 @@ type
TFunctionCallParameter = record
ValueRef: Pointer;
ValueSize: SizeInt;
Info: TFunctionCallParameterInfo;
end;
TFunctionCallParameterArray = specialize TArray<TFunctionCallParameter>;
@ -812,6 +813,7 @@ begin
SetLength(funcargs, Length(aArgs));
for i := Low(aArgs) to High(aArgs) do begin
funcargs[i - Low(aArgs) + Low(funcargs)].ValueRef := aArgs[i].GetReferenceToRawData;
funcargs[i - Low(aArgs) + Low(funcargs)].ValueSize := aArgs[i].DataSize;
funcargs[i - Low(aArgs) + Low(funcargs)].Info.ParamType := aArgs[i].TypeInfo;
funcargs[i - Low(aArgs) + Low(funcargs)].Info.ParamFlags := [];
funcargs[i - Low(aArgs) + Low(funcargs)].Info.ParaLocs := Nil;

1
utils/fpcmkcfg/fpmake.pp
View File

@ -39,6 +39,7 @@ begin
p.Commands.AddCommand(caBeforeCompile, Data2IncBin, '-b -s default.cft default.inc fppkg_default','default.inc','default.cft');
T:=P.Targets.AddProgram('fpcmkcfg.pp');
T.ResourceStrings:=true;
T.Dependencies.AddInclude('fpccfg.inc');
T.Dependencies.AddInclude('fpcfg.inc');
T.Dependencies.AddInclude('fpini.inc');

7
utils/fpdoc/fpmake.pp
View File

@ -60,7 +60,9 @@ begin
T.Dependencies.AddUnit('dglobals');
T:=P.Targets.AddProgram('unitdiff.pp');
T.ResourceStrings:=true;
T:=P.Targets.AddProgram('fpclasschart.pp');
T.ResourceStrings:=true;
T := P.Targets.AddUnit('dglobals.pp');
T.install:=false;
@ -77,13 +79,16 @@ begin
P.Targets.AddUnit('dw_xml.pp').install:=false;
P.Targets.AddUnit('sh_pas.pp').install:=false;
P.Targets.AddUnit('dw_html.pp').install:=false;
P.Targets.AddUnit('dw_latex.pp').install:=false;
T:=P.Targets.AddUnit('dw_latex.pp');
T.install:=false;
T.ResourceStrings:=true;
P.Targets.AddUnit('dw_txt.pp').install:=false;
P.Targets.AddUnit('dw_man.pp').install:=false;
P.Targets.AddUnit('dwlinear.pp').install:=false;
P.Targets.AddUnit('dw_linrtf.pp').install:=false;
P.Targets.AddUnit('dw_dxml.pp').install:=false;
P.Targets.AddUnit('fpdocproj.pas').install:=false;
P.Targets.AddUnit('fpdocclasstree.pp').install:=false;
P.Targets.AddUnit('mkfpdoc.pp').install:=false;
P.Targets.AddUnit('dw_ipflin.pas').install:=false;

6
utils/fpmake.pp
View File

@ -69,7 +69,7 @@ begin
P.Dependencies.Add('rtl-extra');
P.Dependencies.Add('rtl-objpas');
P.Version:='3.3.1';
T:=P.Targets.AddProgram('ptop.pp');
@ -77,7 +77,8 @@ begin
T.ResourceStrings:=true;
P.Targets.AddProgram('ppdep.pp');
P.Targets.AddProgram('rstconv.pp');
T:=P.Targets.AddProgram('rstconv.pp');
T.ResourceStrings:=true;
P.Targets.AddProgram('data2inc.pp');
P.Targets.AddProgram('delp.pp');
P.Targets.AddProgram('bin2obj.pp');
@ -87,6 +88,7 @@ begin
P.Targets.AddProgram('grab_vcsa.pp',[linux]);
T:=P.Targets.AddProgram('fpcsubst.pp');
T.Dependencies.AddUnit('usubst');
T.ResourceStrings:=true;
P.Targets.AddUnit('usubst.pp').install:=false;
P.Targets.AddUnit('ptopu.pp').install:=false;
end;

3
utils/fppkg/fpmake.pp
View File

@ -9,7 +9,7 @@ procedure add_fppkg_util(const ADirectory: string);
const
lnetOSes = [linux,beos,haiku,freebsd,netbsd,openbsd,darwin,iphonesim,solaris,win32,win64,wince,aix];
WindowsOSes = [win32,win64,wince];
Var
P : TPackage;
T : TTarget;
@ -71,6 +71,7 @@ begin
P.Targets.AddUnit('lnet/lnet.pp', lnetOSes).install:=false;
P.Targets.AddUnit('lnet/lstrbuffer.pp', lnetOSes).install:=false;
P.Targets.AddUnit('lnet/ltimer.pp', lnetOSes).install:=false;
P.Targets.AddUnit('lnet/lws2tcpip.pp', WindowsOSes).install:=false;
P.Sources.AddSrc('lnet/lsmtp.pp');
P.Sources.AddSrc('lnet/lwebserver.pp');

4
utils/pas2js/fpmake.pp
View File

@ -34,9 +34,11 @@ begin
P.Dependencies.Add('webidl');
PT:=P.Targets.AddProgram('pas2js.pp');
PT:=P.Targets.AddLibrary('pas2jslib.pp');
PT:=P.Targets.AddUnit('dirwatch.pp');
PT:=P.Targets.AddUnit('httpcompiler.pp');
PT.Dependencies.AddUnit('dirwatch');
PT:=P.Targets.AddProgram('compileserver.pp');
PT.Dependencies.AddUnit('httpcompiler');
PT.Dependencies.AddUnit('httpcompiler');
PT:=P.Targets.AddProgram('webidl2pas.pp');
end;
end;

1
utils/pas2ut/fpmake.pp
View File

@ -29,6 +29,7 @@ begin
P.Dependencies.Add('fcl-passrc');
T:=P.Targets.AddProgram('pas2ut.pp');
T.ResourceStrings:=true;
end;
end;

6
utils/unicode/fpmake.pp
View File

@ -36,8 +36,9 @@ begin
T := P.Targets.AddImplicitUnit('helper.pas');
T.ResourceStrings := true;
T.Install := false;
T := P.Targets.AddImplicitUnit('cldrtxt.pas');
T.Install := false;
T := P.Targets.AddImplicitUnit('cldrxml.pas');
T.ResourceStrings := true;
T.Install := false;
T := P.Targets.AddImplicitUnit('unicodeset.pas');
T.ResourceStrings := true;
@ -46,14 +47,13 @@ begin
T.Install := false;
T := P.Targets.AddImplicitUnit('cldrhelper.pas');
T.Install := false;
T.ResourceStrings:=true;
T := P.Targets.AddImplicitUnit('cldrtest.pas');
T.Install := false;
T := P.Targets.AddImplicitUnit('grbtree.pas');
T.Install := false;
T := P.Targets.AddImplicitUnit('trie.pas');
T.Install := false;
T := P.Targets.AddImplicitUnit('unicodeset.pas');
T.Install := false;
T:=P.Targets.AddProgram('cldrparser.lpr');
T:=P.Targets.AddProgram('unihelper.lpr');