1{ /*************************************************************************** 2 compileroptions.pp - Lazarus IDE unit 3 --------------------------------------- 4 Compiler options sets the switches for the project 5 file for the FPC compiler. 6 7 8 Initial Revision : Sat May 10 23:15:32 CST 1999 9 10 11 ***************************************************************************/ 12 13 *************************************************************************** 14 * * 15 * This source is free software; you can redistribute it and/or modify * 16 * it under the terms of the GNU General Public License as published by * 17 * the Free Software Foundation; either version 2 of the License, or * 18 * (at your option) any later version. * 19 * * 20 * This code is distributed in the hope that it will be useful, but * 21 * WITHOUT ANY WARRANTY; without even the implied warranty of * 22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 23 * General Public License for more details. * 24 * * 25 * A copy of the GNU General Public License is available on the World * 26 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 27 * obtain it by writing to the Free Software Foundation, * 28 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 29 * * 30 *************************************************************************** 31 32} 33unit CompilerOptions; 34 35{$mode objfpc} 36{$H+} 37 38{$ifdef Trace} 39 {$ASSERTIONS ON} 40{$endif} 41 42interface 43 44uses 45 Classes, SysUtils, Laz_AVL_Tree, 46 // LCL 47 InterfaceBase, Forms, Controls, 48 // LazUtils 49 FileUtil, LazFileUtils, LazUTF8, Laz2_XMLCfg, Laz2_DOM, LazUtilities, LazTracer, 50 LazStringUtils, 51 // CodeTools 52 FileProcs, DefineTemplates, CodeToolsCfgScript, CodeToolManager, 53 KeywordFuncLists, BasicCodeTools, LinkScanner, 54 // IDEIntf 55 ProjectIntf, MacroIntf, IDEExternToolIntf, SrcEditorIntf, CompOptsIntf, 56 IDEOptionsIntf, 57 // IDE 58 LazarusIDEStrConsts, IDEProcs, LazConf, TransferMacros, etFPCMsgParser, 59 IDECmdLine, ModeMatrixOpts, CompOptsModes, EnvironmentOpts; 60 61const 62 DefaultCompilerPath = '$(CompPath)'; 63type 64 65 TCheckCompileOptionsMsgLvl = ( 66 ccomlHints, 67 ccomlWarning, 68 ccomlErrors, 69 ccomlNone 70 ); 71 72 TIDEBuildMacros = class; 73 74 { TIDEBuildMacro } 75 76 TIDEBuildMacro = class(TLazBuildMacro) 77 private 78 FChangeStamp: integer; 79 protected 80 procedure SetIdentifier(const AValue: string); override; 81 procedure SetDescription(const AValue: string); override; 82 procedure SetValueDescriptions(const AValue: TStrings); override; 83 procedure SetValues(const AValue: TStrings); override; 84 public 85 constructor Create; 86 destructor Destroy; override; 87 procedure Assign(Source: TLazBuildMacro); override; 88 function Equals(Other: TLazBuildMacro): boolean; reintroduce; 89 procedure LoadFromXMLConfig(aXMLConfig: TXMLConfig; const Path: string; 90 {%H-}DoSwitchPathDelims: boolean); 91 procedure SaveToXMLConfig(aXMLConfig: TXMLConfig; const Path: string; 92 {%H-}UsePathDelim: TPathDelimSwitch); 93 function CreateDiff(OtherMode: TLazBuildMacro; Tool: TCompilerDiffTool = nil): boolean; 94 procedure IncreaseChangeStamp; 95 property ChangeStamp: integer read FChangeStamp; 96 end; 97 98 { TIDEBuildMacros 99 - every package and project has this list of build macros 100 every build macro has 101 - a list of possible values 102 - and has a default value, or an expression to define the default 103 the expression can use other build macros } 104 TIDEBuildMacros = class(TLazBuildMacros) 105 protected 106 FItems: TFPList;// list of TIDEBuildMacro 107 function GetItems(Index: integer): TLazBuildMacro; override; 108 public 109 function Add(Identifier: string): TLazBuildMacro; override; 110 procedure Clear; override; 111 function Count: integer; override; 112 constructor Create(TheOwner: TObject); override; 113 procedure Delete(Index: integer); override; 114 destructor Destroy; override; 115 function IndexOfIdentifier(Identifier: string): integer; override; 116 function VarWithIdentifier(Identifier: string): TIDEBuildMacro; override; 117 procedure Move(OldIndex, NewIndex: integer); override; 118 procedure LoadFromXMLConfig(AXMLConfig: TXMLConfig; const Path: string; 119 DoSwitchPathDelims: boolean); 120 procedure SaveToXMLConfig(AXMLConfig: TXMLConfig; const Path: string; 121 UsePathDelim: TPathDelimSwitch); 122 function CreateDiff(OtherProperties: TLazBuildMacros; 123 Tool: TCompilerDiffTool = nil): boolean; 124 procedure Assign(Source: TLazBuildMacros); 125 end; 126 127const 128 DefaultConditionals = 129 '// example for adding linker options on Mac OS X'+LineEnding 130 +'//if TargetOS=''darwin'' then'+LineEnding 131 +'// LinkerOptions := '' -framework OpenGL'';'+LineEnding 132 +LineEnding 133 +'// example for adding a unit and include path on Windows'+LineEnding 134 +'//if SrcOS=''win'' then begin'+LineEnding 135 +'// UnitPath += '';win'';'+LineEnding 136 +'// IncPath += '';win'';'+LineEnding 137 +'//end;' 138 ; 139 140type 141 142 { TIDECfgScriptEngine } 143 144 TIDECfgScriptEngine = class(TCTConfigScriptEngine) 145 private 146 FProjValuesAvailable: boolean; 147 protected 148 function IsCustomFunction(FunctionName: PChar): boolean; override; 149 procedure RunCustomSimpleFunction(FunctionName: PChar; 150 Value: PCTCfgScriptVariable); override; 151 public 152 property ProjValuesAvailable: boolean read FProjValuesAvailable write FProjValuesAvailable; 153 end; 154 155type 156 TInheritedCompilerOption = ( 157 icoNone, 158 icoUnitPath, 159 icoNamespaces, 160 icoIncludePath, 161 icoObjectPath, 162 icoLibraryPath, 163 icoSrcPath, 164 icoLinkerOptions, 165 icoCustomOptions 166 ); 167 TInheritedCompilerOptions = set of TInheritedCompilerOption; 168 169 TInheritedCompOptsStrings = array[TInheritedCompilerOption] of string; 170 171const 172 icoAllSearchPaths = [icoUnitPath,icoIncludePath,icoObjectPath,icoLibraryPath, 173 icoSrcPath]; 174 175type 176 { TParsedCompilerOptions } 177 178 TParsedCompilerOptString = ( 179 pcosNone, 180 pcosBaseDir, // the base directory for the relative paths (only auto created packages can have macros in the BaseDir) 181 pcosUnitPath, // search path for pascal units 182 pcosNamespaces, // namespaces 183 pcosIncludePath, // search path for pascal include files 184 pcosObjectPath, // search path for .o files 185 pcosLibraryPath, // search path for libraries 186 pcosSrcPath, // additional search path for pascal source files 187 pcosLinkerOptions,// additional linker options 188 pcosCustomOptions,// additional options 189 pcosOutputDir, // the output directory 190 pcosCompilerPath, // the filename of the compiler 191 pcosDebugPath, // additional debug search path 192 pcosMsgFile // fpc message file (errore.msg) 193 ); 194 TParsedCompilerOptStrings = set of TParsedCompilerOptString; 195 196 197const 198 ParsedCompilerSearchPaths = [pcosUnitPath,pcosIncludePath,pcosObjectPath, 199 pcosLibraryPath,pcosSrcPath,pcosDebugPath]; 200 ParsedCompilerFilenames = [pcosCompilerPath,pcosMsgFile]; 201 ParsedCompilerDirectories = [pcosOutputDir]; 202 ParsedCompilerOutDirectories = [pcosOutputDir]; 203 ParsedCompilerFiles = 204 ParsedCompilerSearchPaths+ParsedCompilerFilenames+ParsedCompilerDirectories; 205 206 ParsedCompilerOptsVars: array[TParsedCompilerOptString] of string = ( 207 '', 208 '', 209 'UnitPath', 210 'Namespaces', 211 'IncPath', 212 'ObjectPath', 213 'LibraryPath', 214 'SrcPath', 215 'LinkerOptions', 216 'CustomOptions', 217 'OutputDir', 218 'CompilerPath', 219 'DebugPath', 220 'MsgFile' 221 ); 222 ParsedCompilerOptsUsageVars: array[TParsedCompilerOptString] of string = ( 223 '', 224 '', 225 'UsageUnitPath', 226 'UsageNamespaces', 227 'UsageIncPath', 228 'UsageObjectPath', 229 'UsageLibraryPath', 230 'UsageSrcPath', 231 'UsageLinkerOptions', 232 'UsageCustomOptions', 233 '', 234 '', 235 'UsageDebugPath', 236 '' 237 ); 238 InheritedToParsedCompilerOption: array[TInheritedCompilerOption] of 239 TParsedCompilerOptString = ( 240 pcosNone, 241 pcosUnitPath, // icoUnitPath, 242 pcosNamespaces, // icoNamespaces, 243 pcosIncludePath, // icoIncludePath, 244 pcosObjectPath, // icoObjectPath, 245 pcosLibraryPath, // icoLibraryPath, 246 pcosSrcPath, // icoSrcPath, 247 pcosLinkerOptions, // icoLinkerOptions, 248 pcosCustomOptions // icoCustomOptions 249 ); 250 251 CompilerOptionMacroNormal = 0; 252 CompilerOptionMacroPlatformIndependent = 1; 253 254type 255 TLocalSubstitutionEvent = function(const s: string; 256 PlatformIndependent: boolean): string of object; 257 258 TInheritedCompOptsParseTypesStrings = 259 array[TCompilerOptionsParseType] of TInheritedCompOptsStrings; 260 261 { TParsedCompilerOptions } 262 263 TParsedCompilerOptions = class 264 private 265 FInvalidateParseOnChange: boolean; 266 FOnLocalSubstitute: TLocalSubstitutionEvent; 267 FOutputDirectoryOverride: string; 268 FOwner: TObject; 269 procedure SetOutputDirectoryOverride(const AValue: string); 270 public 271 // parsed 272 Values: array[TParsedCompilerOptString] of TParseString; 273 ParsedErrorOption: TParsedCompilerOptString; 274 ParsedErrorMsg: string; 275 ParsedErrorStamp: integer; // see CompilerParseStamp 276 // parsed except for platform macros 277 ParsedPIValues: array[TParsedCompilerOptString] of string; 278 ParsedPIStamp: array[TParsedCompilerOptString] of integer; // see CompilerParseStamp 279 ParsingPI: array[TParsedCompilerOptString] of boolean; 280 // macro values 281 InheritedMacroValues: TCTCfgScriptVariables; 282 InheritedMacroValuesStamp: integer; // see BuildMacroChangeStamp 283 InheritedMacroValuesParsing: boolean; 284 MacroValues: TIDECfgScriptEngine; 285 MacroValuesStamp: integer; // see BuildMacroChangeStamp 286 MacroValuesParsing: boolean; 287 constructor Create(TheOwner: TObject); 288 destructor Destroy; override; 289 function HasParsedError: boolean; 290 procedure ParsedError(Option: TParsedCompilerOptString; Msg: string); 291 function GetUnparsedWithConditionals(Option: TParsedCompilerOptString): string; 292 function GetParsedValue(Option: TParsedCompilerOptString; 293 WithOverrides: boolean = true): string; 294 function GetParsedPIValue(Option: TParsedCompilerOptString): string;// platform independent 295 procedure SetUnparsedValue(Option: TParsedCompilerOptString; 296 const NewValue: string); 297 function DoParseOption(const OptionText: string; 298 Option: TParsedCompilerOptString; 299 PlatformIndependent: boolean): string; 300 procedure Assign(Src: TParsedCompilerOptions); 301 procedure Clear; 302 procedure InvalidateAll; 303 procedure InvalidateFiles; 304 procedure RenameMacro(const OldName, NewName: string; 305 out Changed: TParsedCompilerOptStrings); // rename macro in UnparsedValues 306 public 307 property Owner: TObject read FOwner; 308 property OnLocalSubstitute: TLocalSubstitutionEvent read FOnLocalSubstitute 309 write FOnLocalSubstitute; 310 property InvalidateParseOnChange: boolean read FInvalidateParseOnChange 311 write FInvalidateParseOnChange; 312 property OutputDirectoryOverride: string read FOutputDirectoryOverride 313 write SetOutputDirectoryOverride; 314 end; 315 316 TParseStringEvent = 317 function(Options: TParsedCompilerOptions; 318 const UnparsedValue: string; PlatformIndependent: boolean 319 ): string of object; 320 321 322 { TBaseCompilerOptions } 323 324 TCompilerCmdLineOption = ( 325 ccloNoLinkerOpts, // exclude linker options 326 ccloAddVerboseAll, // add -va 327 ccloDoNotAppendOutFileOption, // do not add -o option 328 ccloAbsolutePaths, 329 ccloNoMacroParams, // no search paths, no linker options, no custom options 330 ccloAddCompilerPath 331 ); 332 TCompilerCmdLineOptions = set of TCompilerCmdLineOption; 333 334 { TCompilationToolOptions } 335 336 TCompilationToolOptions = class(TLazCompilationToolOptions) 337 private 338 FParsedCommandStamp: integer; 339 FParsedCommand: string; 340 protected 341 procedure SetCommand(AValue: string); override; 342 procedure SubstituteMacros(var s: string); virtual; 343 public 344 function CreateDiff(CompOpts: TCompilationToolOptions; 345 Tool: TCompilerDiffTool = nil): boolean; virtual; 346 procedure Assign(Src: TLazCompilationToolOptions); override; 347 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; 348 DoSwitchPathDelims: boolean); virtual; 349 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 350 UsePathDelim: TPathDelimSwitch); virtual; 351 function Execute(const WorkingDir, ToolTitle, CompileHint: string): TModalResult; 352 function CreateExtTool(const WorkingDir, ToolTitle, CompileHint: string): TAbstractExternalTool; 353 function GetParsedCommand: string; // resolved macros 354 function HasCommands: boolean; // true if there is something to execute 355 end; 356 357 TCompilerMsgIdFlag = record 358 MsgId: integer; 359 Flag: TCompilerFlagValue; 360 end; 361 PCompilerMsgIdFlag = ^TCompilerMsgIdFlag; 362 363 { TCompilerMsgIDFlagsEnumerator } 364 365 TCompilerMsgIDFlagsEnumerator = class 366 protected 367 FTree: TAvlTree; 368 FCurrent: TAvlTreeNode; 369 function GetCurrent: PCompilerMsgIdFlag; inline; 370 public 371 constructor Create(Tree: TAvlTree); 372 function GetEnumerator: TCompilerMsgIDFlagsEnumerator; inline; 373 function MoveNext: Boolean; 374 property Current: PCompilerMsgIdFlag read GetCurrent; 375 end; 376 377 { TCompilerMsgIDFlags } 378 379 TCompilerMsgIDFlags = class(TAbstractCompilerMsgIDFlags) 380 private 381 FChangeStamp: int64; 382 fLastSavedStamp: int64; 383 fTree: TAvlTree; // tree of TCompilerMsgIdFlag 384 function FindNode(MsgId: integer): TAvlTreeNode; 385 protected 386 function GetValues(MsgId: integer): TCompilerFlagValue; override; 387 function GetModified: boolean; override; 388 procedure SetModified(AValue: boolean); override; 389 procedure SetValues(MsgId: integer; AValue: TCompilerFlagValue); override; 390 public 391 constructor Create; 392 destructor Destroy; override; 393 procedure Clear; override; 394 procedure Assign(Source: TPersistent); override; 395 function Equals(Obj: TObject): boolean; override; 396 procedure IncreaseChangeStamp; 397 function GetEnumerator: TCompilerMsgIDFlagsEnumerator; 398 function GetMsgIdList(Delim: char; aValue: TCompilerFlagValue; FPCMsgFile: TFPCMsgFilePoolItem = nil): string; 399 function CreateDiff(Tool: TCompilerDiffTool; Other: TCompilerMsgIDFlags): boolean; 400 function Count: SizeInt; inline; 401 property ChangeStamp: int64 read FChangeStamp; 402 end; 403 404type 405 { TBaseCompilerOptions } 406 407 TBaseCompilerOptions = class(TLazCompilerOptions) 408 private 409 FDefaultMakeOptionsFlags: TCompilerCmdLineOptions; 410 fInheritedOptions: TInheritedCompOptsParseTypesStrings; 411 fInheritedOptParseStamps: integer; 412 FParsedOpts: TParsedCompilerOptions; 413 FStorePathDelim: TPathDelimSwitch; 414 FOtherDefines: TStrings; // list of user selectable defines for custom options 415 FFPCMsgFile: TFPCMsgFilePoolItem; 416 FCreateMakefileOnBuild: boolean; 417 procedure AppendDefaultExt(var aFilename: string); 418 function GetExecuteAfter: TCompilationToolOptions; 419 function GetExecuteBefore: TCompilationToolOptions; 420 procedure PrependDefaultType(var AFilename: string); 421 procedure SetCreateMakefileOnBuild(AValue: boolean); 422 protected 423 function GetCompilerPath: String; override; 424 function GetBaseDirectory: string; 425 function GetCustomOptions: string; override; 426 function GetDebugPath: string; override; 427 function GetIncludePaths: String; override; 428 function GetLibraryPaths: String; override; 429 function GetNamespaces: String; override; 430 function GetObjectPath: string; override; 431 function GetSrcPath: string; override; 432 function GetUnitOutputDir: string; override; 433 function GetUnitPaths: String; override; 434 procedure SetBaseDirectory(AValue: string); 435 procedure SetCompilerPath(const AValue: String); override; 436 procedure SetConditionals(AValue: string); override; 437 procedure SetCustomOptions(const AValue: string); override; 438 procedure SetIncludePaths(const AValue: String); override; 439 procedure SetLibraryPaths(const AValue: String); override; 440 procedure SetLinkerOptions(const AValue: String); override; 441 procedure SetNamespaces(const AValue: String); override; 442 procedure SetUnitPaths(const AValue: String); override; 443 procedure SetUnitOutputDir(const AValue: string); override; 444 procedure SetObjectPath(const AValue: string); override; 445 procedure SetSrcPath(const AValue: string); override; 446 procedure SetDebugPath(const AValue: string); override; 447 procedure SetTargetCPU(const AValue: string); override; 448 procedure SetTargetProc(const AValue: string); override; 449 procedure SetTargetOS(const AValue: string); override; 450 procedure SetTargetFileExt(const AValue: String); override; 451 procedure SetTargetFilename(const AValue: String); override; 452 protected 453 function GetModified: boolean; override; 454 procedure SetModified(const AValue: boolean); override; 455 procedure ClearInheritedOptions; 456 procedure SetDefaultMakeOptionsFlags(const AValue: TCompilerCmdLineOptions); 457 public 458 constructor Create(const AOwner: TObject); override; 459 constructor Create(const AOwner: TObject; const AToolClass: TLazCompilationToolClass); 460 destructor Destroy; override; 461 procedure Clear; virtual; 462 class function GetInstance: TAbstractIDEOptions; override; 463 class function GetGroupCaption: string; override; 464 465 procedure LoadFromXMLConfig(AXMLConfig: TXMLConfig; const Path: string); virtual; 466 procedure SaveToXMLConfig(AXMLConfig: TXMLConfig; const Path: string); virtual; 467 468 function LoadFromFile(AFilename: string): TModalResult; 469 function SaveToFile(AFilename: string): TModalResult; 470 procedure Assign(Source: TPersistent); override; 471 function IsEqual(CompOpts: TBaseCompilerOptions): boolean; virtual; 472 procedure CreateDiffAsText(CompOpts: TBaseCompilerOptions; Diff: TStrings); 473 function CreateDiff(CompOpts: TBaseCompilerOptions; 474 Tool: TCompilerDiffTool = nil): boolean; virtual;// true if differ 475 476 procedure SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); override; 477 478 function MakeOptionsString(Flags: TCompilerCmdLineOptions): String; virtual; 479 function GetSyntaxOptionsString(Kind: TPascalCompiler): string; virtual; 480 function CreatePPUFilename(const SourceFileName: string): string; override; 481 function CreateTargetFilename: string; override; 482 function GetTargetFileExt: string; virtual; 483 function GetTargetFilePrefix: string; virtual; 484 procedure GetInheritedCompilerOptions(var OptionsList: TFPList // list of TAdditionalCompilerOptions 485 ); virtual; 486 function GetOwnerName: string; virtual; 487 function GetInheritedOption(Option: TInheritedCompilerOption; 488 RelativeToBaseDir: boolean; 489 Parsed: TCompilerOptionsParseType = coptParsed 490 ): string; virtual; 491 function GetDefaultMainSourceFileName: string; virtual; 492 function CanBeDefaulForProject: boolean; virtual; 493 function NeedsLinkerOpts: boolean; 494 function HasCommands: boolean; // true if there is at least one commad to execute 495 function HasCompilerCommand: boolean; virtual; 496 function GetEffectiveTargetOS: string; override; 497 function GetEffectiveTargetCPU: string; override; 498 function GetEffectiveLCLWidgetType: string; override; 499 // parsed CompilerFilename: use ParsedOpts.GetParsedValue(pcosCompilerPath) 500 function GetUnitPath(RelativeToBaseDir: boolean; 501 Parsed: TCompilerOptionsParseType = coptParsed; 502 WithBaseDir: boolean = true): string; override; 503 function GetNamespacesParsed(Parsed: TCompilerOptionsParseType = coptParsed): string; override; 504 function GetIncludePath(RelativeToBaseDir: boolean; 505 Parsed: TCompilerOptionsParseType = coptParsed; 506 WithBaseDir: boolean = true): string; override; 507 function GetSrcPath(RelativeToBaseDir: boolean; 508 Parsed: TCompilerOptionsParseType = coptParsed; 509 WithBaseDir: boolean = true): string; override; 510 function GetDebugPath(RelativeToBaseDir: boolean; 511 Parsed: TCompilerOptionsParseType = coptParsed; 512 WithBaseDir: boolean = true): string; override; 513 function GetLibraryPath(RelativeToBaseDir: boolean; 514 Parsed: TCompilerOptionsParseType = coptParsed; 515 WithBaseDir: boolean = true): string; override; 516 function GetUnitOutputDirectory(RelativeToBaseDir: boolean): string; override; 517 function GetUnitOutPath(RelativeToBaseDir: boolean; 518 Parsed: TCompilerOptionsParseType = coptParsed): string; 519 function GetObjectPath(RelativeToBaseDir: boolean; 520 Parsed: TCompilerOptionsParseType = coptParsed; 521 WithBaseDir: boolean = true): string; override; 522 function GetPath(Option: TParsedCompilerOptString; 523 InheritedOption: TInheritedCompilerOption; 524 RelativeToBaseDir: boolean; 525 Parsed: TCompilerOptionsParseType; 526 WithBaseDir: boolean): string; 527 function GetParsedPath(Option: TParsedCompilerOptString; 528 InheritedOption: TInheritedCompilerOption; 529 RelativeToBaseDir: boolean; 530 AddBaseDir: boolean = false): string; 531 function GetParsedPIPath(Option: TParsedCompilerOptString; 532 InheritedOption: TInheritedCompilerOption; 533 RelativeToBaseDir: boolean): string; 534 function GetUnparsedPath(Option: TParsedCompilerOptString; 535 InheritedOption: TInheritedCompilerOption; 536 RelativeToBaseDir: boolean): string; 537 function ShortenPath(const SearchPath: string): string; 538 function GetCustomOptions(Parsed: TCompilerOptionsParseType): string; 539 function TrimCustomOptions(o: string): string; override; 540 function GetOptionsForCTDefines: string; 541 // rename macro in paths and options, not in BuildMacros, not in dependencies 542 procedure RenameMacro(const OldName, NewName: string; 543 ChangeConditionals: boolean); virtual; 544 procedure MergeToIncludePaths(const AddSearchPath: string); 545 procedure MergeToLibraryPaths(const AddSearchPath: string); 546 procedure MergeToNamespaces(const AddNamespaces: string); 547 procedure MergeToUnitPaths(const AddSearchPath: string); 548 procedure MergeToObjectPath(const AddSearchPath: string); 549 procedure MergeToSrcPath(const AddSearchPath: string); 550 procedure MergeToDebugPath(const AddSearchPath: string); 551 procedure RemoveFromUnitPaths(const RemSearchPath: string); 552 // compiler message types by id 553 function IDEMessageFlags: TCompilerMsgIDFlags; inline; 554 public 555 // not stored properties 556 property ParsedOpts: TParsedCompilerOptions read FParsedOpts; 557 property BaseDirectory: string read GetBaseDirectory write SetBaseDirectory; 558 property DefaultMakeOptionsFlags: TCompilerCmdLineOptions 559 read FDefaultMakeOptionsFlags write SetDefaultMakeOptionsFlags; 560 // stored properties 561 property StorePathDelim: TPathDelimSwitch read FStorePathDelim write FStorePathDelim; 562 property OtherDefines: TStrings read FOtherDefines; 563 // compilation 564 property ExecuteBefore: TCompilationToolOptions read GetExecuteBefore; 565 property ExecuteAfter: TCompilationToolOptions read GetExecuteAfter; 566 property CreateMakefileOnBuild: boolean read FCreateMakefileOnBuild 567 write SetCreateMakefileOnBuild; 568 end; 569 570 TBaseCompilerOptionsClass = class of TBaseCompilerOptions; 571 572 { TAdditionalCompilerOptions 573 574 Additional Compiler options are used by packages to define, what a project 575 or a package or the IDE needs to use the package. 576 } 577 TAdditionalCompilerOptions = class 578 private 579 fOwner: TObject; 580 FParsedOpts: TParsedCompilerOptions; 581 protected 582 function GetBaseDirectory: string; 583 function GetCustomOptions: string; virtual; 584 function GetIncludePath: string; virtual; 585 function GetLibraryPath: string; virtual; 586 function GetLinkerOptions: string; virtual; 587 function GetNamespaces: string; virtual; 588 function GetObjectPath: string; virtual; 589 function GetSrcPath: string; virtual; 590 function GetUnitPath: string; virtual; 591 procedure SetBaseDirectory(const AValue: string); virtual; 592 procedure SetCustomOptions(const AValue: string); virtual; 593 procedure SetIncludePath(const AValue: string); virtual; 594 procedure SetLibraryPath(const AValue: string); virtual; 595 procedure SetLinkerOptions(const AValue: string); virtual; 596 procedure SetNamespaces(const AValue: string); virtual; 597 procedure SetObjectPath(const AValue: string); virtual; 598 procedure SetSrcPath(const AValue: string); virtual; 599 procedure SetUnitPath(const AValue: string); virtual; 600 public 601 constructor Create(TheOwner: TObject); 602 destructor Destroy; override; 603 procedure Clear; 604 procedure AssignOptions(Source: TObject); virtual; 605 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; 606 AdjustPathDelims: boolean); 607 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 608 UsePathDelim: TPathDelimSwitch); 609 function GetOwnerName: string; virtual; 610 function GetOption(AnOption: TInheritedCompilerOption): string; 611 function GetBaseCompilerOptions: TBaseCompilerOptions; virtual; 612 public 613 property Owner: TObject read fOwner; 614 property UnitPath: string read GetUnitPath write SetUnitPath; 615 property Namespaces: string read GetNamespaces write SetNamespaces; 616 property IncludePath: string read GetIncludePath write SetIncludePath; 617 property SrcPath: string read GetSrcPath write SetSrcPath; 618 property ObjectPath: string read GetObjectPath write SetObjectPath; 619 property LibraryPath: string read GetLibraryPath write SetLibraryPath; 620 property LinkerOptions: string read GetLinkerOptions write SetLinkerOptions; 621 property CustomOptions: string read GetCustomOptions write SetCustomOptions; 622 property BaseDirectory: string read GetBaseDirectory write SetBaseDirectory; 623 property ParsedOpts: TParsedCompilerOptions read FParsedOpts; 624 end; 625 626 627 { TCompilerOptions } 628 629 TCompilerOptions = TBaseCompilerOptions; 630 631const 632 CompileReasonNames: array[TCompileReason] of string = ( 633 'Compile', 634 'Build', 635 'Run' 636 ); 637 638var 639 OnParseString: TParseStringEvent = nil; 640 641function EnumToStr(opt: TParsedCompilerOptString): string; overload; 642function ParseString(Options: TParsedCompilerOptions; 643 const UnparsedValue: string; 644 PlatformIndependent: boolean): string; 645function GetMakefileMacroValue(const MacroName: string): string; 646function TargetNeedsFPCOptionCG(TargetOS, TargetCPU: string): boolean; 647 648procedure GatherInheritedOptions(AddOptionsList: TFPList; 649 Parsed: TCompilerOptionsParseType; 650 var InheritedOptionStrings: TInheritedCompOptsStrings); 651function InheritedOptionsToCompilerParameters( 652 var InheritedOptionStrings: TInheritedCompOptsStrings; 653 Flags: TCompilerCmdLineOptions): string; 654function MergeLinkerOptions(const OldOptions, AddOptions: string): string; 655function MergeCustomOptions(const OldOptions, AddOptions: string): string; 656function ConvertSearchPathToCmdLine(const switch, paths: String): String; 657function ConvertOptionsToCmdLine(const Switch, OptionStr: string): string; 658 659type 660 TGetBuildMacroValues = function(Options: TBaseCompilerOptions; 661 IncludeSelf: boolean): TCTCfgScriptVariables of object; 662 TOnAppendCustomOptions = procedure(Sender: TObject; 663 var CustomOptions: string; Types: TBuildMatrixGroupTypes) of object; 664 TOnGetOutputDirectoryOverride = procedure(Sender: TObject; 665 var OutDir: string; Types: TBuildMatrixGroupTypes) of object; 666var 667 GetBuildMacroValues: TGetBuildMacroValues = nil; // set by TPkgManager, do not change or free the variables 668 OnAppendCustomOption: TOnAppendCustomOptions = nil; // set by MainBuildBoss 669 OnGetOutputDirectoryOverride: TOnGetOutputDirectoryOverride = nil; // set by MainBuildBoss 670 671function LoadXMLCompileReasons(const AConfig: TXMLConfig; 672 const APath: String; const DefaultReasons: TCompileReasons): TCompileReasons; 673procedure SaveXMLCompileReasons(const AConfig: TXMLConfig; const APath: String; 674 const AFlags, DefaultFlags: TCompileReasons); 675 676function EnumToStr(Flag: TCompilerFlagValue): string; overload; 677function CompareCompMsgIdFlag(Data1, Data2: Pointer): integer; 678 679var 680 TestCompilerOptions: TNotifyEvent = nil; 681 682implementation 683 684const 685 CompilerOptionsVersion = 11; 686 // 11 Debugging/DebugInfoType/Value 687 // 7 TargetProcessor/Value 688 // 6 SyntaxMode/Value 689 690function EnumToStr(opt: TParsedCompilerOptString): string; 691begin 692 Result:=''; 693 WriteStr(Result, opt); 694end; 695 696function ParseString(Options: TParsedCompilerOptions; 697 const UnparsedValue: string; PlatformIndependent: boolean): string; 698begin 699 Result:=OnParseString(Options,UnparsedValue,PlatformIndependent); 700end; 701 702function GetMakefileMacroValue(const MacroName: string): string; 703begin 704 if SysUtils.CompareText('TargetCPU',MacroName)=0 then 705 Result:='%(CPU_TARGET)' 706 else if SysUtils.CompareText('TargetOS',MacroName)=0 then 707 Result:='%(OS_TARGET)' 708 else if SysUtils.CompareText('LCLWidgetType',MacroName)=0 then 709 Result:='%(LCL_PLATFORM)' 710 else 711 Result:=''; 712end; 713 714function TargetNeedsFPCOptionCG(TargetOS, TargetCPU: string): boolean; 715begin 716 Result:= (TargetCPU='x86_64') 717 and ((TargetOS='linux') or (TargetOS='freebsd') or (TargetOS='netbsd') 718 or (TargetOS='openbsd') or (TargetOS='dragonfly') or (TargetOS='solaris')); 719end; 720 721procedure GatherInheritedOptions(AddOptionsList: TFPList; 722 Parsed: TCompilerOptionsParseType; 723 var InheritedOptionStrings: TInheritedCompOptsStrings); 724var 725 i: Integer; 726 AddOptions: TAdditionalCompilerOptions; 727 o: TInheritedCompilerOption; 728 UnparsedOption: String; 729 CurOptions: String; 730begin 731 if AddOptionsList<>nil then begin 732 for i:=0 to AddOptionsList.Count-1 do begin 733 AddOptions:=TAdditionalCompilerOptions(AddOptionsList[i]); 734 if (not (AddOptions is TAdditionalCompilerOptions)) then continue; 735 736 case Parsed of 737 coptParsed: 738 begin 739 // unit search path 740 InheritedOptionStrings[icoUnitPath]:= 741 MergeSearchPaths(InheritedOptionStrings[icoUnitPath], 742 AddOptions.ParsedOpts.GetParsedValue(pcosUnitPath)); 743 // namespaces 744 InheritedOptionStrings[icoNamespaces]:= 745 MergeSearchPaths(InheritedOptionStrings[icoNamespaces], 746 AddOptions.ParsedOpts.GetParsedValue(pcosNamespaces)); 747 // include search path 748 InheritedOptionStrings[icoIncludePath]:= 749 MergeSearchPaths(InheritedOptionStrings[icoIncludePath], 750 AddOptions.ParsedOpts.GetParsedValue(pcosIncludePath)); 751 // src search path 752 InheritedOptionStrings[icoSrcPath]:= 753 MergeSearchPaths(InheritedOptionStrings[icoSrcPath], 754 AddOptions.ParsedOpts.GetParsedValue(pcosSrcPath)); 755 // object search path 756 InheritedOptionStrings[icoObjectPath]:= 757 MergeSearchPaths(InheritedOptionStrings[icoObjectPath], 758 AddOptions.ParsedOpts.GetParsedValue(pcosObjectPath)); 759 // library search path 760 InheritedOptionStrings[icoLibraryPath]:= 761 MergeSearchPaths(InheritedOptionStrings[icoLibraryPath], 762 AddOptions.ParsedOpts.GetParsedValue(pcosLibraryPath)); 763 // linker options 764 InheritedOptionStrings[icoLinkerOptions]:= 765 MergeLinkerOptions(InheritedOptionStrings[icoLinkerOptions], 766 AddOptions.ParsedOpts.GetParsedValue(pcosLinkerOptions)); 767 // custom options 768 InheritedOptionStrings[icoCustomOptions]:= 769 MergeCustomOptions(InheritedOptionStrings[icoCustomOptions], 770 AddOptions.ParsedOpts.GetParsedValue(pcosCustomOptions)); 771 end; 772 773 coptParsedPlatformIndependent: 774 begin 775 // unit search path 776 InheritedOptionStrings[icoUnitPath]:= 777 MergeSearchPaths(InheritedOptionStrings[icoUnitPath], 778 AddOptions.ParsedOpts.GetParsedPIValue(pcosUnitPath)); 779 // namespaces 780 InheritedOptionStrings[icoNamespaces]:= 781 MergeSearchPaths(InheritedOptionStrings[icoNamespaces], 782 AddOptions.ParsedOpts.GetParsedPIValue(pcosNamespaces)); 783 // include search path 784 InheritedOptionStrings[icoIncludePath]:= 785 MergeSearchPaths(InheritedOptionStrings[icoIncludePath], 786 AddOptions.ParsedOpts.GetParsedPIValue(pcosIncludePath)); 787 // src search path 788 InheritedOptionStrings[icoSrcPath]:= 789 MergeSearchPaths(InheritedOptionStrings[icoSrcPath], 790 AddOptions.ParsedOpts.GetParsedPIValue(pcosSrcPath)); 791 // object search path 792 InheritedOptionStrings[icoObjectPath]:= 793 MergeSearchPaths(InheritedOptionStrings[icoObjectPath], 794 AddOptions.ParsedOpts.GetParsedPIValue(pcosObjectPath)); 795 // library search path 796 InheritedOptionStrings[icoLibraryPath]:= 797 MergeSearchPaths(InheritedOptionStrings[icoLibraryPath], 798 AddOptions.ParsedOpts.GetParsedPIValue(pcosLibraryPath)); 799 // linker options 800 InheritedOptionStrings[icoLinkerOptions]:= 801 MergeLinkerOptions(InheritedOptionStrings[icoLinkerOptions], 802 AddOptions.ParsedOpts.GetParsedPIValue(pcosLinkerOptions)); 803 // custom options 804 InheritedOptionStrings[icoCustomOptions]:= 805 MergeCustomOptions(InheritedOptionStrings[icoCustomOptions], 806 AddOptions.ParsedOpts.GetParsedPIValue(pcosCustomOptions)); 807 end; 808 809 coptUnparsed: 810 for o:=Low(TInheritedCompilerOption) to High(TInheritedCompilerOption) 811 do begin 812 UnparsedOption:=AddOptions.GetOption(o); 813 if UnparsedOption<>'' then begin 814 815 CurOptions:=InheritedOptionStrings[o]; 816 case o of 817 icoNone: ; 818 icoUnitPath,icoNamespaces,icoIncludePath,icoSrcPath,icoObjectPath, 819 icoLibraryPath: 820 CurOptions:=MergeWithDelimiter(CurOptions,UnparsedOption,';'); 821 icoLinkerOptions,icoCustomOptions: 822 CurOptions:=MergeWithDelimiter(CurOptions,UnparsedOption,' '); 823 else 824 RaiseGDBException('GatherInheritedOptions'); 825 end; 826 InheritedOptionStrings[o]:=CurOptions; 827 end; 828 end; 829 end; 830 end; 831 end; 832end; 833 834function InheritedOptionsToCompilerParameters( 835 var InheritedOptionStrings: TInheritedCompOptsStrings; 836 Flags: TCompilerCmdLineOptions): string; 837var 838 CurLinkerOpts: String; 839 CurIncludePath: String; 840 CurLibraryPath: String; 841 CurObjectPath: String; 842 CurUnitPath: String; 843 CurCustomOptions, CurNamespaces: String; 844begin 845 Result:=''; 846 847 // inherited Linker options 848 if (not (ccloNoLinkerOpts in Flags)) then begin 849 CurLinkerOpts:=InheritedOptionStrings[icoLinkerOptions]; 850 if CurLinkerOpts<>'' then 851 Result := Result + ' ' + ConvertOptionsToCmdLine('-k', CurLinkerOpts); 852 end; 853 854 // include path 855 CurIncludePath:=InheritedOptionStrings[icoIncludePath]; 856 if (CurIncludePath <> '') then 857 Result := Result + ' ' + ConvertSearchPathToCmdLine('-Fi', CurIncludePath); 858 859 // library path 860 if (not (ccloNoLinkerOpts in Flags)) then begin 861 CurLibraryPath:=InheritedOptionStrings[icoLibraryPath]; 862 if (CurLibraryPath <> '') then 863 Result := Result + ' ' + ConvertSearchPathToCmdLine('-Fl', CurLibraryPath); 864 end; 865 866 // namespaces 867 CurNamespaces:=InheritedOptionStrings[icoNamespaces]; 868 if CurNamespaces <> '' then 869 Result := Result + ' -FN'+CurNamespaces; 870 871 // object path 872 CurObjectPath:=InheritedOptionStrings[icoObjectPath]; 873 if (CurObjectPath <> '') then 874 Result := Result + ' ' + ConvertSearchPathToCmdLine('-Fo', CurObjectPath); 875 876 // unit path 877 CurUnitPath:=InheritedOptionStrings[icoUnitPath]; 878 // always add the current directory to the unit path, so that the compiler 879 // checks for changed files in the directory 880 CurUnitPath:=CurUnitPath+';.'; 881 Result := Result + ' ' + ConvertSearchPathToCmdLine('-Fu', CurUnitPath); 882 883 // custom options 884 CurCustomOptions:=InheritedOptionStrings[icoCustomOptions]; 885 if CurCustomOptions<>'' then 886 Result := Result + ' ' + SpecialCharsToSpaces(CurCustomOptions,true); 887end; 888 889function MergeLinkerOptions(const OldOptions, AddOptions: string): string; 890begin 891 Result:=MergeCustomOptions(OldOptions,AddOptions); 892end; 893 894function MergeCustomOptions(const OldOptions, AddOptions: string): string; 895begin 896 Result:=OldOptions; 897 if AddOptions='' then exit; 898 if (OldOptions<>'') and (OldOptions[length(OldOptions)]<>' ') 899 and (AddOptions[1]<>' ') then 900 Result+=' '; 901 Result+=AddOptions; 902end; 903 904function ConvertSearchPathToCmdLine( 905 const Switch, Paths: String): String; 906var 907 StartPos: Integer; 908 l: Integer; 909 EndPos: LongInt; 910begin 911 if Switch='' then 912 RaiseGDBException('ConvertSearchPathToCmdLine no Switch'); 913 Result := ''; 914 if (Paths = '') then exit; 915 916 l:=length(Paths); 917 StartPos:=1; 918 while StartPos<=l do begin 919 while (StartPos<=l) and (Paths[StartPos]=' ') do inc(StartPos); 920 EndPos:=StartPos; 921 while (EndPos<=l) and (Paths[EndPos]<>';') do inc(EndPos); 922 if StartPos<EndPos then begin 923 if Result<>'' then 924 Result:=Result+' '; 925 Result:=Result 926 +PrepareCmdLineOption(Switch + copy(Paths,StartPos,EndPos-StartPos)); 927 end; 928 StartPos:=EndPos+1; 929 end; 930end; 931 932function ConvertOptionsToCmdLine(const Switch, 933 OptionStr: string): string; 934var Startpos, EndPos: integer; 935 p: Integer; 936begin 937 Result:=''; 938 StartPos:=1; 939 while StartPos<=length(OptionStr) do begin 940 while (StartPos<=length(OptionStr)) and (OptionStr[StartPos]<=' ') do 941 inc(StartPos); 942 EndPos:=StartPos; 943 while (EndPos<=length(OptionStr)) and (OptionStr[EndPos]>' ') do begin 944 if OptionStr[EndPos] in ['"',''''] then begin 945 p:=EndPos; 946 inc(EndPos); 947 while (EndPos<=length(OptionStr)) and (OptionStr[EndPos]<>OptionStr[p]) do 948 inc(EndPos); 949 end; 950 inc(EndPos); 951 end; 952 if EndPos>StartPos then begin 953 if Result<>'' then Result:=Result+' '; 954 Result:=Result+Switch+copy(OptionStr,StartPos,EndPos-StartPos); 955 end; 956 StartPos:=EndPos; 957 end; 958end; 959 960function LoadXMLCompileReasons(const AConfig: TXMLConfig; const APath: String; 961 const DefaultReasons: TCompileReasons): TCompileReasons; 962begin 963 Result := []; 964 if AConfig.GetValue(APath+'Compile',crCompile in DefaultReasons) 965 then Include(Result, crCompile); 966 if AConfig.GetValue(APath+'Build',crBuild in DefaultReasons) 967 then Include(Result, crBuild); 968 if AConfig.GetValue(APath+'Run',crRun in DefaultReasons) 969 then Include(Result, crRun); 970end; 971 972procedure SaveXMLCompileReasons(const AConfig: TXMLConfig; const APath: String; 973 const AFlags, DefaultFlags: TCompileReasons); 974begin 975 AConfig.SetDeleteValue(APath+'Compile', crCompile in AFlags, crCompile in DefaultFlags); 976 AConfig.SetDeleteValue(APath+'Build', crBuild in AFlags, crBuild in DefaultFlags); 977 AConfig.SetDeleteValue(APath+'Run', crRun in AFlags, crRun in DefaultFlags); 978end; 979 980function EnumToStr(Flag: TCompilerFlagValue): string; 981begin 982 case Flag of 983 cfvHide: Result:='Hide'; 984 cfvShow: Result:='Show'; 985 else Result:='Default'; 986 end; 987end; 988 989function CompareCompMsgIdFlag(Data1, Data2: Pointer): integer; 990var 991 Flag1: PCompilerMsgIdFlag absolute Data1; 992 Flag2: PCompilerMsgIdFlag absolute Data2; 993begin 994 if Flag1^.MsgId<Flag2^.MsgId then 995 Result:=1 996 else if Flag1^.MsgId>Flag2^.MsgId then 997 Result:=-1 998 else 999 Result:=0; 1000end; 1001 1002{ TCompilerMsgIDFlagsEnumerator } 1003 1004function TCompilerMsgIDFlagsEnumerator.GetCurrent: PCompilerMsgIdFlag; 1005begin 1006 Result:=PCompilerMsgIdFlag(FCurrent.Data); 1007end; 1008 1009constructor TCompilerMsgIDFlagsEnumerator.Create(Tree: TAvlTree); 1010begin 1011 FTree:=Tree; 1012end; 1013 1014function TCompilerMsgIDFlagsEnumerator. 1015 GetEnumerator: TCompilerMsgIDFlagsEnumerator; 1016begin 1017 Result:=Self; 1018end; 1019 1020function TCompilerMsgIDFlagsEnumerator.MoveNext: Boolean; 1021begin 1022 if FCurrent<>nil then 1023 FCurrent:=FCurrent.Successor 1024 else 1025 FCurrent:=FTree.FindLowest; 1026 Result:=FCurrent<>nil; 1027end; 1028 1029{ TIDECfgScriptEngine } 1030 1031function TIDECfgScriptEngine.IsCustomFunction(FunctionName: PChar): boolean; 1032begin 1033 case UpChars[FunctionName^] of 1034 'G': 1035 if (CompareIdentifiers(FunctionName,'GetIDEValue')=0) 1036 or (CompareIdentifiers(FunctionName,'GetEnv')=0) 1037 or (ProjValuesAvailable and (CompareIdentifiers(FunctionName,'GetProjValue')=0)) 1038 then exit(true); 1039 end; 1040 Result:=false; 1041end; 1042 1043procedure TIDECfgScriptEngine.RunCustomSimpleFunction(FunctionName: PChar; 1044 Value: PCTCfgScriptVariable); 1045var 1046 VarName: String; 1047 s: String; 1048begin 1049 case UpChars[FunctionName^] of 1050 'G': 1051 if (CompareIdentifiers(FunctionName,'GetIDEValue')=0) then 1052 begin 1053 VarName:=GetCTCSVariableAsString(Value); 1054 if CompareIdentifiers(PChar(VarName),'OS')=0 then 1055 SetCTCSVariableAsString(Value,GetCompiledTargetOS) 1056 else if CompareIdentifiers(PChar(VarName),'CPU')=0 then 1057 SetCTCSVariableAsString(Value,GetCompiledTargetCPU) 1058 else if CompareIdentifiers(PChar(VarName),'SrcOS')=0 then 1059 SetCTCSVariableAsString(Value,GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)) 1060 else if CompareIdentifiers(PChar(VarName),'SrcOS2')=0 then 1061 SetCTCSVariableAsString(Value,GetDefaultSrcOS2ForTargetOS(GetCompiledTargetOS)) 1062 else if CompareIdentifiers(PChar(VarName),'LCLWidgetType')=0 then 1063 SetCTCSVariableAsString(Value,GetLCLWidgetTypeName) 1064 else 1065 ClearCTCSVariable(Value); 1066 end else if (CompareIdentifiers(FunctionName,'GetEnv')=0) then 1067 begin 1068 VarName:=GetCTCSVariableAsString(Value); 1069 SetCTCSVariableAsString(Value,GetEnvironmentVariableUTF8(VarName)); 1070 end else if ProjValuesAvailable 1071 and (CompareIdentifiers(FunctionName,'GetProjValue')=0) then 1072 begin 1073 VarName:=GetCTCSVariableAsString(Value); 1074 if CompareIdentifiers(PChar(VarName),'FPC_FULLVERSION')=0 then 1075 begin 1076 s:='$(FPC_FULLVERSION)'; 1077 GlobalMacroList.SubstituteStr(s); 1078 SetCTCSVariableAsNumber(Value,StrToIntDef(s,0)); 1079 end; 1080 end; 1081 end; 1082end; 1083 1084 1085{ TBaseCompilerOptions } 1086 1087// inline 1088function TBaseCompilerOptions.IDEMessageFlags: TCompilerMsgIDFlags; 1089begin 1090 Result:=TCompilerMsgIDFlags(MessageFlags); 1091end; 1092 1093{------------------------------------------------------------------------------ 1094 TBaseCompilerOptions Constructor 1095------------------------------------------------------------------------------} 1096constructor TBaseCompilerOptions.Create(const AOwner: TObject; 1097 const AToolClass: TLazCompilationToolClass); 1098begin 1099 inherited Create(AOwner); 1100 FParsedOpts := TParsedCompilerOptions.Create(Self); 1101 FOtherDefines := TStringList.Create; 1102 FExecuteBefore := AToolClass.Create(Self); 1103 FExecuteAfter := AToolClass.Create(Self); 1104 fBuildMacros := TIDEBuildMacros.Create(Self); 1105 fMessageFlags:=TCompilerMsgIDFlags.Create; 1106 Clear; 1107end; 1108 1109constructor TBaseCompilerOptions.Create(const AOwner: TObject); 1110begin 1111 Create(AOwner, TCompilationToolOptions); 1112end; 1113 1114{------------------------------------------------------------------------------ 1115 TBaseCompilerOptions Destructor 1116------------------------------------------------------------------------------} 1117destructor TBaseCompilerOptions.Destroy; 1118begin 1119 if (FPCMsgFilePool<>nil) and (FFPCMsgFile<>nil) then 1120 FPCMsgFilePool.UnloadFile(FFPCMsgFile); 1121 FreeAndNil(fMessageFlags); 1122 FreeAndNil(fBuildMacros); 1123 FreeThenNil(fExecuteBefore); 1124 FreeThenNil(fExecuteAfter); 1125 FreeThenNil(FOtherDefines); 1126 FreeThenNil(FParsedOpts); 1127 inherited Destroy; 1128end; 1129 1130{------------------------------------------------------------------------------ 1131 TBaseCompilerOptions LoadFromFile 1132------------------------------------------------------------------------------} 1133function TBaseCompilerOptions.LoadFromFile(AFilename: string): TModalResult; 1134var 1135 XMLConfig: TXMLConfig; 1136begin 1137 Result:=mrCancel; 1138 try 1139 XMLConfig := TXMLConfig.Create(AFilename); 1140 try 1141 LoadFromXMLConfig(XMLConfig,'CompilerOptions'); 1142 Result:=mrOk; 1143 finally 1144 XMLConfig.Free; 1145 end; 1146 except 1147 on E: Exception do begin 1148 DebugLn('TBaseCompilerOptions.LoadFromFile '+Classname+' '+AFilename+' '+E.Message); 1149 end; 1150 end; 1151end; 1152 1153{------------------------------------------------------------------------------ 1154 procedure TBaseCompilerOptions.SetIncludePaths(const AValue: String); 1155------------------------------------------------------------------------------} 1156procedure TBaseCompilerOptions.SetIncludePaths(const AValue: String); 1157var 1158 NewValue: String; 1159begin 1160 NewValue:=ShortenPath(AValue); 1161 if IncludePath=NewValue then exit; 1162 ParsedOpts.SetUnparsedValue(pcosIncludePath,NewValue); 1163 {$IFDEF VerboseIDEModified} 1164 debugln(['TBaseCompilerOptions.SetIncludePaths ',AValue]); 1165 {$ENDIF} 1166 IncreaseChangeStamp; 1167end; 1168 1169procedure TBaseCompilerOptions.SetCompilerPath(const AValue: String); 1170begin 1171 if CompilerPath=AValue then exit; 1172 ParsedOpts.SetUnparsedValue(pcosCompilerPath,AValue); 1173 {$IFDEF VerboseIDEModified} 1174 debugln(['TBaseCompilerOptions.SetCompilerPath ',AValue]); 1175 {$ENDIF} 1176 IncreaseChangeStamp; 1177end; 1178 1179procedure TBaseCompilerOptions.SetConditionals(AValue: string); 1180begin 1181 if FConditionals=AValue then exit; 1182 {$IFDEF VerboseIDEModified} 1183 debugln(['TBaseCompilerOptions.SetConditionals ']); 1184 debugln('old:"',dbgstr(FConditionals),'"'); 1185 debugln('new:"',dbgstr(AValue),'"'); 1186 {$ENDIF} 1187 FConditionals:=AValue; 1188 if ParsedOpts.InvalidateParseOnChange then 1189 IncreaseBuildMacroChangeStamp; 1190 IncreaseChangeStamp; 1191end; 1192 1193procedure TBaseCompilerOptions.SetDefaultMakeOptionsFlags( 1194 const AValue: TCompilerCmdLineOptions); 1195begin 1196 if FDefaultMakeOptionsFlags=AValue then exit; 1197 FDefaultMakeOptionsFlags:=AValue; 1198 {$IFDEF VerboseIDEModified} 1199 debugln(['TBaseCompilerOptions.SetDefaultMakeOptionsFlags ']); 1200 {$ENDIF} 1201 IncreaseChangeStamp; 1202end; 1203 1204procedure TBaseCompilerOptions.SetSrcPath(const AValue: string); 1205var 1206 NewValue: String; 1207begin 1208 NewValue:=ShortenPath(AValue); 1209 if SrcPath=NewValue then exit; 1210 ParsedOpts.SetUnparsedValue(pcosSrcPath,NewValue); 1211 {$IFDEF VerboseIDEModified} 1212 debugln(['TBaseCompilerOptions.SetSrcPath ',AValue]); 1213 {$ENDIF} 1214 IncreaseChangeStamp; 1215end; 1216 1217procedure TBaseCompilerOptions.SetDebugPath(const AValue: string); 1218var 1219 NewValue: String; 1220begin 1221 NewValue:=ShortenPath(AValue); 1222 if DebugPath=NewValue then exit; 1223 ParsedOpts.SetUnparsedValue(pcosDebugPath,NewValue); 1224 {$IFDEF VerboseIDEModified} 1225 debugln(['TBaseCompilerOptions.SetDebugPath ',AValue]); 1226 {$ENDIF} 1227 IncreaseChangeStamp; 1228end; 1229 1230procedure TBaseCompilerOptions.SetTargetCPU(const AValue: string); 1231var 1232 NewValue: String; 1233begin 1234 NewValue:=GetFPCTargetCPU(AValue); 1235 if fTargetCPU=NewValue then exit; 1236 fTargetCPU:=NewValue; 1237 if ParsedOpts.InvalidateParseOnChange then 1238 IncreaseBuildMacroChangeStamp; 1239 {$IFDEF VerboseIDEModified} 1240 debugln(['TBaseCompilerOptions.SetTargetCPU ',AValue]); 1241 {$ENDIF} 1242 IncreaseChangeStamp; 1243end; 1244 1245procedure TBaseCompilerOptions.SetTargetProc(const AValue: string); 1246begin 1247 if fTargetProc=AValue then exit; 1248 fTargetProc:=AValue; 1249 if ParsedOpts.InvalidateParseOnChange then 1250 IncreaseBuildMacroChangeStamp; 1251 {$IFDEF VerboseIDEModified} 1252 debugln(['TBaseCompilerOptions.SetTargetProc ',AValue]); 1253 {$ENDIF} 1254 IncreaseChangeStamp; 1255end; 1256 1257procedure TBaseCompilerOptions.SetTargetOS(const AValue: string); 1258var 1259 NewValue: String; 1260begin 1261 NewValue:=GetFPCTargetOS(AValue); 1262 if fTargetOS=NewValue then exit; 1263 fTargetOS:=NewValue; 1264 if ParsedOpts.InvalidateParseOnChange then 1265 IncreaseBuildMacroChangeStamp; 1266 {$IFDEF VerboseIDEModified} 1267 debugln(['TBaseCompilerOptions.SetTargetOS ',AValue]); 1268 {$ENDIF} 1269 IncreaseChangeStamp; 1270end; 1271 1272procedure TBaseCompilerOptions.SetTargetFileExt(const AValue: String); 1273begin 1274 if fTargetFileExt=AValue then exit; 1275 fTargetFileExt:=AValue; 1276 {$IFDEF VerboseIDEModified} 1277 debugln(['TBaseCompilerOptions.SetTargetFileExt ',AValue]); 1278 {$ENDIF} 1279 IncreaseChangeStamp; 1280end; 1281 1282procedure TBaseCompilerOptions.SetTargetFilename(const AValue: String); 1283begin 1284 if fTargetFilename=AValue then exit; 1285 fTargetFilename:=AValue; 1286 {$IFDEF VerboseIDEModified} 1287 debugln(['TBaseCompilerOptions.SetTargetFilename ',AValue]); 1288 {$ENDIF} 1289 IncreaseChangeStamp; 1290end; 1291 1292function TBaseCompilerOptions.GetModified: boolean; 1293begin 1294 Result:=(inherited GetModified) or MessageFlags.Modified; 1295end; 1296 1297procedure TBaseCompilerOptions.SetCreateMakefileOnBuild(AValue: boolean); 1298begin 1299 if FCreateMakefileOnBuild=AValue then Exit; 1300 FCreateMakefileOnBuild:=AValue; 1301 {$IFDEF VerboseIDEModified} 1302 debugln(['TBaseCompilerOptions.SetCreateMakefileOnBuild ',AValue]); 1303 {$ENDIF} 1304 IncreaseChangeStamp; 1305end; 1306 1307function TBaseCompilerOptions.GetCompilerPath: String; 1308begin 1309 Result:=ParsedOpts.Values[pcosCompilerPath].UnparsedValue; 1310end; 1311 1312function TBaseCompilerOptions.GetBaseDirectory: string; 1313begin 1314 Result:=ParsedOpts.Values[pcosBaseDir].UnparsedValue; 1315end; 1316 1317function TBaseCompilerOptions.GetCustomOptions: string; 1318begin 1319 Result:=ParsedOpts.Values[pcosCustomOptions].UnparsedValue; 1320end; 1321 1322function TBaseCompilerOptions.GetDebugPath: string; 1323begin 1324 Result:=ParsedOpts.Values[pcosDebugPath].UnparsedValue; 1325end; 1326 1327function TBaseCompilerOptions.GetIncludePaths: String; 1328begin 1329 Result:=ParsedOpts.Values[pcosIncludePath].UnparsedValue; 1330end; 1331 1332function TBaseCompilerOptions.GetLibraryPaths: String; 1333begin 1334 Result:=ParsedOpts.Values[pcosLibraryPath].UnparsedValue; 1335end; 1336 1337function TBaseCompilerOptions.GetNamespaces: String; 1338begin 1339 Result:=ParsedOpts.Values[pcosNamespaces].UnparsedValue; 1340end; 1341 1342function TBaseCompilerOptions.GetObjectPath: string; 1343begin 1344 Result:=ParsedOpts.Values[pcosObjectPath].UnparsedValue; 1345end; 1346 1347function TBaseCompilerOptions.GetSrcPath: string; 1348begin 1349 Result:=ParsedOpts.Values[pcosSrcPath].UnparsedValue; 1350end; 1351 1352function TBaseCompilerOptions.GetUnitOutputDir: string; 1353begin 1354 Result:=ParsedOpts.Values[pcosOutputDir].UnparsedValue; 1355end; 1356 1357function TBaseCompilerOptions.GetUnitPaths: String; 1358begin 1359 Result:=ParsedOpts.Values[pcosUnitPath].UnparsedValue; 1360end; 1361 1362function TBaseCompilerOptions.GetExecuteAfter: TCompilationToolOptions; 1363begin 1364 Result:=TCompilationToolOptions(fExecuteAfter); 1365end; 1366 1367function TBaseCompilerOptions.GetExecuteBefore: TCompilationToolOptions; 1368begin 1369 Result:=TCompilationToolOptions(fExecuteBefore); 1370end; 1371 1372procedure TBaseCompilerOptions.SetBaseDirectory(AValue: string); 1373begin 1374 if BaseDirectory=AValue then exit; 1375 ParsedOpts.SetUnparsedValue(pcosBaseDir,AValue); 1376 {$IFDEF VerboseIDEModified} 1377 debugln(['TBaseCompilerOptions.SetBaseDirectory ',AValue]); 1378 {$ENDIF} 1379 IncreaseChangeStamp; 1380end; 1381 1382procedure TBaseCompilerOptions.SetCustomOptions(const AValue: string); 1383var 1384 NewValue: String; 1385begin 1386 // Keep line breaks for formatting in options dialog 1387 NewValue:=Trim(AValue); 1388 if CustomOptions=NewValue then exit; 1389 ParsedOpts.SetUnparsedValue(pcosCustomOptions,NewValue); 1390 {$IFDEF VerboseIDEModified} 1391 debugln(['TBaseCompilerOptions.SetCustomOptions ',AValue]); 1392 {$ENDIF} 1393 IncreaseChangeStamp; 1394end; 1395 1396procedure TBaseCompilerOptions.SetLibraryPaths(const AValue: String); 1397var 1398 NewValue: String; 1399begin 1400 NewValue:=ShortenPath(AValue); 1401 if Libraries=NewValue then exit; 1402 ParsedOpts.SetUnparsedValue(pcosLibraryPath,NewValue); 1403 {$IFDEF VerboseIDEModified} 1404 debugln(['TBaseCompilerOptions.SetLibraryPaths ',AValue]); 1405 {$ENDIF} 1406 IncreaseChangeStamp; 1407end; 1408 1409procedure TBaseCompilerOptions.SetLinkerOptions(const AValue: String); 1410begin 1411 if LinkerOptions=AValue then exit; 1412 fLinkerOptions:=AValue; 1413 ParsedOpts.SetUnparsedValue(pcosLinkerOptions,AValue); 1414 {$IFDEF VerboseIDEModified} 1415 debugln(['TBaseCompilerOptions.SetLinkerOptions ',AValue]); 1416 {$ENDIF} 1417 IncreaseChangeStamp; 1418end; 1419 1420procedure TBaseCompilerOptions.SetNamespaces(const AValue: String); 1421begin 1422 if Namespaces=AValue then exit; 1423 ParsedOpts.SetUnparsedValue(pcosNamespaces,AValue); 1424 {$IFDEF VerboseIDEModified} 1425 debugln(['TBaseCompilerOptions.SetNamespaces ',AValue]); 1426 {$ENDIF} 1427 IncreaseChangeStamp; 1428end; 1429 1430procedure TBaseCompilerOptions.SetUnitPaths(const AValue: String); 1431var 1432 NewValue: String; 1433begin 1434 NewValue:=ShortenPath(AValue); 1435 if OtherUnitFiles=NewValue then exit; 1436 ParsedOpts.SetUnparsedValue(pcosUnitPath,NewValue); 1437 {$IFDEF VerboseIDEModified} 1438 debugln(['TBaseCompilerOptions.SetUnitPaths ',AValue]); 1439 {$ENDIF} 1440 IncreaseChangeStamp; 1441end; 1442 1443procedure TBaseCompilerOptions.SetUnitOutputDir(const AValue: string); 1444begin 1445 if UnitOutputDirectory=AValue then exit; 1446 ParsedOpts.SetUnparsedValue(pcosOutputDir,AValue); 1447 {$IFDEF VerboseIDEModified} 1448 debugln(['TBaseCompilerOptions.SetUnitOutputDir ',AValue]); 1449 {$ENDIF} 1450 IncreaseChangeStamp; 1451end; 1452 1453procedure TBaseCompilerOptions.SetObjectPath(const AValue: string); 1454var 1455 NewValue: String; 1456begin 1457 NewValue:=ShortenPath(AValue); 1458 if ObjectPath=NewValue then exit; 1459 ParsedOpts.SetUnparsedValue(pcosObjectPath,NewValue); 1460 {$IFDEF VerboseIDEModified} 1461 debugln(['TBaseCompilerOptions.SetObjectPath ',AValue]); 1462 {$ENDIF} 1463 IncreaseChangeStamp; 1464end; 1465 1466{------------------------------------------------------------------------------ 1467 TfrmCompilerOptions LoadTheCompilerOptions 1468------------------------------------------------------------------------------} 1469procedure TBaseCompilerOptions.LoadFromXMLConfig(AXMLConfig: TXMLConfig; 1470 const Path: string); 1471var 1472 FileVersion: Integer; 1473 PathDelimChange: boolean; 1474 p: String; 1475 1476 function f(const Filename: string): string; 1477 begin 1478 Result:=SwitchPathDelims(Filename,PathDelimChange); 1479 end; 1480 1481 function sp(const SearchPath: string): string; 1482 begin 1483 Result:=SwitchPathDelims(SearchPath,PathDelimChange); 1484 Result:=MinimizeSearchPath(Result); 1485 end; 1486 1487 procedure ReadSmaller; 1488 begin 1489 if FileVersion<2 then begin 1490 if aXMLConfig.GetValue(p+'Generate/Value', 1)<>1 then 1491 SmallerCode:=true; 1492 end else if FileVersion<8 then begin 1493 if aXMLConfig.GetValue(p+'Generate/Value','')='Smaller' then 1494 SmallerCode:=true; 1495 end else 1496 SmallerCode:=aXMLConfig.GetValue(p+'SmallerCode/Value',false); 1497 end; 1498 1499 procedure ReadSmartLinkUnit; 1500 begin 1501 if FileVersion<3 then 1502 SmartLinkUnit := aXMLConfig.GetValue(p+'UnitStyle/Value', 1)=2 1503 else 1504 SmartLinkUnit := aXMLConfig.GetValue(p+'SmartLinkUnit/Value', false); 1505 end; 1506 1507 procedure ReadLinkSmart; 1508 begin 1509 if FileVersion<3 then 1510 LinkSmart := aXMLConfig.GetValue(p+'LinkStyle/Value', 1)=3 1511 else 1512 LinkSmart := aXMLConfig.GetValue(p+'LinkSmart/Value', false); 1513 end; 1514 1515 procedure ReadListOfMessageFlags(aPath: string; aValue: TCompilerFlagValue); 1516 var 1517 dNode: TDOMNode; 1518 i: Integer; 1519 Attr: TDOMNode; 1520 aName: DOMString; 1521 MsgId: Integer; 1522 begin 1523 dNode:=aXMLConfig.FindNode(aPath,false); 1524 if dNode<>nil then begin 1525 for i:=0 to dNode.Attributes.Length-1 do begin 1526 Attr:=dNode.Attributes.Item[i]; 1527 aName:=Attr.NodeName; 1528 //debugln(['ReadListOfMessageFlags Attr=',aName,'=',Attr.NodeValue]); 1529 if LeftStr(aName,3)<>'idx' then continue; 1530 Delete(aName,1,3); 1531 MsgId:=StrToIntDef(aName,0); 1532 if MsgId<=0 then continue; 1533 if Attr.NodeValue<>'True' then continue; 1534 MessageFlags[MsgId]:=aValue; 1535 end; 1536 end; 1537 end; 1538 1539var 1540 b: boolean; 1541 dit: TCompilerDbgSymbolType; 1542 i, Cnt: Integer; 1543 s: String; 1544begin 1545 { Load the compiler options from the XML file } 1546 p:=Path; 1547 FileVersion:=aXMLConfig.GetValue(p+'Version/Value', 0); 1548 StorePathDelim:=CheckPathDelim(aXMLConfig.GetValue(p+'PathDelim/Value', '/'),PathDelimChange); 1549 1550 { Target } 1551 p:=Path+'Target/'; 1552 TargetFileExt := f(aXMLConfig.GetValue(p+'FileExt', '')); 1553 TargetFilename := f(aXMLConfig.GetValue(p+'Filename/Value', '')); 1554 TargetFilenameApplyConventions := aXMLConfig.GetValue(p+'Filename/ApplyConventions', true); 1555 1556 { SearchPaths } 1557 p:=Path+'SearchPaths/'; 1558 IncludePath := sp(aXMLConfig.GetValue(p+'IncludeFiles/Value', '')); 1559 Libraries := sp(aXMLConfig.GetValue(p+'Libraries/Value', '')); 1560 OtherUnitFiles := sp(aXMLConfig.GetValue(p+'OtherUnitFiles/Value', '')); 1561 UnitOutputDirectory := sp(aXMLConfig.GetValue(p+'UnitOutputDirectory/Value', '')); 1562 ObjectPath := sp(aXMLConfig.GetValue(p+'ObjectPath/Value', '')); 1563 SrcPath := sp(aXMLConfig.GetValue(p+'SrcPath/Value', '')); 1564 1565 { Conditionals } 1566 FConditionals:=LineBreaksToSystemLineBreaks(UTF8Trim( 1567 aXMLConfig.GetValue(Path+'Conditionals/Value',DefaultConditionals),[])); 1568 TIDEBuildMacros(fBuildMacros).LoadFromXMLConfig(aXMLConfig, 1569 Path+'BuildMacros/',PathDelimChange); 1570 1571 { Parsing } 1572 p:=Path+'Parsing/'; 1573 AssemblerStyle := aXMLConfig.GetValue(p+'Style/Value', 0); 1574 1575 { Syntax Options } 1576 if FileVersion>=5 then 1577 p:=Path+'Parsing/SyntaxOptions/' 1578 else 1579 p:=Path+'SymantecChecking/'; 1580 if FileVersion<6 then begin 1581 if aXMLConfig.GetValue(p+'D2Extensions/Value', true) then 1582 FSyntaxMode:='ObjFPC'; 1583 if aXMLConfig.GetValue(p+'TPCompatible/Value', false) then 1584 FSyntaxMode:='TP'; 1585 if aXMLConfig.GetValue(p+'DelphiCompat/Value', false) then 1586 FSyntaxMode:='Delphi'; 1587 if aXMLConfig.GetValue(p+'GPCCompat/Value', false) then 1588 FSyntaxMode:='GPC'; 1589 end else begin 1590 FSyntaxMode:=aXMLConfig.GetValue(p+'SyntaxMode/Value', ''); 1591 if FSyntaxMode='' then 1592 FSyntaxMode:='ObjFPC'; 1593 end; 1594 CStyleOperators := aXMLConfig.GetValue(p+'CStyleOperator/Value', true); 1595 IncludeAssertionCode := aXMLConfig.GetValue(p+'IncludeAssertionCode/Value', false); 1596 AllowLabel := aXMLConfig.GetValue(p+'AllowLabel/Value', true); 1597 CPPInline := aXMLConfig.GetValue(p+'CPPInline/Value', true); 1598 CStyleMacros := aXMLConfig.GetValue(p+'CStyleMacros/Value', false); 1599 InitConstructor := aXMLConfig.GetValue(p+'InitConstructor/Value', false); 1600 StaticKeyword := aXMLConfig.GetValue(p+'StaticKeyword/Value', false); 1601 UseAnsiStrings := aXMLConfig.GetValue(p+'UseAnsiStrings/Value', FileVersion>=9); 1602 1603 { CodeGeneration } 1604 p:=Path+'CodeGeneration/'; 1605 ReadSmartLinkUnit; 1606 RelocatableUnit := aXMLConfig.GetValue(p+'RelocatableUnit/Value', false); 1607 IOChecks := aXMLConfig.GetValue(p+'Checks/IOChecks/Value', false); 1608 RangeChecks := aXMLConfig.GetValue(p+'Checks/RangeChecks/Value', false); 1609 OverflowChecks := aXMLConfig.GetValue(p+'Checks/OverflowChecks/Value', false); 1610 StackChecks := aXMLConfig.GetValue(p+'Checks/StackChecks/Value', false); 1611 EmulatedFloatOpcodes := aXMLConfig.GetValue(p+'EmulateFloatingPointOpCodes/Value', false); 1612 HeapSize := aXMLConfig.GetValue(p+'HeapSize/Value', 0); 1613 StackSize := aXMLConfig.GetValue(p+'StackSize/Value', 0); 1614 VerifyObjMethodCall := aXMLConfig.GetValue(p+'VerifyObjMethodCallValidity/Value', false); 1615 if FileVersion<7 then begin 1616 i:=aXMLConfig.GetValue(p+'TargetProcessor/Value', 0); 1617 case i of 1618 1: TargetProcessor:='PENTIUM'; 1619 2: TargetProcessor:='PENTIUM2'; 1620 3: TargetProcessor:='PENTIUM3'; 1621 end; 1622 end else 1623 TargetProcessor := aXMLConfig.GetValue(p+'TargetProcessor/Value', ''); 1624 TargetCPU := aXMLConfig.GetValue(p+'TargetCPU/Value', ''); 1625 TargetOS := aXMLConfig.GetValue(p+'TargetOS/Value', ''); 1626 OptimizationLevel := aXMLConfig.GetValue(p+'Optimizations/OptimizationLevel/Value', 1); 1627 VariablesInRegisters := aXMLConfig.GetValue(p+'Optimizations/VariablesInRegisters/Value', false); 1628 UncertainOptimizations := aXMLConfig.GetValue(p+'Optimizations/UncertainOptimizations/Value', false); 1629 ReadSmaller; 1630 1631 { Linking } 1632 p:=Path+'Linking/'; 1633 GenerateDebugInfo := aXMLConfig.GetValue(p+'Debugging/GenerateDebugInfo/Value', FileVersion >= 11); // Default = True, since version 11 (was False before) 1634 UseLineInfoUnit := aXMLConfig.GetValue(p+'Debugging/UseLineInfoUnit/Value', true); 1635 UseHeaptrc := aXMLConfig.GetValue(p+'Debugging/UseHeaptrc/Value', false); 1636 TrashVariables := aXMLConfig.GetValue(p+'Debugging/TrashVariables/Value', false); 1637 UseValgrind := aXMLConfig.GetValue(p+'Debugging/UseValgrind/Value', false); 1638 1639 if (FileVersion < 11) and (aXMLConfig.GetValue(p+'Debugging/DebugInfoType/Value', '') = '') then begin 1640 // upgrading old setting 1641 DebugInfoType := dsAuto; 1642 if GenerateDebugInfo then 1643 DebugInfoType := dsStabs; 1644 if UseLineInfoUnit or UseHeaptrc or UseValgrind then 1645 GenerateDebugInfo := True; // LineInfo implies debug info 1646 b := aXMLConfig.GetValue(p+'Debugging/GenerateDwarf/Value', false); 1647 if b then begin 1648 GenerateDebugInfo := True; // The old setting implied this 1649 DebugInfoType := dsDwarf2Set; // explicit dwarf, upgrade to +set 1650 end; 1651 end 1652 else begin 1653 try 1654 ReadStr(aXMLConfig.GetValue(p+'Debugging/DebugInfoType/Value', 'dsAuto'), dit); 1655 DebugInfoType := dit; 1656 except 1657 DebugInfoType := dsAuto; 1658 end; 1659 end; 1660 1661 GenGProfCode := aXMLConfig.GetValue(p+'Debugging/GenGProfCode/Value', false); 1662 StripSymbols := aXMLConfig.GetValue(p+'Debugging/StripSymbols/Value', false); 1663 UseExternalDbgSyms := aXMLConfig.GetValue(p+'Debugging/UseExternalDbgSyms/Value', false); 1664 ReadLinkSmart; 1665 PassLinkerOptions := aXMLConfig.GetValue(p+'Options/PassLinkerOptions/Value', false); 1666 LinkerOptions := LineBreaksToSystemLineBreaks( 1667 f(aXMLConfig.GetValue(p+'Options/LinkerOptions/Value', ''))); 1668 Win32GraphicApp := aXMLConfig.GetValue(p+'Options/Win32/GraphicApplication/Value', false); 1669 ExecutableType := CompilationExecutableTypeNameToType( 1670 aXMLConfig.GetValue(p+'Options/ExecutableType/Value','')); 1671 //DebugLn('TBaseCompilerOptions.LoadFromXMLConfig ',CompilationExecutableTypeNames[ExecutableType]); 1672 1673 { Messages } 1674 p:=Path+'Other/'; 1675 ShowWarn := aXMLConfig.GetValue(p+'Verbosity/ShowWarn/Value', true); 1676 ShowNotes := aXMLConfig.GetValue(p+'Verbosity/ShowNotes/Value', true); 1677 ShowHints := aXMLConfig.GetValue(p+'Verbosity/ShowHints/Value', true); 1678 ShowLineNum := aXMLConfig.GetValue(p+'Verbosity/ShoLineNum/Value', false); 1679 ShowAll := aXMLConfig.GetValue(p+'Verbosity/ShowAll/Value', false); 1680 ShowDebugInfo := aXMLConfig.GetValue(p+'Verbosity/ShowDebugInfo/Value', false); 1681 ShowUsedFiles := aXMLConfig.GetValue(p+'Verbosity/ShowUsedFiles/Value', false); 1682 ShowTriedFiles := aXMLConfig.GetValue(p+'Verbosity/ShowTriedFiles/Value', false); 1683 ShowCompProc := aXMLConfig.GetValue(p+'Verbosity/ShowCompProc/Value', false); 1684 ShowCond := aXMLConfig.GetValue(p+'Verbosity/ShowCond/Value', false); 1685 ShowExecInfo := aXMLConfig.GetValue(p+'Verbosity/ShowExecInfo/Value', false); 1686 ShowHintsForUnusedUnitsInMainSrc := aXMLConfig.GetValue(p+'Verbosity/ShowHintsForUnusedUnitsInMainSrc/Value', false); 1687 ShowHintsForSenderNotUsed := aXMLConfig.GetValue(p+'Verbosity/ShowHintsForSenderNotUsed/Value', false); 1688 WriteFPCLogo := aXMLConfig.GetValue(p+'WriteFPCLogo/Value', true); 1689 StopAfterErrCount := aXMLConfig.GetValue(p+'ConfigFile/StopAfterErrCount/Value', 1); 1690 1691 ReadListOfMessageFlags(p+'CompilerMessages/IgnoredMessages',cfvHide); 1692 ReadListOfMessageFlags(p+'CompilerMessages/NonIgnoredMessages',cfvShow); 1693 1694 { Other } 1695 p:=Path+'Other/'; 1696 DontUseConfigFile := aXMLConfig.GetValue(p+'ConfigFile/DontUseConfigFile/Value', false); 1697 if FileVersion<=3 then 1698 CustomConfigFile := aXMLConfig.GetValue(p+'ConfigFile/AdditionalConfigFile/Value', false) 1699 else 1700 CustomConfigFile := aXMLConfig.GetValue(p+'ConfigFile/CustomConfigFile/Value', false); 1701 ConfigFilePath := f(aXMLConfig.GetValue(p+'ConfigFile/ConfigFilePath/Value', 'extrafpc.cfg')); 1702 CustomOptions := LineBreaksToSystemLineBreaks(aXMLConfig.GetValue(p+'CustomOptions/Value', '')); 1703 UseCommentsInCustomOptions := aXMLConfig.GetValue(p+'ConfigFile/UseCommentsInCustomOptions/Value', false); 1704 1705 FOtherDefines.Clear; 1706 Cnt := aXMLConfig.GetValue(p+'OtherDefines/Count', 0); 1707 for i := 0 to Cnt-1 do 1708 begin 1709 s := aXMLConfig.GetValue(p+'OtherDefines/Define'+IntToStr(i)+'/Value', ''); 1710 if s <> '' then 1711 FOtherDefines.Add(s); 1712 end; 1713 1714 { Compilation } 1715 CompilerPath := f(aXMLConfig.GetValue(p+'CompilerPath/Value',DefaultCompilerPath)); 1716 1717 ExecuteBefore.LoadFromXMLConfig(aXMLConfig,p+'ExecuteBefore/',PathDelimChange); 1718 ExecuteAfter.LoadFromXMLConfig(aXMLConfig,p+'ExecuteAfter/',PathDelimChange); 1719 CreateMakefileOnBuild:=aXMLConfig.GetValue(p+'CreateMakefileOnBuild/Value',false); 1720end; 1721 1722{------------------------------------------------------------------------------ 1723 TfrmCompilerOptions SaveToFile 1724------------------------------------------------------------------------------} 1725function TBaseCompilerOptions.SaveToFile(AFilename: string): TModalResult; 1726var 1727 aXMLConfig: TXMLConfig; 1728begin 1729 Result:=mrCancel; 1730 try 1731 aXMLConfig := TXMLConfig.Create(AFilename); 1732 try 1733 SaveToXMLConfig(aXMLConfig,'CompilerOptions'); 1734 Modified:=false; 1735 Result:=mrOk; 1736 finally 1737 aXMLConfig.Free; 1738 end; 1739 except 1740 on E: Exception do begin 1741 DebugLn('TBaseCompilerOptions.SaveToFile '+Classname+' '+AFilename+' '+E.Message); 1742 end; 1743 end; 1744end; 1745 1746{------------------------------------------------------------------------------ 1747 TfrmCompilerOptions SaveTheCompilerOptions 1748------------------------------------------------------------------------------} 1749procedure TBaseCompilerOptions.SaveToXMLConfig(AXMLConfig: TXMLConfig; 1750 const Path: string); 1751var 1752 UsePathDelim: TPathDelimSwitch; 1753 1754 function f(const AFilename: string): string; 1755 begin 1756 Result:=SwitchPathDelims(AFilename,UsePathDelim); 1757 end; 1758 1759 procedure WriteListOfMessageFlags(aPath: string; aValue: TCompilerFlagValue); 1760 var 1761 Flag: PCompilerMsgIdFlag; 1762 begin 1763 for Flag in IDEMessageFlags do 1764 if Flag^.Flag=aValue then begin 1765 //debugln(['WriteListOfMessageFlags aPath=',aPath,' Flag.MsgId=',Flag^.MsgId]); 1766 aXMLConfig.SetValue(aPath+'/idx'+IntToStr(Flag^.MsgId), true); 1767 end; 1768 end; 1769 1770var 1771 P, s: string; 1772 i: Integer; 1773begin 1774 { Save the compiler options to the XML file } 1775 p:=Path; 1776 UsePathDelim:=StorePathDelim; 1777 aXMLConfig.SetValue(p+'Version/Value', CompilerOptionsVersion); 1778 aXMLConfig.SetDeleteValue(p+'PathDelim/Value', 1779 PathDelimSwitchToDelim[UsePathDelim], '/'); 1780 1781 { Target } 1782 p:=Path+'Target/'; 1783 aXMLConfig.SetDeleteValue(p+'FileExt', f(TargetFileExt),''); 1784 aXMLConfig.SetDeleteValue(p+'Filename/Value', f(TargetFilename),''); 1785 aXMLConfig.SetDeleteValue(p+'Filename/ApplyConventions', TargetFilenameApplyConventions,true); 1786 1787 { SearchPaths } 1788 p:=Path+'SearchPaths/'; 1789 aXMLConfig.SetDeleteValue(p+'IncludeFiles/Value', f(IncludePath),''); 1790 aXMLConfig.SetDeleteValue(p+'Libraries/Value', f(Libraries),''); 1791 aXMLConfig.SetDeleteValue(p+'OtherUnitFiles/Value', f(OtherUnitFiles),''); 1792 aXMLConfig.SetDeleteValue(p+'UnitOutputDirectory/Value', f(UnitOutputDirectory),''); 1793 aXMLConfig.SetDeleteValue(p+'ObjectPath/Value', f(ObjectPath),''); 1794 aXMLConfig.SetDeleteValue(p+'SrcPath/Value', f(SrcPath),''); 1795 1796 { Conditionals } 1797 s:=Conditionals; 1798 if CompareTextIgnoringSpace(s,DefaultConditionals,true)=0 then 1799 s:=''; 1800 aXMLConfig.SetDeleteValue(Path+'Conditionals/Value',s,''); 1801 TIDEBuildMacros(fBuildMacros).SaveToXMLConfig(aXMLConfig, 1802 Path+'BuildMacros/',UsePathDelim); 1803 1804 { Parsing } 1805 p:=Path+'Parsing/'; 1806 aXMLConfig.SetDeleteValue(p+'Style/Value', AssemblerStyle,0); 1807 1808 { Syntax Options } 1809 p:=Path+'Parsing/SyntaxOptions/'; 1810 aXMLConfig.SetDeleteValue(p+'SyntaxMode/Value', SyntaxMode,'ObjFPC'); 1811 aXMLConfig.SetDeleteValue(p+'CStyleOperator/Value', CStyleOperators,true); 1812 aXMLConfig.SetDeleteValue(p+'IncludeAssertionCode/Value', IncludeAssertionCode,false); 1813 aXMLConfig.SetDeleteValue(p+'AllowLabel/Value', AllowLabel,true); 1814 aXMLConfig.SetDeleteValue(p+'CPPInline/Value', CPPInline,true); 1815 aXMLConfig.SetDeleteValue(p+'CStyleMacros/Value', CStyleMacros,false); 1816 aXMLConfig.SetDeleteValue(p+'InitConstructor/Value', InitConstructor,false); 1817 aXMLConfig.SetDeleteValue(p+'StaticKeyword/Value', StaticKeyword,false); 1818 aXMLConfig.SetDeleteValue(p+'UseAnsiStrings/Value', UseAnsiStrings,true); 1819 1820 { CodeGeneration } 1821 p:=Path+'CodeGeneration/'; 1822 aXMLConfig.SetDeleteValue(p+'SmartLinkUnit/Value', SmartLinkUnit,false); 1823 aXMLConfig.SetDeleteValue(p+'RelocatableUnit/Value', RelocatableUnit,false); 1824 aXMLConfig.SetDeleteValue(p+'Checks/IOChecks/Value', IOChecks,false); 1825 aXMLConfig.SetDeleteValue(p+'Checks/RangeChecks/Value', RangeChecks,false); 1826 aXMLConfig.SetDeleteValue(p+'Checks/OverflowChecks/Value', OverflowChecks,false); 1827 aXMLConfig.SetDeleteValue(p+'Checks/StackChecks/Value', StackChecks,false); 1828 aXMLConfig.SetDeleteValue(p+'EmulateFloatingPointOpCodes/Value', EmulatedFloatOpcodes,false); 1829 aXMLConfig.SetDeleteValue(p+'HeapSize/Value', HeapSize,0); 1830 aXMLConfig.SetDeleteValue(p+'StackSize/Value', StackSize,0); 1831 aXMLConfig.SetDeleteValue(p+'VerifyObjMethodCallValidity/Value', VerifyObjMethodCall,false); 1832 aXMLConfig.SetDeleteValue(p+'TargetProcessor/Value', TargetProcessor,''); 1833 aXMLConfig.SetDeleteValue(p+'TargetCPU/Value', TargetCPU,''); 1834 aXMLConfig.SetDeleteValue(p+'TargetOS/Value', TargetOS,''); 1835 aXMLConfig.SetDeleteValue(p+'Optimizations/OptimizationLevel/Value', OptimizationLevel,1); 1836 aXMLConfig.SetDeleteValue(p+'Optimizations/VariablesInRegisters/Value', VariablesInRegisters,false); 1837 aXMLConfig.SetDeleteValue(p+'Optimizations/UncertainOptimizations/Value', UncertainOptimizations,false); 1838 aXMLConfig.SetDeleteValue(p+'SmallerCode/Value', SmallerCode, false); 1839 1840 { Linking } 1841 p:=Path+'Linking/'; 1842 aXMLConfig.SetDeleteValue(p+'Debugging/GenerateDebugInfo/Value', GenerateDebugInfo, True); // Default = True, since version 11 (was False before) 1843 s:=''; 1844 WriteStr(s, DebugInfoType); 1845 aXMLConfig.SetDeleteValue(p+'Debugging/DebugInfoType/Value', s, 'dsAuto'); 1846 aXMLConfig.DeletePath(p+'Debugging/GenerateDwarf'); // old deprecated setting 1847 aXMLConfig.SetDeleteValue(p+'Debugging/UseLineInfoUnit/Value', UseLineInfoUnit,true); 1848 aXMLConfig.SetDeleteValue(p+'Debugging/UseHeaptrc/Value', UseHeaptrc,false); 1849 aXMLConfig.SetDeleteValue(p+'Debugging/TrashVariables/Value', TrashVariables,false); 1850 aXMLConfig.SetDeleteValue(p+'Debugging/UseValgrind/Value', UseValgrind,false); 1851 aXMLConfig.SetDeleteValue(p+'Debugging/GenGProfCode/Value', GenGProfCode,false); 1852 aXMLConfig.SetDeleteValue(p+'Debugging/StripSymbols/Value', StripSymbols,false); 1853 aXMLConfig.SetDeleteValue(p+'Debugging/UseExternalDbgSyms/Value', UseExternalDbgSyms,false); 1854 aXMLConfig.SetDeleteValue(p+'LinkSmart/Value', LinkSmart,false); 1855 aXMLConfig.SetDeleteValue(p+'Options/PassLinkerOptions/Value', PassLinkerOptions,false); 1856 aXMLConfig.SetDeleteValue(p+'Options/LinkerOptions/Value', 1857 f(LineBreaksToSystemLineBreaks(LinkerOptions)),''); 1858 aXMLConfig.SetDeleteValue(p+'Options/Win32/GraphicApplication/Value', Win32GraphicApp,false); 1859 aXMLConfig.SetDeleteValue(p+'Options/ExecutableType/Value', 1860 CompilationExecutableTypeNames[ExecutableType], 1861 CompilationExecutableTypeNames[cetProgram]); 1862 //DebugLn('TBaseCompilerOptions.SaveCompilerOptions ',CompilationExecutableTypeNames[ExecutableType]); 1863 1864 { Messages } 1865 p:=Path+'Other/'; 1866 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowWarn/Value', ShowWarn,true); 1867 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowNotes/Value', ShowNotes,true); 1868 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowHints/Value', ShowHints,true); 1869 aXMLConfig.SetDeleteValue(p+'Verbosity/ShoLineNum/Value', ShowLineNum,false); 1870 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowAll/Value', ShowAll,false); 1871 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowDebugInfo/Value', ShowDebugInfo,false); 1872 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowUsedFiles/Value', ShowUsedFiles,false); 1873 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowTriedFiles/Value', ShowTriedFiles,false); 1874 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowCompProc/Value', ShowCompProc,false); 1875 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowCond/Value', ShowCond,false); 1876 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowExecInfo/Value', ShowExecInfo,false); 1877 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowHintsForUnusedUnitsInMainSrc/Value', ShowHintsForUnusedUnitsInMainSrc,false); 1878 aXMLConfig.SetDeleteValue(p+'Verbosity/ShowHintsForSenderNotUsed/Value', ShowHintsForSenderNotUsed,false); 1879 aXMLConfig.SetDeleteValue(p+'WriteFPCLogo/Value', WriteFPCLogo,true); 1880 aXMLConfig.SetDeleteValue(p+'ConfigFile/StopAfterErrCount/Value', StopAfterErrCount,1); 1881 1882 WriteListOfMessageFlags(p+'CompilerMessages/IgnoredMessages',cfvHide); 1883 WriteListOfMessageFlags(p+'CompilerMessages/NonIgnoredMessages',cfvShow); 1884 1885 { Other } 1886 p:=Path+'Other/'; 1887 aXMLConfig.SetDeleteValue(p+'ConfigFile/DontUseConfigFile/Value', DontUseConfigFile,false); 1888 aXMLConfig.SetDeleteValue(p+'ConfigFile/CustomConfigFile/Value', CustomConfigFile,false); 1889 aXMLConfig.SetDeleteValue(p+'ConfigFile/ConfigFilePath/Value', f(ConfigFilePath),'extrafpc.cfg'); 1890 aXMLConfig.SetDeleteValue(p+'CustomOptions/Value', 1891 LineBreaksToSystemLineBreaks(CustomOptions),''); // do not touch / \ characters 1892 aXMLConfig.SetDeleteValue(p+'ConfigFile/UseCommentsInCustomOptions/Value', UseCommentsInCustomOptions,false); 1893 1894 for i:=0 to FOtherDefines.Count-1 do 1895 aXMLConfig.SetDeleteValue(p+'OtherDefines/Define'+IntToStr(i)+'/Value', 1896 FOtherDefines[i],''); 1897 aXMLConfig.SetDeleteValue(p+'OtherDefines/Count',FOtherDefines.Count,0); 1898 1899 { Compilation } 1900 aXMLConfig.SetDeleteValue(p+'CompilerPath/Value', f(CompilerPath),DefaultCompilerPath); 1901 ExecuteBefore.SaveToXMLConfig(aXMLConfig,p+'ExecuteBefore/',UsePathDelim); 1902 ExecuteAfter.SaveToXMLConfig(aXMLConfig,p+'ExecuteAfter/',UsePathDelim); 1903 aXMLConfig.SetDeleteValue(p+'CreateMakefileOnBuild/Value', 1904 CreateMakefileOnBuild,false); 1905 // write 1906 Modified := False; 1907end; 1908 1909procedure TBaseCompilerOptions.SetModified(const AValue: boolean); 1910begin 1911 if Modified=AValue then exit; 1912 if AValue then begin 1913 IncreaseChangeStamp; 1914 if Assigned(OnModified) then 1915 OnModified(Self); 1916 end else begin 1917 FSavedChangeStamp:=ChangeStamp; 1918 fMessageFlags.Modified:=false; 1919 end; 1920end; 1921 1922class function TBaseCompilerOptions.GetInstance: TAbstractIDEOptions; 1923begin 1924 Result := nil; 1925end; 1926 1927class function TBaseCompilerOptions.GetGroupCaption: string; 1928begin 1929 Result := ''; 1930end; 1931 1932procedure TBaseCompilerOptions.ClearInheritedOptions; 1933var 1934 i: TInheritedCompilerOption; 1935 p: TCompilerOptionsParseType; 1936begin 1937 fInheritedOptParseStamps:=CTInvalidChangeStamp; 1938 for p:=Low(TCompilerOptionsParseType) to High(TCompilerOptionsParseType) do 1939 for i:=Low(TInheritedCompilerOption) to High(TInheritedCompilerOption) do 1940 begin 1941 fInheritedOptions[p][i]:=''; 1942 end; 1943end; 1944 1945procedure TBaseCompilerOptions.AppendDefaultExt(var aFilename: string); 1946var 1947 Ext: String; 1948begin 1949 if ExtractFileName(aFilename)='' then exit; 1950 Ext:=GetTargetFileExt; 1951 if (Ext<>'') and not FilenameExtIs(aFilename,Ext) then 1952 aFilename:=aFilename+Ext; 1953 //DebugLn('Filename is ',AFilename,' in AppendDefaultExt'); 1954end; 1955 1956procedure TBaseCompilerOptions.PrependDefaultType(var AFilename: string); 1957var 1958 Prefix, FileName, PathName, CurTargetOS, aSrcOS: String; 1959begin 1960 //DebugLn('Filename AFilename is ',AFilename, ' in PrependDefaultType'); 1961 if (ExtractFileName(AFilename)='') 1962 or (CompareText(copy(ExtractFileName(AFilename),1,3), 'lib') = 0) then exit; 1963 Prefix:=GetTargetFilePrefix; 1964 if Prefix<>'' then 1965 begin 1966 FileName := ExtractFileName(AFilename); 1967 PathName := ExtractFilePath(AFilename); 1968 //debugln ( 'Filename is ',FileName, ' in PrependDefaultType' ); 1969 CurTargetOS:=TargetOS; 1970 if CurTargetOS='' then CurTargetOS:=GetCompiledTargetOS; 1971 aSrcOS:=GetDefaultSrcOSForTargetOS(CurTargetOS); 1972 if CompareText(aSrcOS, 'unix') = 0 then 1973 AFilename:=PathName+Prefix+UTF8LowerCase(FileName) 1974 else 1975 AFilename:=PathName+Prefix+FileName; 1976 //DebugLn('AFilename is ',AFilename, ' in PrependDefaultType'); 1977 exit; 1978 end; 1979end; 1980 1981function TBaseCompilerOptions.CreateTargetFilename: string; 1982var 1983 UnitOutDir, OutFilename, Dir: String; 1984begin 1985 Result:=TargetFilename; 1986 if Assigned(ParsedOpts.OnLocalSubstitute) then 1987 Result:=ParsedOpts.OnLocalSubstitute(Result,false) 1988 else 1989 Result:=ParseString(ParsedOpts,Result,false); 1990 if (Result<>'') and FilenameIsAbsolute(Result) then begin 1991 // fully specified target filename 1992 end else if Result<>'' then begin 1993 //debugln(['TBaseCompilerOptions.CreateTargetFilename ParsedOpts.OutputDirectoryOverride=',ParsedOpts.OutputDirectoryOverride]); 1994 if ParsedOpts.OutputDirectoryOverride<>'' then 1995 begin 1996 // the program is put into the output directory 1997 UnitOutDir:=GetUnitOutPath(false); 1998 if UnitOutDir='' then 1999 UnitOutDir:=BaseDirectory; 2000 Result:=AppendPathDelim(UnitOutDir)+ExtractFileName(Result); 2001 end else if BaseDirectory<>'' then begin 2002 // the program is put relative to the base directory 2003 Result:=CreateAbsolutePath(Result,BaseDirectory); 2004 end else begin 2005 // put into test directory 2006 Dir:=EnvironmentOptions.GetParsedTestBuildDirectory; 2007 Result:=CreateAbsolutePath(Result,Dir); 2008 end; 2009 end else begin 2010 // no target given => put into unit output directory 2011 // calculate output directory 2012 UnitOutDir:=GetUnitOutPath(false); 2013 if UnitOutDir='' then 2014 UnitOutDir:=BaseDirectory; 2015 if UnitOutDir='' then 2016 UnitOutDir:=EnvironmentOptions.GetParsedTestBuildDirectory; 2017 OutFilename:=ExtractFileNameOnly(GetDefaultMainSourceFileName); 2018 //debugln('TBaseCompilerOptions.CreateTargetFilename MainSourceFileName=',MainSourceFileName,' OutFilename=',OutFilename,' TargetFilename=',TargetFilename,' UnitOutDir=',UnitOutDir); 2019 Result:=CreateAbsolutePath(OutFilename,UnitOutDir); 2020 end; 2021 Result:=TrimFilename(Result); 2022 if TargetFilenameApplyConventions then begin 2023 AppendDefaultExt(Result); 2024 PrependDefaultType(Result); 2025 end; 2026end; 2027 2028function TBaseCompilerOptions.GetTargetFileExt: string; 2029begin 2030 Result:=TargetFileExt; 2031 if Result<>'' then exit; 2032 case ExecutableType of 2033 cetProgram: 2034 Result:=GetExecutableExt(fTargetOS); 2035 cetLibrary: 2036 Result:=GetLibraryExt(fTargetOS); 2037 else 2038 RaiseGDBException(''); 2039 end; 2040 //DebugLn('TBaseCompilerOptions.GetTargetFileExt ',Result,' ',dbgs(ord(ExecutableType)),' ',fTargetOS); 2041end; 2042 2043function TBaseCompilerOptions.GetTargetFilePrefix: string; 2044begin 2045 case ExecutableType of 2046 cetLibrary: 2047 Result:=GetLibraryPrefix(fTargetOS); 2048 else 2049 Result:=''; 2050 end; 2051 //DebugLn('TBaseCompilerOptions.GetTargetFilePrefix ',Result,' ',dbgs(ord(ExecutableType)),' ',fTargetOS); 2052end; 2053 2054procedure TBaseCompilerOptions.GetInheritedCompilerOptions( 2055 var OptionsList: TFPList); 2056begin 2057 OptionsList:=nil; 2058end; 2059 2060function TBaseCompilerOptions.GetOwnerName: string; 2061begin 2062 if Owner<>nil then 2063 Result:=Owner.ClassName 2064 else 2065 Result:='This compiler options object has no owner'; 2066end; 2067 2068{------------------------------------------------------------------------------ 2069 function TBaseCompilerOptions.GetInheritedOption( 2070 Option: TInheritedCompilerOption; RelativeToBaseDir: boolean; 2071 Parsed: TCompilerOptionsParseType): string; 2072------------------------------------------------------------------------------} 2073function TBaseCompilerOptions.GetInheritedOption( 2074 Option: TInheritedCompilerOption; RelativeToBaseDir: boolean; 2075 Parsed: TCompilerOptionsParseType): string; 2076var 2077 AddOptionsList: TFPList; // list of TAdditionalCompilerOptions 2078 p: TCompilerOptionsParseType; 2079begin 2080 if (fInheritedOptParseStamps<>CompilerParseStamp) 2081 then begin 2082 // update all three inherited options: 2083 // coptUnparsed, coptParsed and coptParsedPlatformIndependent 2084 ClearInheritedOptions; 2085 AddOptionsList:=nil; 2086 GetInheritedCompilerOptions(AddOptionsList); 2087 if AddOptionsList<>nil then begin 2088 for p:=Low(TCompilerOptionsParseType) to High(TCompilerOptionsParseType) 2089 do begin 2090 GatherInheritedOptions(AddOptionsList,p,fInheritedOptions[p]); 2091 end; 2092 AddOptionsList.Free; 2093 end; 2094 fInheritedOptParseStamps:=CompilerParseStamp; 2095 end; 2096 Result:=fInheritedOptions[Parsed][Option]; 2097 if RelativeToBaseDir then begin 2098 if Option in [icoUnitPath,icoIncludePath,icoObjectPath,icoLibraryPath] then 2099 Result:=CreateRelativeSearchPath(Result,BaseDirectory); 2100 end; 2101end; 2102 2103function TBaseCompilerOptions.GetDefaultMainSourceFileName: string; 2104begin 2105 Result:=''; 2106end; 2107 2108function TBaseCompilerOptions.CanBeDefaulForProject: boolean; 2109begin 2110 Result:=false; 2111end; 2112 2113function TBaseCompilerOptions.NeedsLinkerOpts: boolean; 2114begin 2115 Result:=not (ccloNoLinkerOpts in fDefaultMakeOptionsFlags); 2116end; 2117 2118function TBaseCompilerOptions.HasCommands: boolean; 2119begin 2120 Result:=true; 2121 if CreateMakefileOnBuild then exit; 2122 if HasCompilerCommand then exit; 2123 if ExecuteBefore.HasCommands then exit; 2124 if ExecuteAfter.HasCommands then exit; 2125 Result:=false; 2126end; 2127 2128function TBaseCompilerOptions.HasCompilerCommand: boolean; 2129begin 2130 Result:=CompilerPath<>''; 2131end; 2132 2133function TBaseCompilerOptions.GetEffectiveTargetOS: string; 2134var 2135 Vars: TCTCfgScriptVariables; 2136 UnitSet: TFPCUnitSetCache; 2137 CfgCache: TPCTargetConfigCache; 2138begin 2139 Result:=''; 2140 Vars:=GetBuildMacroValues(Self,true); 2141 if Vars<>nil then 2142 Result:=GetFPCTargetOS(Vars.Values['TargetOS']); 2143 if Result='' then begin 2144 UnitSet:=CodeToolBoss.GetUnitSetForDirectory(BaseDirectory); 2145 if UnitSet<>nil then begin 2146 CfgCache:=UnitSet.GetConfigCache(false); 2147 if CfgCache<>nil then begin 2148 Result:=CfgCache.RealTargetOS; 2149 end; 2150 end; 2151 end; 2152 if Result='' then 2153 Result:=GetCompiledTargetOS; 2154end; 2155 2156function TBaseCompilerOptions.GetEffectiveTargetCPU: string; 2157var 2158 Vars: TCTCfgScriptVariables; 2159 UnitSet: TFPCUnitSetCache; 2160 CfgCache: TPCTargetConfigCache; 2161begin 2162 Result:=''; 2163 Vars:=GetBuildMacroValues(Self,true); 2164 if Vars<>nil then 2165 Result:=GetFPCTargetOS(Vars.Values['TargetCPU']); 2166 if Result='' then begin 2167 UnitSet:=CodeToolBoss.GetUnitSetForDirectory(BaseDirectory); 2168 if UnitSet<>nil then begin 2169 CfgCache:=UnitSet.GetConfigCache(false); 2170 if CfgCache<>nil then begin 2171 Result:=CfgCache.RealTargetCPU; 2172 end; 2173 end; 2174 end; 2175 if Result='' then 2176 Result:=GetCompiledTargetCPU; 2177end; 2178 2179function TBaseCompilerOptions.GetEffectiveLCLWidgetType: string; 2180var 2181 Vars: TCTCfgScriptVariables; 2182begin 2183 Result:=''; 2184 Vars:=GetBuildMacroValues(Self,true); 2185 if Vars<>nil then 2186 Result:=Vars.Values['LCLWidgetType']; 2187end; 2188 2189function TBaseCompilerOptions.GetUnitPath(RelativeToBaseDir: boolean; 2190 Parsed: TCompilerOptionsParseType; WithBaseDir: boolean): string; 2191begin 2192 Result:=GetPath(pcosUnitPath,icoUnitPath,RelativeToBaseDir,Parsed,WithBaseDir); 2193end; 2194 2195function TBaseCompilerOptions.GetNamespacesParsed(Parsed: TCompilerOptionsParseType 2196 ): string; 2197var 2198 CurNamespaces, InhNamespaces: String; 2199begin 2200 // this namespaces 2201 case Parsed of 2202 coptParsed: CurNamespaces:=ParsedOpts.GetParsedValue(pcosNamespaces); 2203 coptUnparsed: CurNamespaces:=ParsedOpts.Values[pcosNamespaces].UnparsedValue; 2204 coptParsedPlatformIndependent: 2205 CurNamespaces:=ParsedOpts.GetParsedPIValue(pcosNamespaces); 2206 else 2207 RaiseGDBException(''); 2208 end; 2209 // inherited namespaces 2210 InhNamespaces:=GetInheritedOption(icoNamespaces,false,Parsed); 2211 2212 // concatenate 2213 Result:=MergeWithDelimiter(CurNamespaces,InhNamespaces,';'); 2214 2215 // eliminate line breaks 2216 Result:=SpecialCharsToSpaces(Result,true); 2217end; 2218 2219function TBaseCompilerOptions.GetIncludePath(RelativeToBaseDir: boolean; 2220 Parsed: TCompilerOptionsParseType; WithBaseDir: boolean): string; 2221begin 2222 Result:=GetPath(pcosIncludePath,icoIncludePath,RelativeToBaseDir,Parsed, 2223 WithBaseDir); 2224end; 2225 2226function TBaseCompilerOptions.GetSrcPath(RelativeToBaseDir: boolean; 2227 Parsed: TCompilerOptionsParseType; WithBaseDir: boolean): string; 2228begin 2229 Result:=GetPath(pcosSrcPath,icoSrcPath,RelativeToBaseDir,Parsed,WithBaseDir); 2230end; 2231 2232function TBaseCompilerOptions.GetDebugPath(RelativeToBaseDir: boolean; 2233 Parsed: TCompilerOptionsParseType; WithBaseDir: boolean): string; 2234begin 2235 Result:=GetPath(pcosDebugPath,icoNone,RelativeToBaseDir,Parsed,WithBaseDir); 2236end; 2237 2238function TBaseCompilerOptions.GetLibraryPath(RelativeToBaseDir: boolean; 2239 Parsed: TCompilerOptionsParseType; WithBaseDir: boolean): string; 2240begin 2241 Result:=GetPath(pcosLibraryPath,icoLibraryPath,RelativeToBaseDir,Parsed, 2242 WithBaseDir); 2243end; 2244 2245function TBaseCompilerOptions.GetUnitOutputDirectory(RelativeToBaseDir: boolean 2246 ): string; 2247begin 2248 Result:=GetUnitOutPath(RelativeToBaseDir); 2249end; 2250 2251function TBaseCompilerOptions.GetUnitOutPath(RelativeToBaseDir: boolean; 2252 Parsed: TCompilerOptionsParseType): string; 2253begin 2254 case Parsed of 2255 coptUnparsed: Result:=ParsedOpts.Values[pcosOutputDir].UnparsedValue; 2256 coptParsed: Result:=ParsedOpts.GetParsedValue(pcosOutputDir); 2257 coptParsedPlatformIndependent: 2258 Result:=ParsedOpts.GetParsedPIValue(pcosOutputDir); 2259 end; 2260 if (not RelativeToBaseDir) then 2261 CreateAbsolutePath(Result,BaseDirectory); 2262end; 2263 2264function TBaseCompilerOptions.GetObjectPath(RelativeToBaseDir: boolean; 2265 Parsed: TCompilerOptionsParseType; WithBaseDir: boolean): string; 2266begin 2267 Result:=GetPath(pcosObjectPath,icoObjectPath,RelativeToBaseDir,Parsed, 2268 WithBaseDir); 2269end; 2270 2271function TBaseCompilerOptions.GetPath(Option: TParsedCompilerOptString; 2272 InheritedOption: TInheritedCompilerOption; RelativeToBaseDir: boolean; 2273 Parsed: TCompilerOptionsParseType; WithBaseDir: boolean): string; 2274var 2275 AddPath: String; 2276begin 2277 case Parsed of 2278 coptUnparsed: 2279 Result:=GetUnparsedPath(Option,InheritedOption,RelativeToBaseDir); 2280 coptParsed: 2281 Result:=GetParsedPath(Option,InheritedOption,RelativeToBaseDir); 2282 coptParsedPlatformIndependent: 2283 Result:=GetParsedPIPath(Option,InheritedOption,RelativeToBaseDir); 2284 else 2285 RaiseGDBException(''); 2286 end; 2287 if WithBaseDir then begin 2288 if RelativeToBaseDir then 2289 AddPath:='.' 2290 else 2291 AddPath:=BaseDirectory; 2292 if AddPath<>'' then 2293 Result:=MergeSearchPaths(Result,AddPath); 2294 end; 2295end; 2296 2297function TBaseCompilerOptions.GetParsedPath(Option: TParsedCompilerOptString; 2298 InheritedOption: TInheritedCompilerOption; 2299 RelativeToBaseDir: boolean; AddBaseDir: boolean = false): string; 2300var 2301 CurrentPath: String; 2302 InheritedPath: String; 2303 ParsedBaseDir: String; 2304begin 2305 // the first path is searched first 2306 2307 // current path 2308 if Option<>pcosNone then begin 2309 CurrentPath:=ParsedOpts.GetParsedValue(Option); 2310 {$IFDEF VerbosePkgUnitPath} 2311 if Option=pcosUnitPath then 2312 debugln('TBaseCompilerOptions.GetParsedPath GetParsedValue ',dbgsName(Self),' RelativeToBaseDir=',dbgs(RelativeToBaseDir),' CurrentPath="',CurrentPath,'"'); 2313 {$ENDIF} 2314 2315 if RelativeToBaseDir then 2316 CurrentPath:=CreateRelativeSearchPath(CurrentPath,BaseDirectory) 2317 else 2318 CurrentPath:=CreateAbsoluteSearchPath(CurrentPath,BaseDirectory); 2319 {$IFDEF VerbosePkgUnitPath} 2320 if Option=pcosUnitPath then 2321 debugln('TBaseCompilerOptions.GetParsedPath Absolute/Relative=',dbgs(RelativeToBaseDir),' SearchPath ',dbgsName(Self),' CurrentPath="',CurrentPath,'" BaseDirectory="',BaseDirectory,'"'); 2322 {$ENDIF} 2323 end else begin 2324 CurrentPath:=''; 2325 end; 2326 2327 // inherited path 2328 if InheritedOption<>icoNone then begin 2329 InheritedPath:=GetInheritedOption(InheritedOption,RelativeToBaseDir,coptParsed); 2330 {$IFDEF VerbosePkgUnitPath} 2331 if Option=pcosUnitPath then 2332 debugln('TBaseCompilerOptions.GetParsedPath Inherited ',dbgsName(Self),' InheritedPath="',InheritedPath,'"'); 2333 {$ENDIF} 2334 2335 Result:=MergeSearchPaths(CurrentPath,InheritedPath); 2336 {$IFDEF VerbosePkgUnitPath} 2337 if Option=pcosUnitPath then 2338 debugln('TBaseCompilerOptions.GetParsedPath Total ',dbgsName(Self),' Result="',Result,'"'); 2339 {$ENDIF} 2340 end else 2341 Result:=CurrentPath; 2342 2343 if AddBaseDir then begin 2344 ParsedBaseDir:=ParsedOpts.GetParsedValue(pcosBaseDir); 2345 if ParsedBaseDir<>'' then 2346 Result:=MergeSearchPaths(Result,ParsedBaseDir); 2347 end; 2348end; 2349 2350function TBaseCompilerOptions.GetParsedPIPath(Option: TParsedCompilerOptString; 2351 InheritedOption: TInheritedCompilerOption; RelativeToBaseDir: boolean 2352 ): string; 2353var 2354 CurrentPath: String; 2355 InheritedPath: String; 2356begin 2357 // current path 2358 CurrentPath:=ParsedOpts.GetParsedPIValue(Option); 2359 {$IFDEF VerbosePkgUnitPath} 2360 if Option=pcosUnitPath then 2361 debugln('TBaseCompilerOptions.GetParsedPIPath GetParsedPIValue ',dbgsName(Self),' RelativeToBaseDir=',dbgs(RelativeToBaseDir),' CurrentPath="',CurrentPath,'" BaseDirectory="',BaseDirectory,'"'); 2362 {$ENDIF} 2363 2364 if RelativeToBaseDir then 2365 CurrentPath:=CreateRelativeSearchPath(CurrentPath,BaseDirectory) 2366 else 2367 CurrentPath:=CreateAbsoluteSearchPath(CurrentPath,BaseDirectory); 2368 {$IFDEF VerbosePkgUnitPath} 2369 if Option=pcosUnitPath then 2370 debugln('TBaseCompilerOptions.GetParsedPIPath Abs/Rel ',dbgsName(Self),' CurrentPath="',CurrentPath,'"'); 2371 {$ENDIF} 2372 2373 // inherited path 2374 InheritedPath:=GetInheritedOption(InheritedOption,RelativeToBaseDir, 2375 coptParsedPlatformIndependent); 2376 {$IFDEF VerbosePkgUnitPath} 2377 if Option=pcosUnitPath then 2378 debugln('TBaseCompilerOptions.GetParsedPIPath Inherited ',dbgsName(Self),' InheritedPath="',InheritedPath,'"'); 2379 {$ENDIF} 2380 2381 Result:=MergeSearchPaths(CurrentPath,InheritedPath); 2382 {$IFDEF VerbosePkgUnitPath} 2383 if Option=pcosUnitPath then 2384 debugln('TBaseCompilerOptions.GetParsedPIPath Total ',dbgsName(Self),' Result="',Result,'"'); 2385 {$ENDIF} 2386end; 2387 2388function TBaseCompilerOptions.GetUnparsedPath(Option: TParsedCompilerOptString; 2389 InheritedOption: TInheritedCompilerOption; RelativeToBaseDir: boolean 2390 ): string; 2391var 2392 CurrentPath: String; 2393 InheritedPath: String; 2394begin 2395 // current path 2396 CurrentPath:=ParsedOpts.Values[Option].UnparsedValue; 2397 {$IFDEF VerbosePkgUnitPath} 2398 if Option=pcosUnitPath then 2399 debugln('TBaseCompilerOptions.GetUnparsedPath GetParsedValue ',dbgsName(Self),' RelativeToBaseDir=',dbgs(RelativeToBaseDir),' CurrentPath="',CurrentPath,'"'); 2400 {$ENDIF} 2401 2402 if (not RelativeToBaseDir) then 2403 CreateAbsoluteSearchPath(CurrentPath,BaseDirectory); 2404 {$IFDEF VerbosePkgUnitPath} 2405 if Option=pcosUnitPath then 2406 debugln('TBaseCompilerOptions.GetUnparsedPath CreateAbsoluteSearchPath ',dbgsName(Self),' CurrentPath="',CurrentPath,'"'); 2407 {$ENDIF} 2408 2409 // inherited path 2410 InheritedPath:=GetInheritedOption(InheritedOption,RelativeToBaseDir, 2411 coptUnparsed); 2412 {$IFDEF VerbosePkgUnitPath} 2413 if Option=pcosUnitPath then 2414 debugln('TBaseCompilerOptions.GetUnparsedPath Inherited ',dbgsName(Self),' InheritedPath="',InheritedPath,'"'); 2415 {$ENDIF} 2416 2417 Result:=MergeSearchPaths(CurrentPath,InheritedPath); 2418 {$IFDEF VerbosePkgUnitPath} 2419 if Option=pcosUnitPath then 2420 debugln('TBaseCompilerOptions.GetUnparsedPath Total ',dbgsName(Self),' Result="',Result,'"'); 2421 {$ENDIF} 2422end; 2423 2424function TBaseCompilerOptions.GetCustomOptions( 2425 Parsed: TCompilerOptionsParseType): string; 2426var 2427 CurCustomOptions: String; 2428 InhCustomOptions: String; 2429begin 2430 // custom options 2431 case Parsed of 2432 coptParsed: CurCustomOptions:=ParsedOpts.GetParsedValue(pcosCustomOptions); 2433 coptUnparsed: CurCustomOptions:=ParsedOpts.Values[pcosCustomOptions].UnparsedValue; 2434 coptParsedPlatformIndependent: 2435 CurCustomOptions:=ParsedOpts.GetParsedPIValue(pcosCustomOptions); 2436 else 2437 RaiseGDBException(''); 2438 end; 2439 // inherited custom options 2440 InhCustomOptions:=GetInheritedOption(icoCustomOptions,true,Parsed); 2441 2442 // concatenate 2443 Result:=MergeCustomOptions(InhCustomOptions,CurCustomOptions); 2444 2445 // eliminate line breaks 2446 Result:=SpecialCharsToSpaces(Result,true); 2447end; 2448 2449function TBaseCompilerOptions.TrimCustomOptions(o: string): string; 2450begin 2451 Result:=SpecialCharsToSpaces(o,true); 2452end; 2453 2454function TBaseCompilerOptions.GetOptionsForCTDefines: string; 2455 2456 procedure Add(s: string); 2457 begin 2458 if Result<>'' then 2459 Result:=Result+' '; 2460 Result:=Result+s; 2461 end; 2462 2463begin 2464 Result:=MakeOptionsString([ccloNoMacroParams]); 2465 Add(GetCustomOptions(coptParsed)); 2466end; 2467 2468procedure TBaseCompilerOptions.RenameMacro(const OldName, NewName: string; 2469 ChangeConditionals: boolean); 2470var 2471 Changed: TParsedCompilerOptStrings; 2472 s: String; 2473begin 2474 ParsedOpts.RenameMacro(OldName,NewName,Changed); 2475 if Changed<>[] then begin 2476 2477 end; 2478 if ChangeConditionals then 2479 begin 2480 s:=Conditionals; 2481 RenameCTCSVariable(s,OldName,NewName); 2482 Conditionals:=s; 2483 end; 2484end; 2485 2486procedure TBaseCompilerOptions.MergeToIncludePaths(const AddSearchPath: string); 2487begin 2488 SetIncludePaths(MergeSearchPaths(GetIncludePaths,AddSearchPath)); 2489end; 2490 2491procedure TBaseCompilerOptions.MergeToLibraryPaths(const AddSearchPath: string); 2492begin 2493 SetLibraryPaths(MergeSearchPaths(GetLibraryPaths,AddSearchPath)); 2494end; 2495 2496procedure TBaseCompilerOptions.MergeToNamespaces(const AddNamespaces: string); 2497begin 2498 SetNamespaces(MergeWithDelimiter(GetNamespacesParsed,AddNamespaces,';')); 2499end; 2500 2501procedure TBaseCompilerOptions.MergeToUnitPaths(const AddSearchPath: string); 2502begin 2503 SetUnitPaths(MergeSearchPaths(GetUnitPaths,AddSearchPath)); 2504end; 2505 2506procedure TBaseCompilerOptions.MergeToObjectPath(const AddSearchPath: string); 2507begin 2508 SetObjectPath(MergeSearchPaths(GetObjectPath,AddSearchPath)); 2509end; 2510 2511procedure TBaseCompilerOptions.MergeToSrcPath(const AddSearchPath: string); 2512begin 2513 SetSrcPath(MergeSearchPaths(GetSrcPath,AddSearchPath)); 2514end; 2515 2516procedure TBaseCompilerOptions.MergeToDebugPath(const AddSearchPath: string); 2517begin 2518 SetDebugPath(MergeSearchPaths(GetDebugPath,AddSearchPath)); 2519end; 2520 2521procedure TBaseCompilerOptions.RemoveFromUnitPaths(const RemSearchPath: string); 2522begin 2523 SetUnitPaths(RemoveSearchPaths(GetUnitPaths,RemSearchPath)); 2524end; 2525 2526function TBaseCompilerOptions.ShortenPath(const SearchPath: string): string; 2527begin 2528 Result:=ShortenSearchPath(TrimSearchPath(SearchPath,''),BaseDirectory,BaseDirectory); 2529end; 2530 2531{------------------------------------------------------------------------------ 2532 function TBaseCompilerOptions.MakeOptionsString( 2533 const MainSourceFilename: string; 2534 Flags: TCompilerCmdLineOptions): String; 2535 2536 Get all the options and create a string that can be passed to the compiler 2537------------------------------------------------------------------------------} 2538function TBaseCompilerOptions.MakeOptionsString( 2539 Flags: TCompilerCmdLineOptions): String; 2540var 2541 switches, tempsw, quietsw, t: String; 2542 InhLinkerOpts: String; 2543 CurTargetFilename: String; 2544 CurTargetDirectory: String; 2545 CurIncludePath: String; 2546 CurLibraryPath: String; 2547 CurUnitPath: String; 2548 CurOutputDir: String; 2549 CurLinkerOptions: String; 2550 CurObjectPath: String; 2551 CurMainSrcFile: String; 2552 CurCustomOptions: String; 2553 OptimizeSwitches: String; 2554 Vars: TCTCfgScriptVariables; 2555 CurTargetOS: String; 2556 CurTargetCPU: String; 2557 CurSrcOS: String; 2558 dit: TCompilerDbgSymbolType; 2559 CompilerFilename: String; 2560 DefaultTargetOS: string; 2561 DefaultTargetCPU: string; 2562 RealCompilerFilename: String; 2563 CurNamespaces: string; 2564 CurFPCMsgFile: TFPCMsgFilePoolItem; 2565 Quiet: Boolean; 2566 Kind: TPascalCompiler; 2567 2568 procedure EnableDisableVerbosityFlag(Enable: boolean; c: char); 2569 begin 2570 if Quiet or not Enable then 2571 quietsw+=c+'-' 2572 else 2573 tempsw+=c; 2574 end; 2575 2576 procedure EnableVerbosityFlag(Enable: boolean; c: char); 2577 begin 2578 if Quiet then 2579 quietsw+=c+'-' 2580 else if Enable then 2581 tempsw+=c; 2582 end; 2583 2584 function FixExeExtForEmbeddedCompiler(exename: string): string; 2585 begin 2586 if SameStr(TargetOS, 'embedded') then 2587 Result := ChangeFileExt(exename, '') 2588 else 2589 Result := exename; 2590 end; 2591 2592begin 2593 switches := ''; 2594 2595 { options of fpc 2.7.1 : 2596 2597 Free Pascal Compiler version 2.7.1 [2012/01/23] for x86_64 2598 Copyright (c) 1993-2011 by Florian Klaempfl and others 2599 /usr/lib/fpc/2.7.1/ppcx64 [options] <inputfile> [options] 2600 Put + after a boolean switch option to enable it, - to disable it 2601 -a The compiler doesn't delete the generated assembler file 2602 -al List sourcecode lines in assembler file 2603 -an List node info in assembler file 2604 -ap Use pipes instead of creating temporary assembler files 2605 -ar List register allocation/release info in assembler file 2606 -at List temp allocation/release info in assembler file 2607 -A<x> Output format: 2608 -Adefault Use default assembler 2609 -Aas Assemble using GNU AS 2610 -Agas Assemble using GNU GAS 2611 -Agas-darwinAssemble darwin Mach-O64 using GNU GAS 2612 -Amasm Win64 object file using ml64 (Microsoft) 2613 -Apecoff PE-COFF (Win64) using internal writer 2614 -Aelf ELF (Linux-64bit) using internal writer 2615 -b Generate browser info 2616 -bl Generate local symbol info 2617 -B Build all modules 2618 -C<x> Code generation options: 2619 -C3<x> Turn on ieee error checking for constants 2620 -Ca<x> Select ABI, see fpc -i for possible values 2621 -Cb Generate big-endian code 2622 -Cc<x> Set default calling convention to <x> 2623 -CD Create also dynamic library (not supported) 2624 -Ce Compilation with emulated floating point opcodes 2625 -Cf<x> Select fpu instruction set to use, see fpc -i for possible values 2626 -CF<x> Minimal floating point constant precision (default, 32, 64) 2627 -Cg Generate PIC code 2628 -Ch<n> <n> bytes heap (between 1023 and 67107840) 2629 -Ci IO-checking 2630 -Cn Omit linking stage 2631 -Co Check overflow of integer operations 2632 -CO Check for possible overflow of integer operations 2633 -Cp<x> Select instruction set, see fpc -i for possible values 2634 -CP<x>=<y> packing settings 2635 -CPPACKSET=<y> <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, 4 and 8 2636 -Cr Range checking 2637 -CR Verify object method call validity 2638 -Cs<n> Set stack checking size to <n> 2639 -Ct Stack checking (for testing only, see manual) 2640 -CX Create also smartlinked library 2641 -d<x> Defines the symbol <x> 2642 -D Generate a DEF file 2643 -Dd<x> Set description to <x> 2644 -Dv<x> Set DLL version to <x> 2645 -e<x> Set path to executable 2646 -E Same as -Cn 2647 -fPIC Same as -Cg 2648 -F<x> Set file names and paths: 2649 -Fa<x>[,y] (for a program) load units <x> and [y] before uses is parsed 2650 -Fc<x> Set input codepage to <x> 2651 -FC<x> Set RC compiler binary name to <x> 2652 -Fd Disable the compiler's internal directory cache 2653 -FD<x> Set the directory where to search for compiler utilities 2654 -Fe<x> Redirect error output to <x> 2655 -Ff<x> Add <x> to framework path (Darwin only) 2656 -FE<x> Set exe/unit output path to <x> 2657 -Fi<x> Add <x> to include path 2658 -Fl<x> Add <x> to library path 2659 -FL<x> Use <x> as dynamic linker 2660 -Fm<x> Load unicode conversion table from <x>.txt in the compiler dir 2661 -Fo<x> Add <x> to object path 2662 -Fr<x> Load error message file <x> 2663 -FR<x> Set resource (.res) linker to <x> 2664 -Fu<x> Add <x> to unit path 2665 -FU<x> Set unit output path to <x>, overrides -FE 2666 -FW<x> Store generated whole-program optimization feedback in <x> 2667 -Fw<x> Load previously stored whole-program optimization feedback from <x> 2668 -g Generate debug information (default format for target) 2669 -gc Generate checks for pointers 2670 -gh Use heaptrace unit (for memory leak/corruption debugging) 2671 -gl Use line info unit (show more info with backtraces) 2672 -go<x> Set debug information options 2673 -godwarfsets Enable DWARF 'set' type debug information (breaks gdb < 6.5) 2674 -gostabsabsincludes Store absolute/full include file paths in Stabs 2675 -godwarfmethodclassprefix Prefix method names in DWARF with class name 2676 -gp Preserve case in stabs symbol names 2677 -gs Generate Stabs debug information 2678 -gt Trash local variables (to detect uninitialized uses) 2679 -gv Generates programs traceable with Valgrind 2680 -gw Generate DWARFv2 debug information (same as -gw2) 2681 -gw2 Generate DWARFv2 debug information 2682 -gw3 Generate DWARFv3 debug information 2683 -gw4 Generate DWARFv4 debug information (experimental) 2684 -i Information 2685 -iD Return compiler date 2686 -iV Return short compiler version 2687 -iW Return full compiler version 2688 -iSO Return compiler OS 2689 -iSP Return compiler host processor 2690 -iTO Return target OS 2691 -iTP Return target processor 2692 -I<x> Add <x> to include path 2693 -k<x> Pass <x> to the linker 2694 -l Write logo 2695 -M<x> Set language mode to <x> 2696 -Mfpc Free Pascal dialect (default) 2697 -Mobjfpc FPC mode with Object Pascal support 2698 -Mdelphi Delphi 7 compatibility mode 2699 -Mtp TP/BP 7.0 compatibility mode 2700 -Mmacpas Macintosh Pascal dialects compatibility mode 2701 -n Do not read the default config files 2702 -N<x> Node tree optimizations 2703 -Nu Unroll loops 2704 -o<x> Change the name of the executable produced to <x> 2705 -O<x> Optimizations: 2706 -O- Disable optimizations 2707 -O1 Level 1 optimizations (quick and debugger friendly) 2708 -O2 Level 2 optimizations (-O1 + quick optimizations) 2709 -O3 Level 3 optimizations (-O2 + slow optimizations) 2710 -Oa<x>=<y> Set alignment 2711 -Oo[NO]<x> Enable or disable optimizations, see fpc -i for possible values 2712 -Op<x> Set target cpu for optimizing, see fpc -i for possible values 2713 -OW<x> Generate whole-program optimization feedback for optimization <x>, see fpc -i for possible values 2714 -Ow<x> Perform whole-program optimization <x>, see fpc -i for possible values 2715 -Os Optimize for size rather than speed 2716 -pg Generate profile code for gprof (defines FPC_PROFILE) 2717 -R<x> Assembler reading style: 2718 -Rdefault Use default assembler for target 2719 -S<x> Syntax options: 2720 -S2 Same as -Mobjfpc 2721 -Sc Support operators like C (*=,+=,/= and -=) 2722 -Sa Turn on assertions 2723 -Sd Same as -Mdelphi 2724 -Se<x> Error options. <x> is a combination of the following: 2725 <n> : Compiler halts after the <n> errors (default is 1) 2726 w : Compiler also halts after warnings 2727 n : Compiler also halts after notes 2728 h : Compiler also halts after hints 2729 -Sg Enable LABEL and GOTO (default in -Mtp and -Mdelphi) 2730 -Sh Use ansistrings by default instead of shortstrings 2731 -Si Turn on inlining of procedures/functions declared as "inline" 2732 -Sk Load fpcylix unit 2733 -SI<x> Set interface style to <x> 2734 -SIcom COM compatible interface (default) 2735 -SIcorba CORBA compatible interface 2736 -Sm Support macros like C (global) 2737 -So Same as -Mtp 2738 -Ss Constructor name must be init (destructor must be done) 2739 -Sx Enable exception keywords (default in Delphi/ObjFPC modes) 2740 -Sy @<pointer> returns a typed pointer, same as $T+ 2741 -s Do not call assembler and linker 2742 -sh Generate script to link on host 2743 -st Generate script to link on target 2744 -sr Skip register allocation phase (use with -alr) 2745 -T<x> Target operating system: 2746 -Tdarwin Darwin/Mac OS X 2747 -Tlinux Linux 2748 -Twin64 Win64 (64 bit Windows systems) 2749 -u<x> Undefines the symbol <x> 2750 -U Unit options: 2751 -Un Do not check where the unit name matches the file name 2752 -Ur Generate release unit files (never automatically recompiled) 2753 -Us Compile a system unit 2754 -v<x> Be verbose. <x> is a combination of the following letters: 2755 e : Show errors (default) 0 : Show nothing (except errors) 2756 w : Show warnings u : Show unit info 2757 n : Show notes t : Show tried/used files 2758 h : Show hints c : Show conditionals 2759 i : Show general info d : Show debug info 2760 l : Show linenumbers r : Rhide/GCC compatibility mode 2761 s : Show time stamps q : Show message numbers 2762 a : Show everything x : Executable info (Win32 only) 2763 b : Write file names messages p : Write tree.log with parse tree 2764 with full path v : Write fpcdebug.txt with 2765 lots of debugging info 2766 m<x>,<y> : Don't show messages numbered <x> and <y> 2767 -W<x> Target-specific options (targets) 2768 -WA Specify native type application (Windows) 2769 -Wb Create a bundle instead of a library (Darwin) 2770 -WB Create a relocatable image (Windows) 2771 -WBxxxx Set image base to xxxx (Windows) 2772 -WC Specify console type application (EMX, OS/2, Windows) 2773 -WD Use DEFFILE to export functions of DLL or EXE (Windows) 2774 -We Use external resources (Darwin) 2775 -WG Specify graphic type application (EMX, OS/2, Windows) 2776 -Wi Use internal resources (Darwin) 2777 -WI Turn on/off the usage of import sections (Windows) 2778 -WM<x> Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwin) 2779 -WN Do not generate relocation code, needed for debugging (Windows) 2780 -WR Generate relocation code (Windows) 2781 -WX Enable executable stack (Linux) 2782 -X Executable options: 2783 -Xc Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Linux) 2784 -Xd Do not search default library path (sometimes required for cross-compiling when not using -XR) 2785 -Xe Use external linker 2786 -Xg Create debuginfo in a separate file and add a debuglink section to executable 2787 -XD Try to link units dynamically (defines FPC_LINK_DYNAMIC) 2788 -Xi Use internal linker 2789 -Xm Generate link map 2790 -XM<x> Set the name of the 'main' program routine (default is 'main') 2791 -XP<x> Prepend the binutils names with the prefix <x> 2792 -Xr<x> Set the linker's rlink-path to <x> (needed for cross compile, see the ld manual for more information) (BeOS, Linux) 2793 -XR<x> Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) 2794 -Xs Strip all symbols from executable 2795 -XS Try to link units statically (default, defines FPC_LINK_STATIC) 2796 -Xt Link with static libraries (-static is passed to linker) 2797 -XX Try to smartlink units (defines FPC_LINK_SMART) 2798 2799 -? Show this help 2800 -h Shows this help without waiting 2801 2802 ------------------------------------------------------------------------------ 2803 ppcx64 -i 2804 Free Pascal Compiler version 2.7.1 2805 2806 Compiler Date : 2012/01/23 2807 Compiler CPU Target: x86_64 2808 2809 Supported targets: 2810 Linux for x86-64 2811 FreeBSD for x86-64 2812 Win64 for x64 2813 Darwin for x86_64 2814 Solaris for x86-64 (under development) 2815 2816 Supported CPU instruction sets: 2817 ATHLON64 2818 2819 Supported FPU instruction sets: 2820 SSE64 2821 SSE3 2822 2823 Supported ABI targets: 2824 DEFAULT 2825 SYSV 2826 AIX 2827 EABI 2828 ARMEB 2829 2830 Supported Optimizations: 2831 REGVAR 2832 STACKFRAME 2833 LOOPUNROLL 2834 TAILREC 2835 CSE 2836 2837 Supported Whole Program Optimizations: 2838 All 2839 DEVIRTCALLS 2840 OPTVMTS 2841 SYMBOLLIVENESS 2842 2843 Supported Microcontroller types: 2844 } 2845 Quiet:=ConsoleVerbosity<=-3; // lazbuild -q -q, lazarus -q -q -q 2846 2847 CompilerFilename:=ParsedOpts.GetParsedValue(pcosCompilerPath); 2848 if CompilerFilename<>'' then begin 2849 RealCompilerFilename:=CompilerFilename; 2850 Kind:=CodeToolBoss.GetPascalCompilerForDirectory(BaseDirectory); 2851 end 2852 else begin 2853 // use default compiler 2854 RealCompilerFilename:=EnvironmentOptions.GetParsedCompilerFilename; 2855 Kind:=pcFPC; 2856 end; 2857 2858 if ccloAddCompilerPath in Flags then 2859 switches:=ConvertOptionsToCmdLine('',RealCompilerFilename); 2860 //writeln('TBaseCompilerOptions.MakeOptionsString RealCompilerFilename="',RealCompilerFilename,'" switches="',switches,'"'); 2861 2862 CurTargetOS:=''; 2863 CurTargetCPU:=''; 2864 if not (ccloNoMacroParams in Flags) then 2865 begin 2866 Vars:=GetBuildMacroValues(Self,true); 2867 if Vars<>nil then 2868 begin 2869 CurTargetOS:=GetFPCTargetOS(Vars.Values['TargetOS']); 2870 CurTargetCPU:=GetFPCTargetCPU(Vars.Values['TargetCPU']); 2871 end; 2872 end; 2873 CurSrcOS:=GetDefaultSrcOSForTargetOS(CurTargetOS); 2874 2875 CodeToolBoss.CompilerDefinesCache.ConfigCaches.GetDefaultCompilerTarget( 2876 RealCompilerFilename,'',DefaultTargetOS,DefaultTargetCPU); 2877 2878 { ------------------ Target --------------------- } 2879 2880 { Target OS } 2881 if (CurTargetOS<>'') 2882 and ((TargetOS<>'') or (CurTargetOS<>DefaultTargetOS)) then 2883 switches := switches + ' -T' + CurTargetOS; 2884 { Target CPU } 2885 if (CurTargetCPU<>'') 2886 and ((TargetCPU<>'') or (CurTargetCPU<>DefaultTargetCPU)) then 2887 switches := switches + ' -P' + CurTargetCPU; 2888 { TargetProcessor } 2889 if TargetProcessor<>'' then 2890 Switches:=Switches+' -Cp'+UpperCase(TargetProcessor); 2891 2892 { --------------- Parsing Tab ------------------- } 2893 2894 { Assembler reading style -Ratt = AT&T -Rintel = Intel -Rdirect = direct } 2895 case AssemblerStyle of 2896 1: switches := switches + ' -Rintel'; 2897 2: switches := switches + ' -Ratt'; 2898 3: switches := switches + ' -Rdirect'; 2899 end; 2900 2901 // Syntax Options 2902 tempsw:=GetSyntaxOptionsString(Kind); 2903 if (tempsw <> '') then 2904 switches := switches + ' ' + tempsw; 2905 2906 { ----------- Code Generation Tab --------------- } 2907 2908 { UnitStyle '' = Static 'D' = Dynamic (not implemented) 'X' = smart linked } 2909 if SmartLinkUnit then 2910 switches := switches + ' -CX'; 2911 if RelocatableUnit and (CurSrcOS='win') then 2912 switches := switches + ' -WR'; 2913 if (not (ccloNoMacroParams in Flags)) 2914 and TargetNeedsFPCOptionCG(CurTargetOS,CurTargetCPU) then 2915 switches := switches + ' -Cg'; // see bug 17412 2916 2917 { Checks } 2918 tempsw := ''; 2919 2920 if IOChecks then 2921 tempsw := tempsw + 'i'; 2922 if RangeChecks then 2923 tempsw := tempsw + 'r'; 2924 if OverflowChecks then 2925 tempsw := tempsw + 'o'; 2926 if StackChecks then 2927 tempsw := tempsw + 't'; 2928 if EmulatedFloatOpcodes then 2929 tempsw := tempsw + 'e'; 2930 if VerifyObjMethodCall then 2931 tempsw := tempsw + 'R'; 2932 2933 if (tempsw <> '') then 2934 switches := switches + ' -C' + tempsw; 2935 2936 { Heap Size } 2937 if (HeapSize > 0) then 2938 switches := switches + ' ' + '-Ch' + IntToStr(HeapSize); 2939 2940 { Stack Size } 2941 if (StackSize > 0) then 2942 switches := switches + ' ' + '-Cs' + IntToStr(StackSize); 2943 2944 { Optimizations } 2945 OptimizeSwitches:=''; 2946 if SmallerCode then 2947 OptimizeSwitches := OptimizeSwitches + 's'; 2948 { OptimizationLevel 1 = Level 1 2 = Level 2 3 = Level 3 } 2949 if OptimizationLevel>0 then 2950 OptimizeSwitches := OptimizeSwitches + IntToStr(OptimizationLevel); 2951 if OptimizeSwitches<>'' then 2952 switches := switches + ' -O'+OptimizeSwitches; 2953 2954 // uncertain 2955 if UncertainOptimizations then 2956 Switches := Switches + ' -OoUNCERTAIN'; 2957 2958 // registers 2959 if VariablesInRegisters then 2960 Switches := Switches + ' -OoREGVAR'; 2961 2962 { --------------- Linking Tab ------------------- } 2963 2964 { Debugging } 2965 { Debug Info for GDB } 2966 if GenerateDebugInfo then begin 2967 2968 dit := DebugInfoType; 2969 case dit of 2970 dsAuto: 2971 if Kind=pcFPC then begin 2972 if (not (ccloNoMacroParams in Flags)) and (CurTargetOS='darwin') then 2973 switches += ' -gw' 2974 else 2975 switches += ' -g'; 2976 end; 2977 dsStabs: switches := switches + ' -gs'; 2978 dsDwarf2: switches := switches + ' -gw2'; 2979 dsDwarf2Set: switches := switches + ' -gw2 -godwarfsets'; 2980 dsDwarf3: switches := switches + ' -gw3'; 2981 end; 2982 2983 { Line Numbers in Run-time Error Backtraces - Use LineInfo Unit } 2984 if UseLineInfoUnit then 2985 switches := switches + ' -gl'; 2986 2987 { Use Heaptrc Unit } 2988 if UseHeaptrc and (not (ccloNoLinkerOpts in Flags)) then 2989 switches := switches + ' -gh'; 2990 2991 { Generate code for Valgrind } 2992 if UseValgrind and (not (ccloNoLinkerOpts in Flags)) then 2993 switches := switches + ' -gv'; 2994 2995 if UseExternalDbgSyms then 2996 switches := switches + ' -Xg'; 2997 2998 end 2999 else begin 3000 // no debug info wanted 3001 3002 { Use Heaptrc Unit } 3003 if (UseHeaptrc) and (not (ccloNoLinkerOpts in Flags)) then 3004 switches := switches + ' -g-h'; // heaptrc, without -g 3005 end; 3006 3007 { Trash variables } 3008 if TrashVariables then 3009 switches := switches + ' -gt'; 3010 3011 { Generate code gprof } 3012 if GenGProfCode then 3013 switches := switches + ' -pg'; 3014 3015 { Strip Symbols } 3016 if StripSymbols and (not (ccloNoLinkerOpts in Flags)) then 3017 switches := switches + ' -Xs'; 3018 3019 { Link Style 3020 -XD = Link with dynamic libraries 3021 -XS = Link with static libraries, default on non-win32 platforms 3022 -XX = Link smart 3023 } 3024 3025 if (not (ccloNoLinkerOpts in Flags)) and LinkSmart then 3026 switches := switches + ' -XX'; 3027 3028 // additional Linker options 3029 if (not (ccloNoLinkerOpts in Flags)) 3030 and (not (ccloNoMacroParams in Flags)) then 3031 begin 3032 if PassLinkerOptions then 3033 begin 3034 CurLinkerOptions:=ParsedOpts.GetParsedValue(pcosLinkerOptions); 3035 if (CurLinkerOptions<>'') then 3036 switches := switches + ' ' + ConvertOptionsToCmdLine('-k', CurLinkerOptions); 3037 end; 3038 3039 // inherited Linker options 3040 InhLinkerOpts:=GetInheritedOption(icoLinkerOptions, 3041 not (ccloAbsolutePaths in Flags),coptParsed); 3042 //debugln(['TBaseCompilerOptions.MakeOptionsString InhLinkerOpts="',InhLinkerOpts,'"']); 3043 if InhLinkerOpts<>'' then 3044 switches := switches + ' ' + ConvertOptionsToCmdLine('-k', InhLinkerOpts); 3045 end; 3046 3047 if Win32GraphicApp 3048 and ((CurSrcOS='win') or (CurTargetOS='macos') or (CurTargetOS='os2')) then 3049 switches := switches + ' -WG'; 3050 3051 { ---------------- Other Tab -------------------- } 3052 3053 { Verbosity } 3054 if Quiet then 3055 switches := switches + ' -l-' 3056 else if WriteFPCLogo then 3057 switches := switches + ' -l'; 3058 3059 tempsw := ''; 3060 quietsw := ''; 3061 // the default fpc.cfg normally contains -viwn, if the user does not want 3062 // to see warnings pass -vw- 3063 tempsw := tempsw + 'e'; // always pass -ve, you cannot ignore errors 3064 EnableDisableVerbosityFlag(ShowWarn,'w'); 3065 EnableDisableVerbosityFlag(ShowNotes,'n'); 3066 EnableDisableVerbosityFlag(ShowHints,'h'); 3067 // always pass -vi for IDE, (e.g. (3104) Compiling) needed to resolve filenames in fpc messages without path 3068 EnableVerbosityFlag(true,'i'); 3069 // optional verbosity flags, usually off in fpc.cfg, pass them only if wanted 3070 EnableVerbosityFlag(ShowLineNum,'l'); 3071 EnableVerbosityFlag(ShowDebugInfo,'d'); 3072 EnableVerbosityFlag(ShowUsedFiles,'u'); 3073 EnableVerbosityFlag(ShowTriedFiles,'t'); 3074 EnableVerbosityFlag(ShowCompProc,'p'); 3075 EnableVerbosityFlag(ShowCond,'c'); 3076 EnableVerbosityFlag(ShowExecInfo,'x'); 3077 3078 if (ShowAll and not Quiet) or (ccloAddVerboseAll in Flags) then 3079 tempsw := 'a'; 3080 tempsw := tempsw + 'bq'; // b = full file names, q = message ids 3081 3082 if (tempsw <> '') then 3083 switches := switches + ' -v' + tempsw; 3084 if (quietsw <> '') then 3085 switches := switches + ' -v' + quietsw; 3086 3087 // -vm flags allow to enable/disable types of messages 3088 // Passing a -vm ID, unknown by the current compiler will create an error 3089 // => check the compiler message file 3090 if IDEMessageFlags.Count>0 then begin 3091 if FPCMsgFilePool<>nil then begin 3092 CurFPCMsgFile:=FPCMsgFilePool.LoadCurrentEnglishFile(true,nil); 3093 if CurFPCMsgFile<>FFPCMsgFile then begin 3094 if FFPCMsgFile<>nil then 3095 FPCMsgFilePool.UnloadFile(FFPCMsgFile); 3096 FFPCMsgFile:=CurFPCMsgFile; 3097 end else 3098 FPCMsgFilePool.UnloadFile(CurFPCMsgFile); 3099 end; 3100 t := IDEMessageFlags.GetMsgIdList(',',cfvHide,FFPCMsgFile); 3101 if t <> '' then 3102 switches := switches + ' ' + PrepareCmdLineOption('-vm'+t); 3103 t := IDEMessageFlags.GetMsgIdList(',',cfvShow,FFPCMsgFile); 3104 if t <> '' then 3105 switches := switches + ' ' + PrepareCmdLineOption('-vm-'+t); 3106 end; 3107 3108 if (StopAfterErrCount>1) then 3109 switches := switches + ' -Se'+IntToStr(StopAfterErrCount); 3110 3111 { Ignore Config File } 3112 if DontUseConfigFile then 3113 switches := switches + ' -n'; 3114 3115 { Use Custom Config File @ = yes and path } 3116 if not (ccloNoMacroParams in Flags) 3117 and (CustomConfigFile) and (ConfigFilePath<>'') then 3118 switches := switches + ' ' + PrepareCmdLineOption('@' + ConfigFilePath); 3119 3120 { ------------- Search Paths ---------------- } 3121 CurOutputDir:=''; 3122 if not (ccloNoMacroParams in Flags) then 3123 begin 3124 // include path 3125 CurIncludePath:=GetIncludePath(not (ccloAbsolutePaths in Flags), 3126 coptParsed,false); 3127 if (CurIncludePath <> '') then 3128 switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fi', CurIncludePath); 3129 3130 // library path 3131 if (not (ccloNoLinkerOpts in Flags)) then begin 3132 CurLibraryPath:=GetLibraryPath(not (ccloAbsolutePaths in Flags), 3133 coptParsed,false); 3134 if (CurLibraryPath <> '') then 3135 switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fl', CurLibraryPath); 3136 end; 3137 3138 // namespaces 3139 CurNamespaces:=GetNamespacesParsed(coptParsed); 3140 if CurNamespaces<>'' then 3141 switches := switches +' -FN'+CurNamespaces; 3142 3143 // object path 3144 CurObjectPath:=GetObjectPath(not (ccloAbsolutePaths in Flags), 3145 coptParsed,false); 3146 if (CurObjectPath <> '') then 3147 switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fo', CurObjectPath); 3148 3149 // unit path 3150 CurUnitPath:=GetUnitPath(not (ccloAbsolutePaths in Flags)); 3151 //debugln('TBaseCompilerOptions.MakeOptionsString A ',dbgsName(Self),' CurUnitPath="',CurUnitPath,'"'); 3152 switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fu', CurUnitPath); 3153 3154 { CompilerPath - Nothing needs to be done with this one } 3155 3156 { Unit output directory } 3157 if (UnitOutputDirectory<>'') then begin 3158 CurOutputDir:=ParsedOpts.GetParsedValue(pcosOutputDir); 3159 end; 3160 end; 3161 3162 // output options -o, -FU, and -FE 3163 // * -o to define the target file name. 3164 // * -FU if the unit output directory is not empty 3165 // * -FE if the target file name is not in the project directory (where the lpi file is) 3166 // * if neither -FU nor -FE is passed fpc creates the ppu in the source directories 3167 3168 CurMainSrcFile:=GetDefaultMainSourceFileName; 3169 CurTargetFilename:=''; 3170 CurTargetDirectory:=''; 3171 //DebugLn(['TBaseCompilerOptions.MakeOptionsString ',DbgSName(Self),' ',ccloDoNotAppendOutFileOption in Flags,' TargetFilename="',TargetFilename,'" CurMainSrcFile="',CurMainSrcFile,'" CurOutputDir="',CurOutputDir,'"']); 3172 if (not (ccloDoNotAppendOutFileOption in Flags)) 3173 and (not (ccloNoMacroParams in Flags)) 3174 and ((TargetFilename<>'') or (CurMainSrcFile<>'') or (CurOutputDir<>'')) then 3175 begin 3176 CurTargetFilename := CreateTargetFilename; 3177 if CurTargetFilename<>'' then 3178 begin 3179 CurTargetDirectory := ExtractFilePath(CurTargetFilename); 3180 if CurTargetDirectory<>'' then begin 3181 if (CurOutputDir='') // no -FU 3182 and (CompareFilenames(ChompPathDelim(CurTargetDirectory),ChompPathDelim(BaseDirectory))=0) 3183 then begin 3184 // if target file is in the base directory, do not use -FE switch 3185 // Without -FE and -FU switch the compiler puts .ppu files in the source 3186 // directories, which is Delphi compatible. 3187 // See bug http://bugs.freepascal.org/view.php?id=15535 3188 CurTargetDirectory:=''; 3189 end else if CompareFilenames(ChompPathDelim(CurOutputDir),ChompPathDelim(CurTargetDirectory))=0 then 3190 begin 3191 // -FU and -FE are the same: do not add -FU 3192 CurOutputDir:=''; 3193 end; 3194 end; 3195 end; 3196 end; 3197 3198 if CurOutputDir<>'' then begin 3199 if not (ccloAbsolutePaths in Flags) then 3200 CurOutputDir:=CreateRelativePath(CurOutputDir,BaseDirectory,true); 3201 switches := switches + ' '+PrepareCmdLineOption('-FU' + CurOutputDir); 3202 end; 3203 if CurTargetDirectory <> '' then begin 3204 if not (ccloAbsolutePaths in Flags) then 3205 CurTargetDirectory:=CreateRelativePath(CurTargetDirectory,BaseDirectory,true); 3206 switches := switches + ' '+PrepareCmdLineOption('-FE' + CurTargetDirectory); 3207 end; 3208 if (CurTargetFilename<>'') then begin 3209 if not (ccloAbsolutePaths in Flags) then 3210 CurTargetFilename := CreateRelativePath(CurTargetFilename, BaseDirectory); 3211 if CurTargetFilename<>'' then 3212 switches := switches + ' '+PrepareCmdLineOption('-o' + 3213 FixExeExtForEmbeddedCompiler(CurTargetFilename)); 3214 end; 3215 3216 // append custom options as last, so they can override 3217 if not (ccloNoMacroParams in Flags) then 3218 begin 3219 //debugln(['TBaseCompilerOptions.MakeOptionsString ',DbgSName(Self)]); 3220 //DumpStack; 3221 CurCustomOptions:=GetCustomOptions(coptParsed); 3222 if CurCustomOptions<>'' then 3223 switches := switches+' '+CurCustomOptions; 3224 end; 3225 3226 Result := switches; 3227end; 3228 3229function TBaseCompilerOptions.GetSyntaxOptionsString(Kind: TPascalCompiler 3230 ): string; 3231var 3232 tempsw: String; 3233begin 3234 if SyntaxMode<>'' then 3235 Result:='-M'+SyntaxMode // -M<x> Set language mode to <x> 3236 else 3237 Result:=''; 3238 3239 tempsw := ''; 3240 3241 if (CStyleOperators) then 3242 tempsw := tempsw + 'c'; 3243 if (IncludeAssertionCode) then 3244 tempsw := tempsw + 'a'; 3245 if Kind=pcFPC then begin 3246 if (AllowLabel) then 3247 tempsw := tempsw + 'g'; 3248 if (UseAnsiStrings) then 3249 tempsw := tempsw + 'h'; 3250 if (CPPInline) then 3251 tempsw := tempsw + 'i'; 3252 if (CStyleMacros) then 3253 tempsw := tempsw + 'm'; 3254 if (InitConstructor) then 3255 tempsw := tempsw + 's'; 3256 if (StaticKeyword) then 3257 tempsw := tempsw + 't'; 3258 end; 3259 3260 if (tempsw <> '') then begin 3261 if Result<>'' then 3262 Result:=Result+' '; 3263 Result := Result+'-S' + tempsw; 3264 end; 3265end; 3266 3267function TBaseCompilerOptions.CreatePPUFilename(const SourceFileName: string 3268 ): string; 3269var 3270 UnitOutDir: String; 3271begin 3272 Result:=SourceFileName; 3273 IDEMacros.SubstituteMacros(Result); 3274 if Result='' then exit; 3275 if FilenameIsAbsolute(Result) then begin 3276 // fully specified target filename 3277 end else if (UnitOutputDirectory='') 3278 and (ParsedOpts.OutputDirectoryOverride='') 3279 and (ExtractFilePath(TargetFilename)='') then begin 3280 // the unit is put into the same directory as its source 3281 Result:=CreateAbsolutePath(Result,BaseDirectory); 3282 end else begin 3283 // the unit is put into the output directory 3284 UnitOutDir:=GetUnitOutPath(false); 3285 if UnitOutDir='' then 3286 UnitOutDir:=BaseDirectory; 3287 Result:=AppendPathDelim(UnitOutDir)+ExtractFileName(Result); 3288 end; 3289 Result:=ChangeFileExt(Result,'.ppu'); 3290end; 3291 3292{------------------------------------------------------------------------------ 3293 TBaseCompilerOptions Clear 3294------------------------------------------------------------------------------} 3295procedure TBaseCompilerOptions.Clear; 3296begin 3297 // search paths 3298 IncludePath := ''; 3299 Libraries := ''; 3300 OtherUnitFiles := ''; 3301 UnitOutputDirectory := ''; 3302 ObjectPath:=''; 3303 SrcPath:=''; 3304 DebugPath:=''; 3305 3306 // parsing 3307 FSyntaxMode:='ObjFPC'; 3308 fAssemblerStyle := 0; 3309 fCStyleOp := true; 3310 fIncludeAssertionCode := false; 3311 fAllowLabel := true; 3312 fCPPInline := true; 3313 fCMacros := false; 3314 fInitConst := false; 3315 fStaticKeyword := false; 3316 fUseAnsiStr := true; 3317 3318 // code generation 3319 fSmartLinkUnit := false; 3320 fIOChecks := false; 3321 fRangeChecks := false; 3322 fOverflowChecks := false; 3323 fStackChecks := false; 3324 fHeapSize := 0; 3325 fStackSize := 0; 3326 fVerifyObjMethodCall := false; 3327 fTargetOS := ''; 3328 fTargetCPU := ''; 3329 fTargetProc := ''; 3330 fOptLevel := 1; 3331 fVarsInReg := false; 3332 fUncertainOpt := false; 3333 FSmallerCode := false; 3334 3335 // linking 3336 fGenDebugInfo := True; 3337 fDebugInfoType := dsAuto; 3338 fUseLineInfoUnit := true; 3339 fUseHeaptrc := false; 3340 fTrashVariables := false; 3341 fUseValgrind := false; 3342 fGenGProfCode := false; 3343 fStripSymbols := false; 3344 fLinkSmart := false; 3345 fPassLinkerOpt := false; 3346 LinkerOptions := ''; 3347 Win32GraphicApp := false; 3348 ExecutableType := cetProgram; 3349 3350 // messages 3351 fShowWarn := true; 3352 fShowNotes := true; 3353 fShowHints := true; 3354 fShowLineNum := false; 3355 fShowAll := false; 3356 fShowDebugInfo := false; 3357 fShowUsedFiles := false; 3358 fShowTriedFiles := false; 3359 fShowCompProc := false; 3360 fShowCond := false; 3361 fShowExecInfo := false; 3362 fShowHintsForUnusedUnitsInMainSrc := false; 3363 fShowHintsForSenderNotUsed := false; 3364 fWriteFPCLogo := true; 3365 fStopAfterErrCount := 1; 3366 fMessageFlags.Clear; 3367 3368 // other 3369 fDontUseConfigFile := false; 3370 fCustomConfigFile := false; 3371 fConfigFilePath := 'extrafpc.cfg'; 3372 CustomOptions := ''; 3373 3374 // inherited 3375 ClearInheritedOptions; 3376 3377 // compilation 3378 CompilerPath := DefaultCompilerPath; 3379 fExecuteBefore.Clear; 3380 fExecuteAfter.Clear; 3381 3382 Modified := false; 3383end; 3384 3385procedure TBaseCompilerOptions.Assign(Source: TPersistent); 3386var 3387 CompOpts: TBaseCompilerOptions; 3388begin 3389 if not (Source is TBaseCompilerOptions) then begin 3390 inherited Assign(Source); 3391 exit; 3392 end; 3393 CompOpts:=TBaseCompilerOptions(Source); 3394 3395 // Target 3396 TargetFilename := CompOpts.TargetFilename; 3397 TargetFilenameApplyConventions := CompOpts.TargetFilenameApplyConventions; 3398 3399 // Search Paths 3400 StorePathDelim := CompOpts.StorePathDelim; 3401 IncludePath := CompOpts.IncludePath; 3402 Libraries := CompOpts.Libraries; 3403 OtherUnitFiles := CompOpts.OtherUnitFiles; 3404 UnitOutputDirectory := CompOpts.UnitOutputDirectory; 3405 ObjectPath := CompOpts.ObjectPath; 3406 SrcPath := CompOpts.SrcPath; 3407 DebugPath := CompOpts.DebugPath; 3408 3409 // conditionals 3410 Conditionals:=CompOpts.Conditionals; 3411 TIDEBuildMacros(BuildMacros).Assign(CompOpts.BuildMacros); 3412 3413 // Parsing 3414 FSyntaxMode := CompOpts.FSyntaxMode; 3415 fAssemblerStyle := CompOpts.fAssemblerStyle; 3416 fCStyleOp := CompOpts.fCStyleOp; 3417 fIncludeAssertionCode := CompOpts.fIncludeAssertionCode; 3418 fAllowLabel := CompOpts.fAllowLabel; 3419 fCPPInline := CompOpts.fCPPInline; 3420 fCMacros := CompOpts.fCMacros; 3421 fInitConst := CompOpts.fInitConst; 3422 fStaticKeyword := CompOpts.fStaticKeyword; 3423 fUseAnsiStr := CompOpts.fUseAnsiStr; 3424 3425 // Code Generation 3426 fSmartLinkUnit := CompOpts.SmartLinkUnit; 3427 fRelocatableUnit := CompOpts.RelocatableUnit; 3428 fIOChecks := CompOpts.fIOChecks; 3429 fRangeChecks := CompOpts.fRangeChecks; 3430 fOverflowChecks := CompOpts.fOverflowChecks; 3431 fStackChecks := CompOpts.fStackChecks; 3432 FEmulatedFloatOpcodes := CompOpts.fEmulatedFloatOpcodes; 3433 fHeapSize := CompOpts.fHeapSize; 3434 fStackSize := CompOpts.fStackSize; 3435 fVerifyObjMethodCall := CompOpts.VerifyObjMethodCall; 3436 fEmulatedFloatOpcodes := CompOpts.fEmulatedFloatOpcodes; 3437 fTargetOS := CompOpts.fTargetOS; 3438 fTargetCPU := CompOpts.fTargetCPU; 3439 fTargetProc := CompOpts.fTargetProc; 3440 fOptLevel := CompOpts.fOptLevel; 3441 fVarsInReg := CompOpts.fVarsInReg; 3442 fUncertainOpt := CompOpts.fUncertainOpt; 3443 FSmallerCode := CompOpts.FSmallerCode; 3444 3445 // Linking 3446 fGenDebugInfo := CompOpts.fGenDebugInfo; 3447 FDebugInfoType := CompOpts.FDebugInfoType; 3448 fUseLineInfoUnit := CompOpts.fUseLineInfoUnit; 3449 fUseHeaptrc := CompOpts.fUseHeaptrc; 3450 fTrashVariables := CompOpts.fTrashVariables; 3451 fUseValgrind := CompOpts.fUseValgrind; 3452 fGenGProfCode := CompOpts.fGenGProfCode; 3453 fStripSymbols := CompOpts.fStripSymbols; 3454 fLinkSmart := CompOpts.fLinkSmart; 3455 fPassLinkerOpt := CompOpts.fPassLinkerOpt; 3456 LinkerOptions := CompOpts.fLinkerOptions; 3457 Win32GraphicApp := CompOpts.Win32GraphicApp; 3458 ExecutableType := CompOpts.ExecutableType; 3459 UseExternalDbgSyms := CompOpts.UseExternalDbgSyms; 3460 3461 // Verbosity 3462 fShowWarn := CompOpts.fShowWarn; 3463 fShowNotes := CompOpts.fShowNotes; 3464 fShowHints := CompOpts.fShowHints; 3465 fShowLineNum := CompOpts.fShowLineNum; 3466 fShowAll := CompOpts.fShowAll; 3467 fShowDebugInfo := CompOpts.fShowDebugInfo; 3468 fShowUsedFiles := CompOpts.fShowUsedFiles; 3469 fShowTriedFiles := CompOpts.fShowTriedFiles; 3470 fShowCompProc := CompOpts.fShowCompProc; 3471 fShowCond := CompOpts.fShowCond; 3472 fShowExecInfo := CompOpts.fShowExecInfo; 3473 fShowHintsForUnusedUnitsInMainSrc := CompOpts.fShowHintsForUnusedUnitsInMainSrc; 3474 fShowHintsForSenderNotUsed := CompOpts.fShowHintsForSenderNotUsed; 3475 fWriteFPCLogo := CompOpts.fWriteFPCLogo; 3476 3477 // Messages 3478 fMessageFlags.Assign(CompOpts.fMessageFlags); 3479 3480 // Other 3481 fDontUseConfigFile := CompOpts.fDontUseConfigFile; 3482 fCustomConfigFile := CompOpts.fCustomConfigFile; 3483 fConfigFilePath := CompOpts.fConfigFilePath; 3484 fStopAfterErrCount := CompOpts.fStopAfterErrCount; 3485 CustomOptions := CompOpts.CustomOptions; 3486 3487 // Inherited and parser options 3488 FDefaultMakeOptionsFlags := CompOpts.FDefaultMakeOptionsFlags; 3489 ClearInheritedOptions; 3490 ParsedOpts.Assign(CompOpts.ParsedOpts); 3491 FStorePathDelim := CompOpts.FStorePathDelim; 3492 FOtherDefines.Assign(CompOpts.FOtherDefines); 3493 3494 // compilation 3495 CompilerPath := CompOpts.CompilerPath; 3496 ExecuteBefore.Assign(CompOpts.ExecuteBefore); 3497 ExecuteAfter.Assign(CompOpts.ExecuteAfter); 3498 CreateMakefileOnBuild:=CompOpts.CreateMakefileOnBuild; 3499end; 3500 3501function TBaseCompilerOptions.IsEqual(CompOpts: TBaseCompilerOptions): boolean; 3502begin 3503 Result:= not CreateDiff(CompOpts,nil); 3504end; 3505 3506procedure TBaseCompilerOptions.CreateDiffAsText(CompOpts: TBaseCompilerOptions; 3507 Diff: TStrings); 3508var 3509 Tool: TCompilerDiffTool; 3510begin 3511 Tool:=TCompilerDiffTool.Create(Diff); 3512 CreateDiff(CompOpts,Tool); 3513 Tool.Free; 3514end; 3515 3516function TBaseCompilerOptions.CreateDiff(CompOpts: TBaseCompilerOptions; 3517 Tool: TCompilerDiffTool): boolean; 3518 3519 function Done(Diff: boolean): boolean; 3520 begin 3521 if Diff then CreateDiff:=true; 3522 Result:=(Tool=nil) and Diff; 3523 end; 3524 3525 function AddDiff(const PropertyName: string; 3526 const Old, New: TCompilationExecutableType): boolean; 3527 begin 3528 if Old=New then exit(false); 3529 Result:=true; 3530 Tool.AddDiffItem(PropertyName,CompilationExecutableTypeNames[New]); 3531 end; 3532 3533begin 3534 Result:=false; 3535 //if Tool<>nil then debugln(['TBaseCompilerOptions.CreateDiff ',DbgSName(Self)]); 3536 if Done(Tool.AddPathsDiff('StorePathDelim',PathDelimSwitchToDelim[FStorePathDelim], 3537 PathDelimSwitchToDelim[CompOpts.FStorePathDelim])) then exit; 3538 3539 // target 3540 if Done(Tool.AddDiff('TargetFileExt',fTargetFileExt,CompOpts.fTargetFileExt)) then exit; 3541 if Done(Tool.AddDiff('TargetFilename',fTargetFilename,CompOpts.fTargetFilename)) then exit; 3542 if Done(Tool.AddDiff('TargetFilenameAppplyConventions',FTargetFilenameAppplyConventions,CompOpts.FTargetFilenameAppplyConventions)) then exit; 3543 3544 // search paths 3545 if Tool<>nil then Tool.Path:='Paths'; 3546 if Done(Tool.AddPathsDiff('IncludePaths',IncludePath,CompOpts.IncludePath)) then exit; 3547 if Done(Tool.AddPathsDiff('LibraryPaths',Libraries,CompOpts.Libraries)) then exit; 3548 if Done(Tool.AddPathsDiff('Namespaces',Namespaces,CompOpts.Namespaces)) then exit; 3549 if Done(Tool.AddPathsDiff('UnitPaths',OtherUnitFiles,CompOpts.OtherUnitFiles)) then exit; 3550 if Done(Tool.AddPathsDiff('UnitOutputDir',UnitOutputDirectory,CompOpts.UnitOutputDirectory)) then exit; 3551 if Done(Tool.AddPathsDiff('ObjectPath',ObjectPath,CompOpts.ObjectPath)) then exit; 3552 if Done(Tool.AddPathsDiff('SrcPath',SrcPath,CompOpts.SrcPath)) then exit; 3553 if Done(Tool.AddPathsDiff('DebugPath',DebugPath,CompOpts.DebugPath)) then exit; 3554 3555 // conditionals 3556 if Done(Tool.AddPathsDiff('Conditionals',FConditionals,CompOpts.FConditionals)) then exit; 3557 if Tool<>nil then Tool.Path:='BuildModes'; 3558 if Done(TIDEBuildMacros(fBuildMacros).CreateDiff(CompOpts.BuildMacros,Tool)) then exit; 3559 3560 // parsing 3561 if Tool<>nil then Tool.Path:='Parsing'; 3562 if Done(Tool.AddDiff('SyntaxMode',FSyntaxMode,CompOpts.FSyntaxMode)) then exit; 3563 if Done(Tool.AddDiff('AssemblerStyle',fAssemblerStyle,CompOpts.fAssemblerStyle)) then exit; 3564 if Done(Tool.AddDiff('CStyleOp',fCStyleOp,CompOpts.fCStyleOp)) then exit; 3565 if Done(Tool.AddDiff('IncludeAssertionCode',fIncludeAssertionCode,CompOpts.fIncludeAssertionCode)) then exit; 3566 if Done(Tool.AddDiff('AllowLabel',fAllowLabel,CompOpts.fAllowLabel)) then exit; 3567 if Done(Tool.AddDiff('CPPInline',fCPPInline,CompOpts.fCPPInline)) then exit; 3568 if Done(Tool.AddDiff('CMacros',fCMacros,CompOpts.fCMacros)) then exit; 3569 if Done(Tool.AddDiff('InitConst',fInitConst,CompOpts.fInitConst)) then exit; 3570 if Done(Tool.AddDiff('StaticKeyword',fStaticKeyword,CompOpts.fStaticKeyword)) then exit; 3571 if Done(Tool.AddDiff('UseAnsiStr',fUseAnsiStr,CompOpts.fUseAnsiStr)) then exit; 3572 3573 // code generation 3574 if Tool<>nil then Tool.Path:='Code'; 3575 if Done(Tool.AddDiff('SmartLinkUnit',fSmartLinkUnit,CompOpts.SmartLinkUnit)) then exit; 3576 if Done(Tool.AddDiff('Relocatable',fRelocatableUnit,CompOpts.RelocatableUnit)) then exit; 3577 if Done(Tool.AddDiff('IOChecks',fIOChecks,CompOpts.fIOChecks)) then exit; 3578 if Done(Tool.AddDiff('RangeChecks',fRangeChecks,CompOpts.fRangeChecks)) then exit; 3579 if Done(Tool.AddDiff('OverflowChecks',fOverflowChecks,CompOpts.fOverflowChecks)) then exit; 3580 if Done(Tool.AddDiff('StackChecks',fStackChecks,CompOpts.fStackChecks)) then exit; 3581 if Done(Tool.AddDiff('EmulatedFloatOpcodes',FEmulatedFloatOpcodes,CompOpts.FEmulatedFloatOpcodes)) then exit; 3582 if Done(Tool.AddDiff('HeapSize',fHeapSize,CompOpts.fHeapSize)) then exit; 3583 if Done(Tool.AddDiff('StackSize',fStackSize,CompOpts.fStackSize)) then exit; 3584 if Done(Tool.AddDiff('VerifyObjMethodCall',fVerifyObjMethodCall,CompOpts.fVerifyObjMethodCall)) then exit; 3585 if Done(Tool.AddDiff('EmulatedFloatOpcodes',fEmulatedFloatOpcodes,CompOpts.fEmulatedFloatOpcodes)) then exit; 3586 if Done(Tool.AddDiff('TargetOS',fTargetOS,CompOpts.fTargetOS)) then exit; 3587 if Done(Tool.AddDiff('TargetCPU',fTargetCPU,CompOpts.fTargetCPU)) then exit; 3588 if Done(Tool.AddDiff('TargetProc',fTargetProc,CompOpts.fTargetProc)) then exit; 3589 if Done(Tool.AddDiff('OptLevel',fOptLevel,CompOpts.fOptLevel)) then exit; 3590 if Done(Tool.AddDiff('VarsInReg',fVarsInReg,CompOpts.fVarsInReg)) then exit; 3591 if Done(Tool.AddDiff('UncertainOpt',fUncertainOpt,CompOpts.fUncertainOpt)) then exit; 3592 if Done(Tool.AddDiff('SmallerCode',FSmallerCode,CompOpts.FSmallerCode)) then exit; 3593 3594 // linking 3595 if Tool<>nil then Tool.Path:='Linking'; 3596 if Done(Tool.AddDiff('GenDebugInfo',fGenDebugInfo,CompOpts.fGenDebugInfo)) then exit; 3597 if Done(Tool.AddDiff('DebugInfoType',DebugInfoTypeStr,CompOpts.DebugInfoTypeStr)) then exit; 3598 if Done(Tool.AddDiff('UseLineInfoUnit',fUseLineInfoUnit,CompOpts.fUseLineInfoUnit)) then exit; 3599 if Done(Tool.AddDiff('UseHeaptrc',fUseHeaptrc,CompOpts.fUseHeaptrc)) then exit; 3600 if Done(Tool.AddDiff('TrashVariables',fTrashVariables,CompOpts.fTrashVariables)) then exit; 3601 if Done(Tool.AddDiff('UseValgrind',fUseValgrind,CompOpts.fUseValgrind)) then exit; 3602 if Done(Tool.AddDiff('GenGProfCode',fGenGProfCode,CompOpts.fGenGProfCode)) then exit; 3603 if Done(Tool.AddDiff('StripSymbols',fStripSymbols,CompOpts.fStripSymbols)) then exit; 3604 if Done(Tool.AddDiff('LinkSmart',fLinkSmart,CompOpts.fLinkSmart)) then exit; 3605 if Done(Tool.AddDiff('PassLinkerOpt',fPassLinkerOpt,CompOpts.fPassLinkerOpt)) then exit; 3606 if Done(Tool.AddDiff('LinkerOptions',fLinkerOptions,CompOpts.fLinkerOptions)) then exit; 3607 if Done(Tool.AddDiff('Win32GraphicApp',FWin32GraphicApp,CompOpts.FWin32GraphicApp)) then exit; 3608 if Done(AddDiff('ExecutableType',FExecutableType,CompOpts.FExecutableType)) then exit; 3609 3610 // verbosity 3611 if Tool<>nil then Tool.Path:='Verbosity'; 3612 if Done(Tool.AddDiff('ShowWarn',fShowWarn,CompOpts.fShowWarn)) then exit; 3613 if Done(Tool.AddDiff('ShowNotes',fShowNotes,CompOpts.fShowNotes)) then exit; 3614 if Done(Tool.AddDiff('ShowHints',fShowHints,CompOpts.fShowHints)) then exit; 3615 if Done(Tool.AddDiff('ShowLineNum',fShowLineNum,CompOpts.fShowLineNum)) then exit; 3616 if Done(Tool.AddDiff('ShowAll',fShowAll,CompOpts.fShowAll)) then exit; 3617 if Done(Tool.AddDiff('ShowDebugInfo',fShowDebugInfo,CompOpts.fShowDebugInfo)) then exit; 3618 if Done(Tool.AddDiff('ShowUsedFiles',fShowUsedFiles,CompOpts.fShowUsedFiles)) then exit; 3619 if Done(Tool.AddDiff('ShowTriedFiles',fShowTriedFiles,CompOpts.fShowTriedFiles)) then exit; 3620 if Done(Tool.AddDiff('ShowCompProc',fShowCompProc,CompOpts.fShowCompProc)) then exit; 3621 if Done(Tool.AddDiff('ShowCond',fShowCond,CompOpts.fShowCond)) then exit; 3622 if Done(Tool.AddDiff('ShowExecInfo',fShowExecInfo,CompOpts.fShowExecInfo)) then exit; 3623 if Done(Tool.AddDiff('ShowHintsForUnusedUnitsInMainSrc',fShowHintsForUnusedUnitsInMainSrc,CompOpts.fShowHintsForUnusedUnitsInMainSrc)) then exit; 3624 if Done(Tool.AddDiff('ShowHintsForSenderNotUsed',fShowHintsForSenderNotUsed,CompOpts.fShowHintsForSenderNotUsed)) then exit; 3625 if Done(Tool.AddDiff('WriteFPCLogo',fWriteFPCLogo,CompOpts.fWriteFPCLogo)) then exit; 3626 3627 // messages 3628 if Tool<>nil then Tool.Path:='Messages'; 3629 if Done(IDEMessageFlags.CreateDiff(Tool,CompOpts.IDEMessageFlags)) then exit; 3630 3631 // other 3632 if Tool<>nil then Tool.Path:='Other'; 3633 if Done(Tool.AddDiff('DontUseConfigFile',fDontUseConfigFile,CompOpts.fDontUseConfigFile)) then exit; 3634 if Done(Tool.AddDiff('CustomConfigFile',fCustomConfigFile,CompOpts.fCustomConfigFile)) then exit; 3635 if Done(Tool.AddDiff('ConfigFilePath',fConfigFilePath,CompOpts.fConfigFilePath)) then exit; 3636 if Done(Tool.AddDiff('StopAfterErrCount',fStopAfterErrCount,CompOpts.fStopAfterErrCount)) then exit; 3637 if Done(Tool.AddDiff('CustomOptions',CustomOptions,CompOpts.CustomOptions)) then exit; 3638 if Done(Tool.AddDiff('OtherDefines',OtherDefines.Text,CompOpts.OtherDefines.Text)) then exit; 3639 3640 // compilation 3641 if Tool<>nil then Tool.Path:='Compilation'; 3642 if Done(Tool.AddDiff('CompilerPath',CompilerPath,CompOpts.CompilerPath)) then exit; 3643 if Done(ExecuteBefore.CreateDiff(CompOpts.ExecuteBefore,Tool)) then exit; 3644 if Done(ExecuteAfter.CreateDiff(CompOpts.ExecuteAfter,Tool)) then exit; 3645 if Done(Tool.AddDiff('CreateMakefileOnBuild',fCreateMakefileOnBuild,CompOpts.fCreateMakefileOnBuild)) then exit; 3646 if Result then debugln(['TBaseCompilerOptions.CreateDiff END']); 3647end; 3648 3649procedure TBaseCompilerOptions.SetAlternativeCompile(const Command: string; 3650 ScanFPCMsgs: boolean); 3651begin 3652 CompilerPath:=''; 3653 ExecuteBefore.Command:=Command; 3654 if ScanFPCMsgs then 3655 ExecuteBefore.Parsers.Text:=SubToolFPC+LineEnding+SubToolMake 3656 else 3657 ExecuteBefore.Parsers.Clear; 3658end; 3659 3660 3661{ TAdditionalCompilerOptions } 3662 3663procedure TAdditionalCompilerOptions.SetCustomOptions(const AValue: string); 3664begin 3665 ParsedOpts.SetUnparsedValue(pcosCustomOptions,AValue); 3666end; 3667 3668procedure TAdditionalCompilerOptions.SetSrcPath(const AValue: string); 3669begin 3670 ParsedOpts.SetUnparsedValue(pcosSrcPath,AValue); 3671end; 3672 3673function TAdditionalCompilerOptions.GetUnitPath: string; 3674begin 3675 Result:=FParsedOpts.Values[pcosUnitPath].UnparsedValue; 3676end; 3677 3678function TAdditionalCompilerOptions.GetIncludePath: string; 3679begin 3680 Result:=FParsedOpts.Values[pcosIncludePath].UnparsedValue; 3681end; 3682 3683function TAdditionalCompilerOptions.GetBaseDirectory: string; 3684begin 3685 Result:=FParsedOpts.Values[pcosBaseDir].UnparsedValue; 3686end; 3687 3688function TAdditionalCompilerOptions.GetCustomOptions: string; 3689begin 3690 Result:=FParsedOpts.Values[pcosCustomOptions].UnparsedValue; 3691end; 3692 3693function TAdditionalCompilerOptions.GetLibraryPath: string; 3694begin 3695 Result:=FParsedOpts.Values[pcosLibraryPath].UnparsedValue; 3696end; 3697 3698function TAdditionalCompilerOptions.GetLinkerOptions: string; 3699begin 3700 Result:=FParsedOpts.Values[pcosLinkerOptions].UnparsedValue; 3701end; 3702 3703function TAdditionalCompilerOptions.GetNamespaces: string; 3704begin 3705 Result:=FParsedOpts.Values[pcosNamespaces].UnparsedValue; 3706end; 3707 3708function TAdditionalCompilerOptions.GetObjectPath: string; 3709begin 3710 Result:=FParsedOpts.Values[pcosObjectPath].UnparsedValue; 3711end; 3712 3713function TAdditionalCompilerOptions.GetSrcPath: string; 3714begin 3715 Result:=FParsedOpts.Values[pcosSrcPath].UnparsedValue; 3716end; 3717 3718procedure TAdditionalCompilerOptions.SetBaseDirectory(const AValue: string); 3719begin 3720 ParsedOpts.SetUnparsedValue(pcosBaseDir,AValue); 3721end; 3722 3723procedure TAdditionalCompilerOptions.SetIncludePath(const AValue: string); 3724begin 3725 ParsedOpts.SetUnparsedValue(pcosIncludePath,AValue); 3726end; 3727 3728procedure TAdditionalCompilerOptions.SetLibraryPath(const AValue: string); 3729begin 3730 ParsedOpts.SetUnparsedValue(pcosLibraryPath,AValue); 3731end; 3732 3733procedure TAdditionalCompilerOptions.SetLinkerOptions(const AValue: string); 3734begin 3735 ParsedOpts.SetUnparsedValue(pcosLinkerOptions,AValue); 3736end; 3737 3738procedure TAdditionalCompilerOptions.SetNamespaces(const AValue: string); 3739begin 3740 ParsedOpts.SetUnparsedValue(pcosNamespaces,AValue); 3741end; 3742 3743procedure TAdditionalCompilerOptions.SetObjectPath(const AValue: string); 3744begin 3745 ParsedOpts.SetUnparsedValue(pcosObjectPath,AValue); 3746end; 3747 3748procedure TAdditionalCompilerOptions.SetUnitPath(const AValue: string); 3749begin 3750 ParsedOpts.SetUnparsedValue(pcosUnitPath,AValue); 3751end; 3752 3753constructor TAdditionalCompilerOptions.Create(TheOwner: TObject); 3754begin 3755 fOwner:=TheOwner; 3756 FParsedOpts:=TParsedCompilerOptions.Create(Self); 3757 Clear; 3758end; 3759 3760destructor TAdditionalCompilerOptions.Destroy; 3761begin 3762 FreeThenNil(FParsedOpts); 3763 inherited Destroy; 3764end; 3765 3766procedure TAdditionalCompilerOptions.Clear; 3767begin 3768 UnitPath:=''; 3769 Namespaces:=''; 3770 SrcPath:=''; 3771 IncludePath:=''; 3772 CustomOptions:=''; 3773 LibraryPath:=''; 3774 LinkerOptions:=''; 3775 ObjectPath:=''; 3776end; 3777 3778procedure TAdditionalCompilerOptions.AssignOptions(Source: TObject); 3779var 3780 Src: TAdditionalCompilerOptions; 3781begin 3782 if not (Source is TAdditionalCompilerOptions) then 3783 raise Exception.Create('TAdditionalCompilerOptions.AssignOptions: Can not copy from '+DbgSName(Source)); 3784 Src:=TAdditionalCompilerOptions(Source); 3785 UnitPath:=Src.UnitPath; 3786 Namespaces:=Src.Namespaces; 3787 IncludePath:=Src.IncludePath; 3788 SrcPath:=Src.SrcPath; 3789 ObjectPath:=Src.ObjectPath; 3790 LibraryPath:=Src.LibraryPath; 3791 LinkerOptions:=Src.LinkerOptions; 3792 CustomOptions:=Src.CustomOptions; 3793 BaseDirectory:=Src.BaseDirectory; 3794end; 3795 3796procedure TAdditionalCompilerOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig; 3797 const Path: string; AdjustPathDelims: boolean); 3798 3799 function f(const Filename: string): string; 3800 begin 3801 Result:=SwitchPathDelims(Filename,AdjustPathDelims); 3802 end; 3803 3804begin 3805 Clear; 3806 CustomOptions:=f(XMLConfig.GetValue(Path+'CustomOptions/Value','')); 3807 IncludePath:=f(XMLConfig.GetValue(Path+'IncludePath/Value','')); 3808 LibraryPath:=f(XMLConfig.GetValue(Path+'LibraryPath/Value','')); 3809 LinkerOptions:=f(XMLConfig.GetValue(Path+'LinkerOptions/Value','')); 3810 Namespaces:=f(XMLConfig.GetValue(Path+'Namespaces/Value','')); 3811 ObjectPath:=f(XMLConfig.GetValue(Path+'ObjectPath/Value','')); 3812 UnitPath:=f(XMLConfig.GetValue(Path+'UnitPath/Value','')); 3813 SrcPath:=f(XMLConfig.GetValue(Path+'SrcPath/Value','')); 3814end; 3815 3816procedure TAdditionalCompilerOptions.SaveToXMLConfig(XMLConfig: TXMLConfig; 3817 const Path: string; UsePathDelim: TPathDelimSwitch); 3818 3819 function f(const AFilename: string): string; 3820 begin 3821 Result:=SwitchPathDelims(AFilename,UsePathDelim); 3822 end; 3823 3824begin 3825 XMLConfig.SetDeleteValue(Path+'CustomOptions/Value',f(CustomOptions),''); 3826 XMLConfig.SetDeleteValue(Path+'IncludePath/Value',f(IncludePath),''); 3827 XMLConfig.SetDeleteValue(Path+'LibraryPath/Value',f(LibraryPath),''); 3828 XMLConfig.SetDeleteValue(Path+'LinkerOptions/Value',f(LinkerOptions),''); 3829 XMLConfig.SetDeleteValue(Path+'Namespaces/Value',Namespaces,''); 3830 XMLConfig.SetDeleteValue(Path+'ObjectPath/Value',f(ObjectPath),''); 3831 XMLConfig.SetDeleteValue(Path+'UnitPath/Value',f(UnitPath),''); 3832 XMLConfig.SetDeleteValue(Path+'SrcPath/Value',f(SrcPath),''); 3833end; 3834 3835function TAdditionalCompilerOptions.GetOwnerName: string; 3836begin 3837 if fOwner<>nil then 3838 Result:=fOwner.Classname 3839 else 3840 Result:='Has no owner'; 3841end; 3842 3843function TAdditionalCompilerOptions.GetOption(AnOption: TInheritedCompilerOption 3844 ): string; 3845begin 3846 Result:=''; 3847 case AnOption of 3848 icoNone: Result:=''; 3849 icoUnitPath: Result:=UnitPath; 3850 icoNamespaces: Result:=Namespaces; 3851 icoIncludePath: Result:=IncludePath; 3852 icoObjectPath: Result:=ObjectPath; 3853 icoLibraryPath: Result:=LibraryPath; 3854 icoSrcPath: Result:=SrcPath; 3855 icoLinkerOptions: Result:=LinkerOptions; 3856 icoCustomOptions: Result:=CustomOptions; 3857 else 3858 RaiseGDBException(''); // inconsistency detected 3859 end; 3860end; 3861 3862function TAdditionalCompilerOptions.GetBaseCompilerOptions: TBaseCompilerOptions; 3863begin 3864 Result:=nil; 3865end; 3866 3867{ TParsedCompilerOptions } 3868 3869procedure TParsedCompilerOptions.SetOutputDirectoryOverride(const AValue: string); 3870begin 3871 if FOutputDirectoryOverride=AValue then exit; 3872 FOutputDirectoryOverride:=AValue; 3873 if InvalidateParseOnChange then 3874 IncreaseCompilerParseStamp;// the output dir is used by other packages 3875 if FOutputDirectoryOverride<>'' then 3876 DebugLn(['TParsedCompilerOptions.SetOutputDirectoryOverride New=',FOutputDirectoryOverride]) 3877 else 3878 DebugLn(['TParsedCompilerOptions.SetOutputDirectoryOverride using default']); 3879end; 3880 3881constructor TParsedCompilerOptions.Create(TheOwner: TObject); 3882begin 3883 FOwner:=TheOwner; 3884 InheritedMacroValues:=TCTCfgScriptVariables.Create; 3885 MacroValues:=TIDECfgScriptEngine.Create; 3886 Clear; 3887end; 3888 3889destructor TParsedCompilerOptions.Destroy; 3890begin 3891 FreeAndNil(InheritedMacroValues); 3892 FreeAndNil(MacroValues); 3893 inherited Destroy; 3894end; 3895 3896function TParsedCompilerOptions.HasParsedError: boolean; 3897begin 3898 Result:=(ParsedErrorStamp<>CTInvalidChangeStamp) 3899 and (ParsedErrorStamp=CompilerParseStamp); 3900end; 3901 3902procedure TParsedCompilerOptions.ParsedError(Option: TParsedCompilerOptString; 3903 Msg: string); 3904begin 3905 if HasParsedError then exit; 3906 ParsedErrorMsg:=Msg; 3907 ParsedErrorOption:=Option; 3908 ParsedErrorStamp:=CompilerParseStamp; 3909end; 3910 3911function TParsedCompilerOptions.GetUnparsedWithConditionals( 3912 Option: TParsedCompilerOptString): string; 3913var 3914 Opts: TBaseCompilerOptions; 3915 VarName: String; 3916 Vars: TCTCfgScriptVariables; 3917 MoreOptions: String; 3918begin 3919 Result:=Values[Option].UnparsedValue; 3920 Opts:=nil; 3921 VarName:=''; 3922 if (Owner is TBaseCompilerOptions) then 3923 begin 3924 Opts:=TBaseCompilerOptions(Owner); 3925 VarName:=ParsedCompilerOptsVars[Option]; 3926 end else if (Owner is TAdditionalCompilerOptions) then 3927 begin 3928 Opts:=TAdditionalCompilerOptions(Owner).GetBaseCompilerOptions; 3929 VarName:=ParsedCompilerOptsUsageVars[Option]; 3930 end; 3931 if (VarName='') or (Opts=nil) then exit; 3932 Vars:=GetBuildMacroValues(Opts,true); 3933 if Vars=nil then exit; 3934 case Option of 3935 pcosUnitPath,pcosIncludePath,pcosObjectPath,pcosLibraryPath,pcosSrcPath, 3936 pcosDebugPath: 3937 Result:=MergeSearchPaths(Result,GetForcedPathDelims(Vars[VarName])); 3938 pcosLinkerOptions: 3939 Result:=MergeLinkerOptions(Result,Vars[VarName]); 3940 pcosNamespaces: 3941 Result:=MergeWithDelimiter(Result,Vars[VarName],';'); 3942 pcosCustomOptions: 3943 begin 3944 Result:=MergeCustomOptions(Result,Vars[VarName]); 3945 // add project/global overrides 3946 if (Owner is TBaseCompilerOptions) and Assigned(OnAppendCustomOption) then 3947 begin 3948 MoreOptions:=''; 3949 OnAppendCustomOption(Opts,MoreOptions,bmgtAll); 3950 if Assigned(OnLocalSubstitute) then 3951 MoreOptions:=OnLocalSubstitute(MoreOptions,false); 3952 MoreOptions:=SpecialCharsToSpaces(MoreOptions,true); 3953 Result:=MergeCustomOptions(Result,MoreOptions); 3954 end; 3955 end; 3956 pcosOutputDir,pcosCompilerPath: 3957 if Vars.IsDefined(PChar(VarName)) then 3958 Result:=GetForcedPathDelims(Vars[VarName]); 3959 end 3960end; 3961 3962function TParsedCompilerOptions.GetParsedValue(Option: TParsedCompilerOptString; 3963 WithOverrides: boolean): string; 3964var 3965 s: String; 3966begin 3967 if WithOverrides then begin 3968 if (Option=pcosOutputDir) and (OutputDirectoryOverride<>'') then begin 3969 Result:=OutputDirectoryOverride; 3970 exit; 3971 end; 3972 end; 3973 if Values[Option].ParseStamp<>CompilerParseStamp then begin 3974 if Values[Option].Parsing then begin 3975 DebugLn('TParsedCompilerOptions.GetParsedValue Circle in Options: ',EnumToStr(Option),' Unparsed="',Values[Option].UnparsedValue,'"'); 3976 ParsedError(Option, lisEndlessLoopInMacros); 3977 exit(''); 3978 end; 3979 Values[Option].Parsing:=true; 3980 try 3981 s:=DoParseOption(GetUnparsedWithConditionals(Option),Option,false); 3982 Values[Option].ParsedValue:=s; 3983 Values[Option].ParseStamp:=CompilerParseStamp; 3984 finally 3985 Values[Option].Parsing:=false; 3986 end; 3987 end; 3988 Result:=Values[Option].ParsedValue; 3989end; 3990 3991function TParsedCompilerOptions.GetParsedPIValue( 3992 Option: TParsedCompilerOptString): string; 3993var 3994 s: String; 3995begin 3996 if ParsedPIStamp[Option]<>CompilerParseStamp then begin 3997 if ParsingPI[Option] then begin 3998 DebugLn('TParsedCompilerOptions.GetParsedPIValue Circle in Options: ',EnumToStr(Option)); 3999 exit(''); 4000 end; 4001 ParsingPI[Option]:=true; 4002 try 4003 s:=DoParseOption(GetUnparsedWithConditionals(Option),Option,true); 4004 ParsedPIValues[Option]:=s; 4005 ParsedPIStamp[Option]:=CompilerParseStamp; 4006 //if Option=pcosCustomOptions then begin 4007 // DebugLn('TParsedCompilerOptions.GetParsedValue PARSED ',dbgs(ParsedStamp[Option]),' ',dbgs(CompilerParseStamp),' new="',ParsedValues[Option],'"'); 4008 //end; 4009 finally 4010 ParsingPI[Option]:=false; 4011 end; 4012 end; 4013 Result:=ParsedPIValues[Option]; 4014end; 4015 4016procedure TParsedCompilerOptions.SetUnparsedValue( 4017 Option: TParsedCompilerOptString; const NewValue: string); 4018begin 4019 if NewValue=Values[Option].UnparsedValue then exit; 4020 if InvalidateParseOnChange then IncreaseCompilerParseStamp; 4021 if Option=pcosBaseDir then 4022 InvalidateFiles 4023 else begin 4024 Values[Option].ParseStamp:=CTInvalidChangeStamp; 4025 ParsedPIStamp[Option]:=CTInvalidChangeStamp; 4026 end; 4027 Values[Option].UnparsedValue:=NewValue; 4028end; 4029 4030function TParsedCompilerOptions.DoParseOption(const OptionText: string; 4031 Option: TParsedCompilerOptString; PlatformIndependent: boolean): string; 4032 4033 function GetBaseDir: string; 4034 begin 4035 if PlatformIndependent then 4036 Result:=GetParsedPIValue(pcosBaseDir) 4037 else 4038 Result:=GetParsedValue(pcosBaseDir); 4039 if Result='' then 4040 Result:=EnvironmentOptions.GetParsedTestBuildDirectory; 4041 end; 4042 4043 procedure MakeFilenameAbsolute(var aFilename: string); 4044 var 4045 BaseDirectory: String; 4046 begin 4047 aFilename:=TrimFilename(aFilename); 4048 if (aFilename<>'') and (not FilenameIsAbsolute(aFilename)) then begin 4049 BaseDirectory:=GetBaseDir; 4050 if (BaseDirectory<>'') then aFilename:=TrimFilename(BaseDirectory+aFilename); 4051 end; 4052 end; 4053 4054var 4055 s: String; 4056 BaseDirectory, h: String; 4057begin 4058 s:=OptionText; 4059 4060 // apply overrides 4061 if not PlatformIndependent then begin 4062 if Option=pcosOutputDir then begin 4063 if Assigned(OnGetOutputDirectoryOverride) then 4064 OnGetOutputDirectoryOverride(Self,s,bmgtAll); 4065 end; 4066 end; 4067 4068 // parse locally (macros depending on owner, like pkgdir and build macros) 4069 if Assigned(OnLocalSubstitute) then 4070 begin 4071 //DebugLn(['TParsedCompilerOptions.DoParseOption local "',s,'" ...']); 4072 s:=OnLocalSubstitute(s,PlatformIndependent) 4073 end else 4074 begin 4075 //DebugLn(['TParsedCompilerOptions.DoParseOption global "',s,'" ...']); 4076 s:=ParseString(Self,s,PlatformIndependent); 4077 end; 4078 //DebugLn(['TParsedCompilerOptions.DoParseOption complete "',s,'" ...']); 4079 // improve 4080 if Option=pcosBaseDir then 4081 // base directory 4082 s:=AppendPathDelim(TrimFilename(s)) 4083 else if Option in ParsedCompilerFilenames then 4084 begin 4085 // make filename absolute 4086 //debugln(['TParsedCompilerOptions.DoParseOption ',ParsedCompilerOptsVars[Option],' s="',s,'"']); 4087 if ExtractFilePath(s)='' then begin 4088 h:=FileUtil.FindDefaultExecutablePath(s,GetBaseDir); 4089 if h<>'' then s:=h; 4090 end; 4091 MakeFilenameAbsolute(s); 4092 end 4093 else if Option in ParsedCompilerDirectories then 4094 begin 4095 // make directory absolute 4096 s:=TrimFilename(s); 4097 if Option<>pcosBaseDir then 4098 MakeFilenameAbsolute(s); 4099 s:=AppendPathDelim(s); 4100 end 4101 else if Option in ParsedCompilerSearchPaths then 4102 begin 4103 // make search paths absolute 4104 BaseDirectory:=GetBaseDir; 4105 s:=TrimSearchPath(s,BaseDirectory); 4106 end else if Option=pcosCustomOptions then begin 4107 s:=SpecialCharsToSpaces(s,true); 4108 end; 4109 Result:=s; 4110end; 4111 4112procedure TParsedCompilerOptions.Assign(Src: TParsedCompilerOptions); 4113begin 4114 FInvalidateParseOnChange := Src.FInvalidateParseOnChange; 4115// FOnLocalSubstitute := Src.FOnLocalSubstitute; 4116 FOutputDirectoryOverride := Src.FOutputDirectoryOverride; 4117 Values := Src.Values; 4118 ParsedErrorOption := Src.ParsedErrorOption; 4119 ParsedErrorMsg := Src.ParsedErrorMsg; 4120 ParsedErrorStamp := Src.ParsedErrorStamp; 4121 // parsed except for platform macros 4122 ParsedPIValues := Src.ParsedPIValues; 4123 ParsedPIStamp := Src.ParsedPIStamp; 4124 ParsingPI := Src.ParsingPI; 4125 // macro values 4126// InheritedMacroValues.Assign(Src.InheritedMacroValues); 4127 InheritedMacroValuesStamp := Src.InheritedMacroValuesStamp; 4128 InheritedMacroValuesParsing := Src.InheritedMacroValuesParsing; 4129// MacroValues: TIDECfgScriptEngine; 4130 MacroValuesStamp := Src.MacroValuesStamp; 4131 MacroValuesParsing := Src.MacroValuesParsing; 4132end; 4133 4134procedure TParsedCompilerOptions.Clear; 4135var 4136 Option: TParsedCompilerOptString; 4137begin 4138 InvalidateAll; 4139 for Option:=Low(TParsedCompilerOptString) to High(TParsedCompilerOptString) do 4140 begin 4141 Values[Option].ParsedValue:=''; 4142 ParsedPIValues[Option]:=''; 4143 Values[Option].UnparsedValue:=''; 4144 end; 4145 InheritedMacroValues.Clear; 4146 MacroValues.Variables.Clear; 4147 MacroValues.ClearErrors; 4148end; 4149 4150procedure TParsedCompilerOptions.InvalidateAll; 4151var 4152 Option: TParsedCompilerOptString; 4153begin 4154 for Option:=Low(TParsedCompilerOptString) to High(TParsedCompilerOptString) do 4155 begin 4156 Values[Option].ParseStamp:=CTInvalidChangeStamp; 4157 ParsedPIStamp[Option]:=CTInvalidChangeStamp; 4158 end; 4159 InheritedMacroValuesStamp:=CTInvalidChangeStamp; 4160 MacroValuesStamp:=CTInvalidChangeStamp; 4161 ParsedErrorStamp:=CTInvalidChangeStamp; 4162end; 4163 4164procedure TParsedCompilerOptions.InvalidateFiles; 4165var 4166 Option: TParsedCompilerOptString; 4167begin 4168 for Option:=Low(TParsedCompilerOptString) to High(TParsedCompilerOptString) do 4169 if (Option in ParsedCompilerFiles) then begin 4170 Values[Option].ParseStamp:=CTInvalidChangeStamp; 4171 ParsedPIStamp[Option]:=CTInvalidChangeStamp; 4172 end; 4173end; 4174 4175procedure TParsedCompilerOptions.RenameMacro(const OldName, NewName: string; 4176 out Changed: TParsedCompilerOptStrings); 4177var 4178 o: TParsedCompilerOptString; 4179 s: String; 4180begin 4181 Changed:=[]; 4182 for o:=Low(Values) to High(Values) do 4183 begin 4184 s:=Values[o].UnparsedValue; 4185 RenameIDEMacroInString(s,OldName,NewName); 4186 if s<>Values[o].UnparsedValue then begin 4187 SetUnparsedValue(o,s); 4188 Include(Changed,o) 4189 end; 4190 end; 4191end; 4192 4193{ TCompilationToolOptions } 4194 4195procedure TCompilationToolOptions.SetCommand(AValue: string); 4196begin 4197 inherited SetCommand(AValue); 4198 FParsedCommandStamp:=CTInvalidChangeStamp; 4199end; 4200 4201procedure TCompilationToolOptions.SubstituteMacros(var s: string); 4202begin 4203 IDEMacros.SubstituteMacros(s); 4204end; 4205 4206procedure TCompilationToolOptions.Assign(Src: TLazCompilationToolOptions); 4207begin 4208 inherited Assign(Src); 4209 if Src is TCompilationToolOptions then 4210 Parsers.Assign(TCompilationToolOptions(Src).Parsers); 4211end; 4212 4213procedure TCompilationToolOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig; 4214 const Path: string; DoSwitchPathDelims: boolean); 4215var 4216 Params: TStrings; 4217 param, cmd: String; 4218 p, p2, i, j: Integer; 4219begin 4220 //debugln(['TCompilationToolOptions.LoadFromXMLConfig ',Command,' Path=',Path,' DoSwitchPathDelims=',DoSwitchPathDelims]); 4221 Command:=XMLConfig.GetValue(Path+'Command/Value',''); 4222 if DoSwitchPathDelims then begin 4223 if (Command<>'') 4224 and (PathDelim='\') then begin 4225 // specialhandling on windows to not switch path delimiters in options 4226 Params:=TStringList.Create; 4227 try 4228 SplitCmdLineParams(Command,Params); 4229 cmd:=SwitchPathDelims(Params[0],True); 4230 for i:=1 to Params.Count-1 do begin 4231 param:=Params[i]; 4232 p:=-1; 4233 p2:=-1; 4234 for j:=1 to length(param) do 4235 if p>1 then 4236 break 4237 else if param[j]='/' then 4238 p:=j 4239 else if param[j]=':' then 4240 p2:=j; 4241 if p=1 then 4242 // param is option (the only / is at pos 1) 4243 if p2<>-1 then 4244 // potential filename after colon in option 4245 cmd+=' '+copy(param,1,p2)+SwitchPathDelims(Copy(param,p2+1,length(param)-p2),True) 4246 else 4247 cmd+=' '+param 4248 else 4249 cmd+=' '+SwitchPathDelims(param,True); 4250 end; 4251 Command:=cmd; 4252 finally 4253 Params.Free; 4254 end; 4255 end else begin 4256 Command:=SwitchPathDelims(Command,DoSwitchPathDelims); 4257 end; 4258 end; 4259 LoadStringList(XMLConfig,Parsers,Path+'Parsers/'); 4260 if Parsers.Count=0 then begin 4261 // read old format 4262 HasParser[SubToolFPC]:=XMLConfig.GetValue(Path+'ScanForFPCMsgs/Value',false); 4263 HasParser[SubToolMake]:=XMLConfig.GetValue(Path+'ScanForMakeMsgs/Value',false); 4264 HasParser[SubToolDefault]:=XMLConfig.GetValue(Path+'ShowAllMessages/Value',false); 4265 end; 4266end; 4267 4268procedure TCompilationToolOptions.SaveToXMLConfig(XMLConfig: TXMLConfig; 4269 const Path: string; UsePathDelim: TPathDelimSwitch); 4270var 4271 i: Integer; 4272 s: String; 4273 NeedNewFormat: Boolean; 4274begin 4275 //debugln(['TCompilationToolOptions.SaveToXMLConfig ',Command,' Path=',Path]); 4276 XMLConfig.SetDeleteValue(Path+'Command/Value', 4277 SwitchPathDelims(Command,UsePathDelim),''); 4278 // Parsers 4279 NeedNewFormat:=false; 4280 for i:=0 to Parsers.Count-1 do begin 4281 s:=Parsers[i]; 4282 if (CompareText(s,SubToolFPC)=0) 4283 or (CompareText(s,SubToolMake)=0) 4284 or (CompareText(s,SubToolDefault)=0) 4285 then continue; 4286 NeedNewFormat:=true; 4287 break; 4288 end; 4289 if NeedNewFormat then 4290 SaveStringList(XMLConfig,Parsers,Path+'Parsers/') 4291 else begin 4292 // save backward compatible 4293 XMLConfig.SetDeleteValue(Path+'ScanForFPCMsgs/Value', HasParser[SubToolFPC],false); 4294 XMLConfig.SetDeleteValue(Path+'ScanForMakeMsgs/Value',HasParser[SubToolMake],false); 4295 XMLConfig.SetDeleteValue(Path+'ShowAllMessages/Value',HasParser[SubToolDefault],false); 4296 end; 4297end; 4298 4299function TCompilationToolOptions.CreateDiff(CompOpts: TCompilationToolOptions; 4300 Tool: TCompilerDiffTool): boolean; 4301 4302 function Done(Diff: boolean): boolean; 4303 begin 4304 if Diff then CreateDiff:=true; 4305 Result:=(Tool=nil) and Diff; 4306 end; 4307 4308begin 4309 Result:=false; 4310 if Done(Tool.AddDiff('Command',Command,CompOpts.Command)) then exit; 4311 if Done(Tool.AddStringsDiff('Parsers',Parsers,CompOpts.Parsers)) then exit; 4312end; 4313 4314function TCompilationToolOptions.Execute(const WorkingDir, ToolTitle, 4315 CompileHint: string): TModalResult; 4316var 4317 ExtTool: TAbstractExternalTool; 4318begin 4319 if Command='' then exit(mrOk); 4320 if SourceEditorManagerIntf<>nil then 4321 SourceEditorManagerIntf.ClearErrorLines; 4322 4323 ExtTool:=CreateExtTool(WorkingDir,ToolTitle,CompileHint); 4324 if ExtTool=nil then exit(mrOk); 4325 ExtTool.Reference(Self,ClassName); 4326 try 4327 // run 4328 ExtTool.Execute; 4329 ExtTool.WaitForExit; 4330 if ExtTool.ErrorMessage='' then 4331 Result:=mrOk 4332 else 4333 Result:=mrCancel; 4334 finally 4335 ExtTool.Release(Self); 4336 end; 4337end; 4338 4339function TCompilationToolOptions.CreateExtTool(const WorkingDir, ToolTitle, 4340 CompileHint: string): TAbstractExternalTool; 4341var 4342 CurCommand: String; 4343 ProgramFilename: string; 4344 Params: string; 4345 Filename: String; 4346 ok: Boolean; 4347 i: Integer; 4348begin 4349 CurCommand:=GetParsedCommand; 4350 //debugln(['TCompilationToolOptions.CreateExtTool CurCommand=[',CurCommand,']']); 4351 if CurCommand='' then 4352 exit(nil); 4353 SplitCmdLine(CurCommand,ProgramFilename,Params); 4354 //debugln(['TCompilationToolOptions.CreateExtTool Prg=[',ProgramFilename,'] Params=[',Params,']']); 4355 if not FilenameIsAbsolute(ProgramFilename) then begin 4356 Filename:=FindProgram(ProgramFilename,WorkingDir,true); 4357 //debugln(['TCompilationToolOptions.CreateExtTool Found=[',Filename,']']); 4358 if Filename<>'' then ProgramFilename:=Filename; 4359 end; 4360 Result:=ExternalToolList.Add(ToolTitle); 4361 ok:=false; 4362 try 4363 Result.Hint:=CompileHint; 4364 Result.Process.CurrentDirectory:=WorkingDir; 4365 Result.Process.Executable:=ProgramFilename; 4366 Result.CmdLineParams:=Params; 4367 for i:=0 to Parsers.Count-1 do 4368 Result.AddParserByName(Parsers[i]); 4369 if Result.ParserCount=0 then 4370 Result.AddParsers(SubToolDefault); 4371 ok:=true; 4372 finally 4373 if not ok then 4374 FreeAndNil(Result); 4375 end; 4376end; 4377 4378function TCompilationToolOptions.GetParsedCommand: string; 4379begin 4380 if FParsedCommandStamp<>CompilerParseStamp then begin 4381 FParsedCommandStamp:=CompilerParseStamp; 4382 FParsedCommand:=Command; 4383 //debugln(['TCompilationToolOptions.GetParsedCommand Unparsed="',FParsedCommand,'"']); 4384 SubstituteMacros(FParsedCommand); 4385 //debugln(['TCompilationToolOptions.GetParsedCommand Parsed="',FParsedCommand,'"']); 4386 end; 4387 Result:=FParsedCommand; 4388end; 4389 4390function TCompilationToolOptions.HasCommands: boolean; 4391begin 4392 Result:=true; 4393 if GetParsedCommand<>'' then exit; 4394 Result:=false; 4395end; 4396 4397{ TIDEBuildMacro } 4398 4399procedure TIDEBuildMacro.SetIdentifier(const AValue: string); 4400begin 4401 if FIdentifier=AValue then exit; 4402 if not IsValidIdent(AValue) then 4403 raise Exception.Create('TIDEBuildMacro.SetIdentifier invalid identifier: '+AValue); 4404 FIdentifier:=AValue; 4405 {$IFDEF VerboseIDEModified} 4406 debugln(['TIDEBuildMacro.SetIdentifier ',AValue]); 4407 {$ENDIF} 4408 IncreaseChangeStamp; 4409 IncreaseBuildMacroChangeStamp; 4410end; 4411 4412procedure TIDEBuildMacro.SetDescription(const AValue: string); 4413begin 4414 if FDescription=AValue then exit; 4415 FDescription:=AValue; 4416 {$IFDEF VerboseIDEModified} 4417 debugln(['TIDEBuildMacro.SetDescription ',AValue]); 4418 {$ENDIF} 4419 IncreaseChangeStamp; 4420end; 4421 4422procedure TIDEBuildMacro.SetValueDescriptions(const AValue: TStrings); 4423begin 4424 if (FValueDescriptions=AValue) or FValueDescriptions.Equals(AValue) then exit; 4425 FValueDescriptions.Assign(AValue); 4426 {$IFDEF VerboseIDEModified} 4427 debugln(['TIDEBuildMacro.SetValueDescriptions ',AValue.Text]); 4428 {$ENDIF} 4429 IncreaseChangeStamp; 4430end; 4431 4432procedure TIDEBuildMacro.SetValues(const AValue: TStrings); 4433begin 4434 if (FValues=AValue) or FValues.Equals(AValue) then exit; 4435 FValues.Assign(AValue); 4436 {$IFDEF VerboseIDEModified} 4437 debugln(['TIDEBuildMacro.SetValues ',AValue.Text]); 4438 {$ENDIF} 4439 IncreaseChangeStamp; 4440end; 4441 4442constructor TIDEBuildMacro.Create; 4443begin 4444 FChangeStamp:=CTInvalidChangeStamp; 4445 FValues:=TStringList.Create; 4446 FValueDescriptions:=TStringList.Create; 4447 FDefaultValue:=''; 4448end; 4449 4450destructor TIDEBuildMacro.Destroy; 4451begin 4452 FreeAndNil(FValues); 4453 FreeAndNil(FValueDescriptions); 4454 inherited Destroy; 4455end; 4456 4457procedure TIDEBuildMacro.Assign(Source: TLazBuildMacro); 4458begin 4459 Identifier:=Source.Identifier; 4460 Description:=Source.Description; 4461 ValueDescriptions:=Source.ValueDescriptions; 4462 Values:=Source.Values; 4463end; 4464 4465function TIDEBuildMacro.Equals(Other: TLazBuildMacro): boolean; 4466begin 4467 Result:=false; 4468 if Identifier<>Other.Identifier then exit; 4469 if Description<>Other.Description then exit; 4470 if not Values.Equals(Other.Values) then exit; 4471 if not ValueDescriptions.Equals(Other.ValueDescriptions) then exit; 4472 Result:=true; 4473end; 4474 4475procedure TIDEBuildMacro.LoadFromXMLConfig(AXMLConfig: TXMLConfig; 4476 const Path: string; DoSwitchPathDelims: boolean); 4477begin 4478 FIdentifier:=AXMLConfig.GetValue(Path+'Identifier/Value',''); 4479 if not IsValidIdent(FIdentifier) then FIdentifier:=''; 4480 FDescription:=LineBreaksToSystemLineBreaks(AXMLConfig.GetValue(Path+'Description/Value','')); 4481 LoadStringList(AXMLConfig,FValues,Path+'Values/'); 4482 LoadStringList(AXMLConfig,FValueDescriptions,Path+'ValueDescriptions/'); 4483 FDefaultValue:=LineBreaksToSystemLineBreaks(AXMLConfig.GetValue(Path+'Default/Value','')); 4484 4485 while ValueDescriptions.Count>Values.Count do 4486 ValueDescriptions.Delete(ValueDescriptions.Count-1); 4487 while ValueDescriptions.Count<Values.Count do 4488 ValueDescriptions.Add(''); 4489end; 4490 4491procedure TIDEBuildMacro.SaveToXMLConfig(AXMLConfig: TXMLConfig; 4492 const Path: string; UsePathDelim: TPathDelimSwitch); 4493begin 4494 AXMLConfig.SetDeleteValue(Path+'Identifier/Value',FIdentifier,''); 4495 AXMLConfig.SetDeleteValue(Path+'Description/Value', 4496 LineBreaksToDelimiter(FDescription,#10),''); 4497 SaveStringList(AXMLConfig,FValues,Path+'Values/'); 4498 SaveStringList(AXMLConfig,FValueDescriptions,Path+'ValueDescriptions/'); 4499 AXMLConfig.SetDeleteValue(Path+'DefaultValue/Value', 4500 LineBreaksToDelimiter(FDefaultValue,#10),''); 4501end; 4502 4503function TIDEBuildMacro.CreateDiff(OtherMode: TLazBuildMacro; 4504 Tool: TCompilerDiffTool): boolean; 4505 4506 function Done(Diff: boolean): boolean; 4507 begin 4508 if Diff then CreateDiff:=true; 4509 Result:=(Tool=nil) and Diff; 4510 end; 4511 4512begin 4513 Result:=false; 4514 if Done(Tool.AddDiff('Identifier',Identifier,OtherMode.Identifier)) then exit; 4515 if Done(Tool.AddDiff('Description',Description,OtherMode.Description)) then exit; 4516 if Done(Tool.AddStringsDiff('Values',Values,OtherMode.Values)) then exit; 4517 if Done(Tool.AddStringsDiff('ValueDescriptions',ValueDescriptions,OtherMode.ValueDescriptions)) then exit; 4518end; 4519 4520procedure TIDEBuildMacro.IncreaseChangeStamp; 4521begin 4522 CTIncreaseChangeStamp(FChangeStamp); 4523end; 4524 4525{ TIDEBuildMacros } 4526 4527function TIDEBuildMacros.GetItems(Index: integer): TLazBuildMacro; 4528begin 4529 Result:=TLazBuildMacro(FItems[Index]); 4530end; 4531 4532function TIDEBuildMacros.Add(Identifier: string): TLazBuildMacro; 4533begin 4534 if IndexOfIdentifier(Identifier)>=0 then 4535 raise Exception.Create('TIDEBuildMacros.Add identifier already exists'); 4536 Result:=TIDEBuildMacro.Create; 4537 Result.Identifier:=Identifier; 4538 FItems.Add(Result); 4539end; 4540 4541procedure TIDEBuildMacros.Clear; 4542var 4543 i: Integer; 4544begin 4545 for i:=0 to FItems.Count-1 do 4546 TObject(FItems[i]).Free; 4547 FItems.Clear; 4548end; 4549 4550function TIDEBuildMacros.Count: integer; 4551begin 4552 Result:=FItems.Count; 4553end; 4554 4555constructor TIDEBuildMacros.Create(TheOwner: TObject); 4556begin 4557 inherited Create(TheOwner); 4558 FItems:=TFPList.Create; 4559end; 4560 4561procedure TIDEBuildMacros.Delete(Index: integer); 4562begin 4563 TObject(FItems[Index]).Free; 4564 FItems.Delete(Index); 4565end; 4566 4567destructor TIDEBuildMacros.Destroy; 4568begin 4569 Clear; 4570 FreeAndNil(FItems); 4571 inherited Destroy; 4572end; 4573 4574function TIDEBuildMacros.IndexOfIdentifier(Identifier: string): integer; 4575begin 4576 Result:=FItems.Count-1; 4577 while (Result>=0) and (SysUtils.CompareText(Identifier,Items[Result].Identifier)<>0) do 4578 dec(Result); 4579end; 4580 4581function TIDEBuildMacros.VarWithIdentifier(Identifier: string): TIDEBuildMacro; 4582var 4583 i: LongInt; 4584begin 4585 i:=IndexOfIdentifier(Identifier); 4586 if i<0 then 4587 Result:=nil 4588 else 4589 Result:=TIDEBuildMacro(Items[i]); 4590end; 4591 4592procedure TIDEBuildMacros.Move(OldIndex, NewIndex: integer); 4593begin 4594 FItems.Move(OldIndex,NewIndex); 4595end; 4596 4597procedure TIDEBuildMacros.LoadFromXMLConfig(AXMLConfig: TXMLConfig; 4598 const Path: string; DoSwitchPathDelims: boolean); 4599var 4600 NewItem: TIDEBuildMacro; 4601 NewCount: LongInt; 4602 i: Integer; 4603begin 4604 Clear; 4605 NewCount:=AXMLConfig.GetValue(Path+'Count/Value',0); 4606 for i:=0 to NewCount-1 do begin 4607 NewItem:=TIDEBuildMacro.Create; 4608 NewItem.LoadFromXMLConfig(AXMLConfig,Path+'Item'+IntToStr(i+1)+'/',DoSwitchPathDelims); 4609 if IsValidIdent(NewItem.Identifier) then 4610 FItems.Add(NewItem) 4611 else 4612 NewItem.Free; 4613 end; 4614end; 4615 4616procedure TIDEBuildMacros.SaveToXMLConfig(AXMLConfig: TXMLConfig; 4617 const Path: string; UsePathDelim: TPathDelimSwitch); 4618var 4619 i: Integer; 4620begin 4621 AXMLConfig.SetDeleteValue(Path+'Count/Value',Count,0); 4622 for i:=0 to Count-1 do 4623 TIDEBuildMacro(Items[i]).SaveToXMLConfig(AXMLConfig, 4624 Path+'Item'+IntToStr(i+1)+'/',UsePathDelim); 4625end; 4626 4627function TIDEBuildMacros.CreateDiff(OtherProperties: TLazBuildMacros; 4628 Tool: TCompilerDiffTool): boolean; 4629var 4630 i: Integer; 4631 OtherMacro: TLazBuildMacro; 4632begin 4633 Result:=Tool.AddDiff('BuildMacros/Count',Count,OtherProperties.Count); 4634 if (Tool=nil) and Result then exit; 4635 for i:=0 to OtherProperties.Count-1 do begin 4636 OtherMacro:=OtherProperties.Items[i]; 4637 if i>=Count then 4638 begin 4639 if Tool=nil then exit(true); 4640 Tool.AddDiffItem('BuildMacros/'+OtherMacro.Identifier,'new'); 4641 end else begin 4642 if Tool=nil then 4643 begin 4644 if not TIDEBuildMacro(Items[i]).Equals(OtherMacro) then exit(true); 4645 end else 4646 begin 4647 Tool.Path:='BuildMacros/'+OtherMacro.Identifier; 4648 if TIDEBuildMacro(Items[i]).CreateDiff(OtherProperties.Items[i],Tool) then 4649 Result:=true; 4650 end; 4651 end; 4652 end; 4653 if Tool<>nil then 4654 for i:=OtherProperties.Count to Count-1 do 4655 Tool.AddDiffItem('BuildMacros/'+Items[i].Identifier,'deleted'); 4656end; 4657 4658procedure TIDEBuildMacros.Assign(Source: TLazBuildMacros); 4659var 4660 i: Integer; 4661 Item: TLazBuildMacro; 4662begin 4663 Clear; 4664 for i:=0 to Source.Count-1 do begin 4665 Item:=Add(Source[i].Identifier); 4666 TIDEBuildMacro(Item).Assign(Source[i]); 4667 end; 4668end; 4669 4670{ TCompilerMsgIDFlags } 4671 4672function TCompilerMsgIDFlags.Count: SizeInt; 4673begin 4674 Result:=fTree.Count; 4675end; 4676 4677function TCompilerMsgIDFlags.FindNode(MsgId: integer): TAvlTreeNode; 4678var 4679 Flag: TCompilerMsgIdFlag; 4680begin 4681 Flag.MsgId:=MsgId; 4682 Result:=fTree.FindKey(@Flag,@CompareCompMsgIdFlag); 4683end; 4684 4685function TCompilerMsgIDFlags.GetValues(MsgId: integer): TCompilerFlagValue; 4686var 4687 Node: TAvlTreeNode; 4688begin 4689 Node:=FindNode(MsgId); 4690 if Node<>nil then 4691 Result:=PCompilerMsgIdFlag(Node.Data)^.Flag 4692 else 4693 Result:=cfvNone; 4694end; 4695 4696function TCompilerMsgIDFlags.GetModified: boolean; 4697begin 4698 Result:=FChangeStamp<>fLastSavedStamp; 4699end; 4700 4701procedure TCompilerMsgIDFlags.SetModified(AValue: boolean); 4702begin 4703 if AValue then 4704 IncreaseChangeStamp 4705 else 4706 fLastSavedStamp:=FChangeStamp; 4707end; 4708 4709procedure TCompilerMsgIDFlags.SetValues(MsgId: integer; 4710 AValue: TCompilerFlagValue); 4711var 4712 Node: TAvlTreeNode; 4713 Flag: PCompilerMsgIdFlag; 4714begin 4715 Node:=FindNode(MsgId); 4716 if (Node<>nil) then begin 4717 Flag:=PCompilerMsgIdFlag(Node.Data); 4718 if Flag^.Flag=AValue then 4719 exit; // no change 4720 if AValue=cfvNone then begin 4721 // change to default -> do not store default values => delete 4722 Dispose(Flag); 4723 fTree.Delete(Node); 4724 end 4725 else 4726 Flag^.Flag:=AValue; // switch 4727 end else if AValue=cfvNone then begin 4728 // no change 4729 exit; 4730 end else begin 4731 // add new value 4732 New(Flag); 4733 Flag^.MsgId:=MsgId; 4734 Flag^.Flag:=AValue; 4735 fTree.Add(Flag); 4736 fTree.ConsistencyCheck; 4737 end; 4738 {$IFDEF VerboseIDEModified} 4739 debugln(['TCompilerMsgIDFlags.SetValues ']); 4740 {$ENDIF} 4741 IncreaseChangeStamp; 4742end; 4743 4744constructor TCompilerMsgIDFlags.Create; 4745begin 4746 fTree:=TAvlTree.Create(@CompareCompMsgIdFlag); 4747end; 4748 4749destructor TCompilerMsgIDFlags.Destroy; 4750begin 4751 Clear; 4752 FreeAndNil(fTree); 4753 inherited Destroy; 4754end; 4755 4756procedure TCompilerMsgIDFlags.Clear; 4757var 4758 Node: TAvlTreeNode; 4759 Flag: PCompilerMsgIdFlag; 4760begin 4761 Node:=fTree.FindLowest; 4762 while Node<>nil do begin 4763 Flag:=PCompilerMsgIdFlag(Node.Data); 4764 Dispose(Flag); 4765 Node:=Node.Successor; 4766 end; 4767 fTree.Clear; 4768end; 4769 4770procedure TCompilerMsgIDFlags.Assign(Source: TPersistent); 4771var 4772 Src: TCompilerMsgIDFlags; 4773 Node: TAvlTreeNode; 4774 SrcFlag, Flag: PCompilerMsgIdFlag; 4775begin 4776 if Source is TCompilerMsgIDFlags then begin 4777 Src:=TCompilerMsgIDFlags(Source); 4778 if Equals(Src) then exit; 4779 // copy node structure and Data references 4780 fTree.Assign(Src.fTree); 4781 // clone data 4782 Node:=fTree.FindLowest; 4783 while Node<>nil do begin 4784 SrcFlag:=PCompilerMsgIdFlag(Node.Data); 4785 New(Flag); 4786 Flag^:=SrcFlag^; 4787 Node.Data:=Flag; 4788 Node:=Node.Successor; 4789 end; 4790 {$IFDEF VerboseIDEModified} 4791 debugln(['TCompilerMsgIDFlags.Assign ']); 4792 {$ENDIF} 4793 IncreaseChangeStamp; 4794 end else 4795 inherited Assign(Source); 4796end; 4797 4798function TCompilerMsgIDFlags.Equals(Obj: TObject): boolean; 4799var 4800 Other: TCompilerMsgIDFlags; 4801 MyNode: TAvlTreeNode; 4802 OtherNode: TAvlTreeNode; 4803 MyFlag: PCompilerMsgIdFlag; 4804 OtherFlag: PCompilerMsgIdFlag; 4805begin 4806 if Obj=Self then exit(true); 4807 if Obj is TCompilerMsgIDFlags then begin 4808 Other:=TCompilerMsgIDFlags(Obj); 4809 Result:=false; 4810 if Count<>Other.Count then exit; 4811 MyNode:=fTree.FindLowest; 4812 OtherNode:=Other.fTree.FindLowest; 4813 while MyNode<>nil do begin 4814 if OtherNode=nil then exit; 4815 MyFlag:=PCompilerMsgIdFlag(MyNode.Data); 4816 OtherFlag:=PCompilerMsgIdFlag(OtherNode.Data); 4817 if (MyFlag^.MsgId<>OtherFlag^.MsgId) 4818 or (MyFlag^.Flag<>OtherFlag^.Flag) then exit; 4819 MyNode:=MyNode.Successor; 4820 OtherNode:=OtherNode.Successor; 4821 end; 4822 if OtherNode<>nil then exit; 4823 Result:=true; 4824 end 4825 else 4826 Result:=inherited Equals(Obj); 4827end; 4828 4829procedure TCompilerMsgIDFlags.IncreaseChangeStamp; 4830begin 4831 CTIncreaseChangeStamp64(FChangeStamp); 4832end; 4833 4834function TCompilerMsgIDFlags.GetEnumerator: TCompilerMsgIDFlagsEnumerator; 4835begin 4836 Result:=TCompilerMsgIDFlagsEnumerator.Create(fTree); 4837end; 4838 4839function TCompilerMsgIDFlags.GetMsgIdList(Delim: char; 4840 aValue: TCompilerFlagValue; FPCMsgFile: TFPCMsgFilePoolItem): string; 4841var 4842 Flag: PCompilerMsgIdFlag; 4843begin 4844 Result:=''; 4845 for Flag in Self do begin 4846 if Flag^.Flag<>aValue then continue; 4847 if (FPCMsgFile<>nil) and (FPCMsgFile.GetMsg(Flag^.MsgId)=nil) then continue; 4848 if Result<>'' then 4849 Result+=Delim; 4850 Result+=IntToStr(Flag^.MsgId); 4851 end; 4852end; 4853 4854function TCompilerMsgIDFlags.CreateDiff(Tool: TCompilerDiffTool; 4855 Other: TCompilerMsgIDFlags): boolean; 4856var 4857 Node: TAvlTreeNode; 4858 Flag: PCompilerMsgIdFlag; 4859 OtherFlag: TCompilerFlagValue; 4860begin 4861 Result:=false; 4862 if Tool=nil then 4863 exit(Equals(Other)); 4864 Result:=Result or Tool.AddDiff('Count',Count,Other.Count); 4865 // first all in here 4866 Node:=fTree.FindLowest; 4867 while Node<>nil do begin 4868 Flag:=PCompilerMsgIdFlag(Node.Data); 4869 OtherFlag:=Other[Flag^.MsgId]; 4870 if Flag^.Flag<>OtherFlag then begin 4871 Result:=Result or Tool.AddDiff('message id '+IntToStr(Flag^.MsgId),EnumToStr(Flag^.Flag),EnumToStr(OtherFlag)); 4872 end; 4873 Node:=Node.Successor; 4874 end; 4875 // then all not here 4876 Node:=Other.fTree.FindLowest; 4877 while Node<>nil do begin 4878 Flag:=PCompilerMsgIdFlag(Node.Data); 4879 if Values[Flag^.MsgId]=cfvNone then 4880 Result:=Result or Tool.AddDiff('message id '+IntToStr(Flag^.MsgId),EnumToStr(cfvNone),EnumToStr(Flag^.Flag)); 4881 Node:=Node.Successor; 4882 end; 4883end; 4884 4885initialization 4886 CompilerParseStamp:=1; 4887 BuildMacroChangeStamp:=1; 4888 4889end. 4890 4891