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

+ initial (and so far experimental) implementation of -ix to output -i in xml format for further automated processing

Browse Source 
git-svn-id: trunk@48897 -
This commit is contained in:
florian 2021-03-07 14:11:09 +00:00
parent 9fbaa28df7
commit b0772ae749
1 changed files with 65 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
compiler/options.pas
View File

@ -212,6 +212,7 @@ var
p : pchar; p : pchar;
hs,hs1,hs3,s : TCmdStr; hs,hs1,hs3,s : TCmdStr;
J: longint; J: longint;
xmloutput: Text;
const const
NewLineStr = '$\n'; NewLineStr = '$\n';
OSTargetsPlaceholder = '$OSTARGETS'; OSTargetsPlaceholder = '$OSTARGETS';
@ -407,6 +408,17 @@ const
end; end;
end; end;
procedure ListOptimizationsXML;
var
opt: toptimizerswitch;
begin
WriteLn(xmloutput,'<optimizations>');
for opt:=low(toptimizerswitch) to high(toptimizerswitch) do
if OptimizerSwitchStr[opt]<>'' then
WriteLn(xmloutput,'<optimization name="',OptimizerSwitchStr[opt],'"/>');
WriteLn(xmloutput,'</optimizations>');
end;
procedure ListWPOptimizations (OrigString: TCmdStr); procedure ListWPOptimizations (OrigString: TCmdStr);
var var
wpopt: twpoptimizerswitch; wpopt: twpoptimizerswitch;
@ -502,6 +514,23 @@ const
{$POP} {$POP}
end; end;
procedure ListControllerTypesXML;
var
controllertype : tcontrollertype;
begin
{$PUSH}
{$WARN 6018 OFF} (* Unreachable code due to compile time evaluation *)
if (ControllerSupport) then
begin
WriteLn(xmloutput,'<controllertypes>');
for controllertype:=low(tcontrollertype) to high(tcontrollertype) do
if embedded_controllers[controllertype].ControllerTypeStr<>'' then
WriteLn(xmloutput,'<controllertype name="',embedded_controllers[controllertype].ControllerTypeStr,'"/>');
WriteLn(xmloutput,'</controllertypes>');
end;
{$POP}
end;
procedure ListFeatures (OrigString: TCmdStr); procedure ListFeatures (OrigString: TCmdStr);
var var
Feature: TFeature; Feature: TFeature;
@ -627,31 +656,44 @@ begin
Comment(V_Normal,s); Comment(V_Normal,s);
end; end;
end end
else if Copy(More,1,1) = 'x' then
begin
Assign(xmloutput,Copy(More,2,length(More)-1));
Rewrite(xmloutput);
WriteLn(xmloutput,'<?xml version="1.0" encoding="utf-8"?>');
WriteLn(xmloutput,'<fpcoutput>');
WriteLn(xmloutput,'<info>');
ListOptimizationsXML;
ListControllerTypesXML;
WriteLn(xmloutput,'</info>');
WriteLn(xmloutput,'</fpcoutput>');
Close(xmloutput);
end
else else
begin begin
J := 1; J := 1;
while J <= Length (More) do while J <= Length (More) do
begin begin
if J > 1 then if J > 1 then
Comment(V_Normal,''); (* Put empty line between multiple sections *) Comment(V_Normal,''); (* Put empty line between multiple sections *)
case More [J] of case More [J] of
'a': ListABITargets (''); 'a': ListABITargets ('');
'b': Comment(V_Normal, cgbackend2str[cgbackend]); 'b': Comment(V_Normal, cgbackend2str[cgbackend]);
'c': ListCPUInstructionSets (''); 'c': ListCPUInstructionSets ('');
'f': ListFPUInstructionSets (''); 'f': ListFPUInstructionSets ('');
'i': ListAsmModes (''); 'i': ListAsmModes ('');
'm': ListModeswitches (''); 'm': ListModeswitches ('');
'o': ListOptimizations (''); 'o': ListOptimizations ('');
'r': ListFeatures (''); 'r': ListFeatures ('');
't': ListOSTargets (''); 't': ListOSTargets ('');
'u': ListControllerTypes (''); 'u': ListControllerTypes ('');
'w': ListWPOptimizations (''); 'w': ListWPOptimizations ('');
else else
IllegalPara ('-i' + More); IllegalPara ('-i' + More);
end;
Inc (J);
end; end;
Inc (J); end;
end;
end;
StopOptions(0); StopOptions(0);
end; end;
@ -1952,7 +1994,7 @@ begin
'i' : 'i' :
begin begin
if (More='') or if (More='') or
(More [1] in ['a', 'b', 'c', 'f', 'i', 'm', 'o', 'r', 't', 'u', 'w']) then (More [1] in ['a', 'b', 'c', 'f', 'i', 'm', 'o', 'r', 't', 'u', 'w', 'x']) then
WriteInfo (More) WriteInfo (More)
else else
QuickInfo:=QuickInfo+More; QuickInfo:=QuickInfo+More;