From ddcd46b4be3a39285b5dc9310df0139e49ab298c Mon Sep 17 00:00:00 2001 From: pierre Date: Wed, 28 Nov 2018 22:11:29 +0000 Subject: [PATCH 01/11] * Change "Clean of package %S completed" level from vlWarning to vlInfo, to be at same level as "Cleaning pacakge %s" message. * Transform "Searching dir" writeln in SearchFiles into a vlDebug level log call. + Add manifest.xml to the list of files to remove. * Only do something in TBuildEngine.Clean method if AllTargets is true or if CPU-OS is supported for APackage parameter. git-svn-id: trunk@40388 - --- packages/fpmkunit/src/fpmkunit.pp | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp index 3174a2a9c2..244a7c8ddc 100644 --- a/packages/fpmkunit/src/fpmkunit.pp +++ b/packages/fpmkunit/src/fpmkunit.pp @@ -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'; @@ -2538,7 +2538,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 +3740,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); @@ -7937,14 +7939,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 +7964,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 +7984,7 @@ begin Clean(APackage, Defaults.CPU, Defaults.OS); DoAfterClean(Apackage); Finally + log(vlInfo, SInfoCleanPackagecomplete, [APackage.Name]); If (APackage.Directory<>'') then EnterDir(''); end; @@ -8374,7 +8384,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; From 8db29007ff52a118ecf8ea8cf362c706e956e967 Mon Sep 17 00:00:00 2001 From: pierre Date: Wed, 28 Nov 2018 23:16:31 +0000 Subject: [PATCH 02/11] Add listing of unremoved files during clean with -d (vlDebug) option git-svn-id: trunk@40389 - --- packages/fpmkunit/src/fpmkunit.pp | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp index 244a7c8ddc..ce11ad86dc 100644 --- a/packages/fpmkunit/src/fpmkunit.pp +++ b/packages/fpmkunit/src/fpmkunit.pp @@ -7994,6 +7994,8 @@ procedure TBuildEngine.Clean(APackage: TPackage; ACPU: TCPU; AOS: TOS); Var List : TStringList; DirectoryList : TStringList; + RemainingList : TStrings; + i : longint; begin List:=TStringList.Create; try @@ -8022,6 +8024,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; @@ -8030,6 +8037,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; From 9f68bddf3be2c9caced64f0e91bef93f979259ce Mon Sep 17 00:00:00 2001 From: pierre Date: Wed, 28 Nov 2018 23:24:33 +0000 Subject: [PATCH 03/11] Document -d --debug option, and change short version of --doc-folder to -df as -d is already used by debug option git-svn-id: trunk@40390 - --- packages/fpmkunit/src/fpmkunit.pp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp index ce11ad86dc..0f2a7f4f45 100644 --- a/packages/fpmkunit/src/fpmkunit.pp +++ b/packages/fpmkunit/src/fpmkunit.pp @@ -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'; @@ -5290,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) @@ -5356,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); @@ -5378,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} From 101ce4d37b759cf2e8d2b83de3961536ef6a1d43 Mon Sep 17 00:00:00 2001 From: pierre Date: Wed, 28 Nov 2018 23:45:35 +0000 Subject: [PATCH 04/11] Add several missing unit references in fpmake files git-svn-id: trunk@40391 - --- utils/fpcmkcfg/fpmake.pp | 1 + utils/fpdoc/fpmake.pp | 7 ++++++- utils/fpmake.pp | 6 ++++-- utils/fppkg/fpmake.pp | 3 ++- utils/pas2js/fpmake.pp | 4 +++- utils/pas2ut/fpmake.pp | 1 + utils/unicode/fpmake.pp | 2 ++ 7 files changed, 19 insertions(+), 5 deletions(-) diff --git a/utils/fpcmkcfg/fpmake.pp b/utils/fpcmkcfg/fpmake.pp index 1a19dd4ee8..3a3c6fc03f 100644 --- a/utils/fpcmkcfg/fpmake.pp +++ b/utils/fpcmkcfg/fpmake.pp @@ -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'); diff --git a/utils/fpdoc/fpmake.pp b/utils/fpdoc/fpmake.pp index 7fc188ead7..fd1470a1f9 100644 --- a/utils/fpdoc/fpmake.pp +++ b/utils/fpdoc/fpmake.pp @@ -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; diff --git a/utils/fpmake.pp b/utils/fpmake.pp index ef174281fa..71a3ba34f4 100644 --- a/utils/fpmake.pp +++ b/utils/fpmake.pp @@ -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; diff --git a/utils/fppkg/fpmake.pp b/utils/fppkg/fpmake.pp index 9ffb1e06b3..a2d66a15b8 100644 --- a/utils/fppkg/fpmake.pp +++ b/utils/fppkg/fpmake.pp @@ -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'); diff --git a/utils/pas2js/fpmake.pp b/utils/pas2js/fpmake.pp index e526f3bfd2..d8755c2762 100644 --- a/utils/pas2js/fpmake.pp +++ b/utils/pas2js/fpmake.pp @@ -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; diff --git a/utils/pas2ut/fpmake.pp b/utils/pas2ut/fpmake.pp index 6b7fbb28b0..24d3850bf7 100644 --- a/utils/pas2ut/fpmake.pp +++ b/utils/pas2ut/fpmake.pp @@ -29,6 +29,7 @@ begin P.Dependencies.Add('fcl-passrc'); T:=P.Targets.AddProgram('pas2ut.pp'); + T.ResourceStrings:=true; end; end; diff --git a/utils/unicode/fpmake.pp b/utils/unicode/fpmake.pp index 2727f284f5..00d26258b4 100644 --- a/utils/unicode/fpmake.pp +++ b/utils/unicode/fpmake.pp @@ -36,6 +36,7 @@ begin T := P.Targets.AddImplicitUnit('helper.pas'); T.ResourceStrings := true; T.Install := false; + T := P.Targets.AddImplicitUnit('cldrtxt.pas'); T := P.Targets.AddImplicitUnit('cldrxml.pas'); T.ResourceStrings := true; T.Install := false; @@ -46,6 +47,7 @@ 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'); From 810b37a87704c6ce160de163516ba841897adfe0 Mon Sep 17 00:00:00 2001 From: pierre Date: Thu, 29 Nov 2018 14:23:44 +0000 Subject: [PATCH 05/11] Fix delete of gdbver.inc generated file after gdbint unit compilation when called from packages level git-svn-id: trunk@40392 - --- packages/gdbint/fpmake.pp | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/packages/gdbint/fpmake.pp b/packages/gdbint/fpmake.pp index a9de7851c6..58abba0894 100644 --- a/packages/gdbint/fpmake.pp +++ b/packages/gdbint/fpmake.pp @@ -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; From 818624559d5de76098f3a454c9b4ea7ea016e87b Mon Sep 17 00:00:00 2001 From: michael Date: Thu, 29 Nov 2018 15:21:50 +0000 Subject: [PATCH 06/11] * Fix bug #34538, AV in case of invalid method (patch by chmod222) git-svn-id: trunk@40393 - --- packages/fcl-web/src/base/httproute.pp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/fcl-web/src/base/httproute.pp b/packages/fcl-web/src/base/httproute.pp index 7277da08f3..50961109c6 100644 --- a/packages/fcl-web/src/base/httproute.pp +++ b/packages/fcl-web/src/base/httproute.pp @@ -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; From 090141a69c5dd500ee1c9543cc4ab2c1ee2a286f Mon Sep 17 00:00:00 2001 From: michael Date: Thu, 29 Nov 2018 15:34:00 +0000 Subject: [PATCH 07/11] * Allow to retrieve argument size, patch by Silvio Clecio (bug ID 34611) git-svn-id: trunk@40394 - --- packages/rtl-objpas/src/inc/rtti.pp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp index 109acfd021..c9de64a999 100644 --- a/packages/rtl-objpas/src/inc/rtti.pp +++ b/packages/rtl-objpas/src/inc/rtti.pp @@ -437,6 +437,7 @@ type TFunctionCallParameter = record ValueRef: Pointer; + ValueSize: SizeInt; Info: TFunctionCallParameterInfo; end; TFunctionCallParameterArray = specialize TArray; @@ -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; From a49c17fb7d7801f23e556510cdac2c681997f065 Mon Sep 17 00:00:00 2001 From: michael Date: Thu, 29 Nov 2018 15:37:16 +0000 Subject: [PATCH 08/11] * Allow redirect to local URL (patch by Michal GawRycki, bug ID #34595) git-svn-id: trunk@40395 - --- packages/fcl-web/src/base/fphttpclient.pp | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp index 72bd60dfdc..d3a4f88ebf 100644 --- a/packages/fcl-web/src/base/fphttpclient.pp +++ b/packages/fcl-web/src/base/fphttpclient.pp @@ -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 From f051e1b8dc2df5450ebd8f012a997d781a5ed04d Mon Sep 17 00:00:00 2001 From: michael Date: Thu, 29 Nov 2018 15:42:06 +0000 Subject: [PATCH 09/11] * Add Payload event git-svn-id: trunk@40396 - --- packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp b/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp index a1f85ce683..b911222caf 100644 --- a/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp +++ b/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp @@ -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; From a1fbde242d0e3d374993ea03d306635d1ab73764 Mon Sep 17 00:00:00 2001 From: pierre Date: Thu, 29 Nov 2018 16:55:07 +0000 Subject: [PATCH 10/11] Fix cleaning of unicode utils package in fpmake git-svn-id: trunk@40397 - --- utils/unicode/fpmake.pp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/utils/unicode/fpmake.pp b/utils/unicode/fpmake.pp index 00d26258b4..655e800b0c 100644 --- a/utils/unicode/fpmake.pp +++ b/utils/unicode/fpmake.pp @@ -37,8 +37,8 @@ begin 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; @@ -54,8 +54,6 @@ begin 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'); From 50ab607676f8a7eb9abd6e499dde5362d32bbdaf Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Thu, 29 Nov 2018 20:57:08 +0000 Subject: [PATCH 11/11] + customint torddef type to create arbitraty bit-width integers o use this to handle non-power-of-two-sized parameters for llvm o no general support in the parser/code generator, so don't expose git-svn-id: trunk@40398 - --- compiler/defcmp.pas | 6 +++-- compiler/defutil.pas | 12 ++++++---- compiler/htypechk.pas | 2 +- compiler/llvm/hlcgllvm.pas | 2 +- compiler/llvm/llvmdef.pas | 35 ++++++++++++++++++++++++++++-- compiler/ncgrtti.pas | 29 +++++++++++++++++++++---- compiler/psystem.pas | 24 ++++++++++++++++++++ compiler/symconst.pas | 2 +- compiler/symdef.pas | 26 +++++++++++++++++----- compiler/utils/ppuutils/ppudump.pp | 8 ++++++- 10 files changed, 125 insertions(+), 21 deletions(-) diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index d5d255a4a7..aa67939749 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -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 diff --git a/compiler/defutil.pas b/compiler/defutil.pas index 51808787ac..2f0053c66c 100644 --- a/compiler/defutil.pas +++ b/compiler/defutil.pas @@ -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; diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index a44735327e..4e97f903a9 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -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, diff --git a/compiler/llvm/hlcgllvm.pas b/compiler/llvm/hlcgllvm.pas index 7153c6dddb..5223847fd2 100644 --- a/compiler/llvm/hlcgllvm.pas +++ b/compiler/llvm/hlcgllvm.pas @@ -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 diff --git a/compiler/llvm/llvmdef.pas b/compiler/llvm/llvmdef.pas index 47b5b37cc3..78acbaf662 100644 --- a/compiler/llvm/llvmdef.pas +++ b/compiler/llvm/llvmdef.pas @@ -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); diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas index bed8321570..017e7f5a16 100644 --- a/compiler/ncgrtti.pas +++ b/compiler/ncgrtti.pas @@ -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); diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 650bb7121d..eb310d3542 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -261,8 +261,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 @@ -499,8 +507,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); @@ -632,8 +648,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); diff --git a/compiler/symconst.pas b/compiler/symconst.pas index bb5e65e72f..bc738463a7 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -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; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 8d438a1a8c..eaa21b680e 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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} diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp index c804dfaee2..b635d23fe3 100644 --- a/compiler/utils/ppuutils/ppudump.pp +++ b/compiler/utils/ppuutils/ppudump.pp @@ -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;