I'm trying to catch the error in this precondition I have on the main procedure and I'm wondering if it's possible to catch?
Do I need to move this to a different procedure and then call it in main in order to catch it?
with
ada.text_io,
ada.command_line,
ada.strings.bounded,
system.assertions;
procedure main with
pre => (ada.command_line.argument_count > 2)
is
package b_str is new
ada.strings.bounded.generic_bounded_length (max => 255);
use b_str;
input_file : bounded_string;
argument : bounded_string;
i : integer := 1;
begin
while i <= ada.command_line.argument_count loop
argument := to_bounded_string(
ada.command_line.argument(i)
);
ada.text_io.put_line("[" & i'image & "] "
& to_string(argument)
);
i := i + 1;
end loop;
exception
when system.assertions.assert_failure =>
ada.text_io.put_line("Failed precondition");
end main;
I've found my answer:
Exception handlers have an important restriction that you need to be careful about: Exceptions raised in the declarative section are not caught by the handlers of that block.
From: https://learn.adacore.com/courses/intro-to-ada/chapters/exceptions.html
Since exception can not be handled in a declarative section, the action should be moved to a package similar to the one below. Then, call it from a exception handling block of the main procedure. So, your code will not terminate after handling the exception.
with Ada.Command_line;
package Util is
--...
function Command_Argument_Count return Natural
with Pre => Ada.Command_Line.Argument_Count > 2;
--...
end Util;
--...
Exception_Handling_Block:
begin
while i <= Util.Command_Argument_Count loop
argument := to_bounded_string(
ada.command_line.argument(i)
);
ada.text_io.put_line("[" & i'image & "] "
& to_string(argument)
);
i := i + 1;
end loop;
exception
when system.assertions.assert_failure =>
ada.text_io.put_line("Failed precondition");
end Exception_Handling_Block;
--...
Related
Let's consider this MWE:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with GNAT.Strings; use GNAT.Strings;
with GNAT.Command_Line; use GNAT.Command_Line;
procedure Verbose_And_Image is
type T_Foo is tagged record
Member_1 : Natural := 13;
Member_2 : Float := 1.414;
Member_3 : Boolean := False;
Member_4 : Unbounded_String := To_Unbounded_String ("Foo");
Member_5 : Natural := 42;
end record;
function Image (Foo : in T_Foo) return String is
Message : Unbounded_String :=
"M1: " & Foo.Member_1'Image & " " &
"M2: " & Foo.Member_2'Image & " " &
"M3: " & Foo.Member_3'Image & " " &
"M4: " & Foo.Member_4 & " " &
"M5: " & Foo.Member_5'Image;
begin
return To_String(Message);
end Image;
Global_Foo : T_Foo;
Config : Command_Line_Configuration;
Verbose : aliased Boolean := False;
N_Elem : aliased Integer := 0;
procedure Debug (Message : in String) is
begin
if Verbose then
Put_Line (Message);
else
null; -- the program is quiet.
end if;
end Debug;
procedure Bar (I : in Integer; Foo : in out T_Foo) is
begin
Foo.Member_5 := I;
Debug ("I is: " & Image (Foo));
end Bar;
begin
Define_Switch (Config, Verbose'Access, "-v", Help => "Verbose");
Define_Switch (Config, N_Elem'Access, "-n:", Help => "Number of tries");
Getopt (Config);
Put_Line ("File argument was " & Verbose'Image);
for I in 1..N_Elem loop
Bar (I, Global_Foo);
end loop;
end Verbose_And_Image;
Compiling this example with gnatmake, we may "profile" our program with:
gnatmake -O3 verbose_and_image.adb
gcc -c -O3 verbose_and_image.adb
gnatbind -x verbose_and_image.ali
gnatlink verbose_and_image.ali -O3
$time ./verbose_and_image -n 19999999 > /dev/null # In "quiet"
real 0m8.282s
user 0m7.946s
sys 0m0.005s
$time ./verbose_and_image -v -n 19999999 > /dev/null # In verbose
real 0m19.481s
user 0m11.946s
sys 0m6.756s
In many cases, to "optimize" the code, some developers wrote everywhere:
procedure Bar (I : in Integer; Foo : in out T_Foo) is
begin
Foo.Member_5 := I;
if Verbose then
Debug ("I is: " & Image (Foo));
end if;
end Bar;
Which is indeed order of magnitude faster (though my example is not really precise):
$time ./verbose_and_image -v -n 19999999 > /dev/null
real 0m19.585s
user 0m12.146s
sys 0m6.655s
$time ./verbose_and_image -n 19999999 > /dev/null
real 0m0.027s
user 0m0.023s
sys 0m0.003s
Writing a dedicated Debug (Message : in String; Foo : in T_Foo) function leads to comparable performances.
My concern with this later form is that the thousands of if Level make the code horribly difficult to read (increasing the cyclomatic complexity) and most of them do not even make sense (no image evaluation inside).
It is also not acceptable to write those dedicated functions each time you want to print a message (plus the debugging is handled by a dedicated package).
Is there a way to offer a procedure based on Formatted_String (for instance) to allow a late evaluation of these Images when needed. Something like:
procedure Debug(format: in out Formatted_String, ...) is
begin
if Verbose then
for argument of arguments loop
format := format & argument'Image;
end loop;
Put_Line (-format);
end if;
end Debug;
So that, at any point, one may do:
Debug ( +"Debug %s", Foo);
Delaying the evaluation of the images to the Debug function and without the need to declare functions any time you want to print some debug message.
I would recommend against using "formatting strings", if possible.
They're too easy to screw-up and the compiler generally can't confirm that you're not making some mistake the way it can with Text_IO.Put_Line( "First-part " & Image(Object) & " second part.") or Text_IO.Put("First-part ")/Enumeration_IO.put(Object)/Text_IO.Put_Line(" second part.").
The way to handle the need for variable length inputs is typically via unconstrained arrays or Ada containers (esp vectors).
I'm stuck here with an error in my Ada program. There is a lot of code and I don't want to copy all of it here, so I hope that the part that I'm sharing is the part from where the problem comes.
task type Producent is
entry Start(Jedzenie: in Typ_Jedzenia; Czas_Produkcji: in Integer);
end Producent;
task type Buffer is
entry Zamow(Jedzenie: in Typ_Jedzenia; Numer: in Integer; Czy_Zatwierdzono: out Boolean);
entry Dostarcz(Zamowienie: in Typ_Zestawu; Numer: out Integer);
end Buffer;
task body Producent is
package Losowa_Produkcja is new
Ada.Numerics.Discrete_Random(Zakres_Czasu_Produkcji);
Generator: Losowa_Produkcja.Generator;
Index_Jedzenia: Integer;
Nr_Produkcji_Jedzenia: Integer := 1;
Produkcja: Integer;
Zatwierdzono: Boolean := False;
begin
accept Start (Jedzenie : in Typ_Jedzenia; Czas_Produkcji : in Integer) do
Losowa_Produkcja.Reset(Generator);
Index_Jedzenia := Jedzenie;
Produkcja := Czas_Produkcji;
end Start;
loop
delay Duration(Losowa_Produkcja.Random(Generator));
Put_Line("Przygotowano " & Nazwa_Jedzenia(Index_Jedzenia) & " numer " & Integer'Image(Nr_Produkcji_Jedzenia));
loop
Buffer.Zamow(Index_Jedzenia, Nr_Produkcji_Jedzenia, Zatwierdzono); <-------- ERROR
if Zatwierdzono = False then
Put_Line("Brak miejsca w kuchni dla " & Nazwa_Jedzenia(Index_Jedzenia) & ". Wstrzymanie");
delay Duration(3.0);
else
Nr_Produkcji_Jedzenia := Nr_Produkcji_Jedzenia + 1;
end if;
exit;
end loop;
end loop;
end Producent;
task body Buffer is
begin
Put_Line("Jestesmy u Buffera");
loop
select
accept Zamow(Jedzenie: in Typ_Jedzenia; Numer: in Integer; Czy_Zatwierdzono: out Boolean) do
Put_Line("Trwa zamawianie...");
end Zamow;
end select;
end loop;
end Buffer;
From my attempts I understand that when I want to call entry Buffer.Zamow(Index_Jedzenia, Nr_Produkcji_Jedzenia, Zatwierdzono); (which is in task Producent) there is an error with 'Zatwierdzono' argument. When I removed this argument from declarations and definitions Zamow() entry worked.
Full error: invalid use of subtype mark in expression or call
What should I change or where is the problem with this boolean Zatwierdzono variable?
Zatwierdzono means Accepted in this case.
Thanks for any ideas.
You have two problems:
Index_Jedzenia := Jedzenie;
In your Start entry is trying to implicitly convert Jedzenie from its type, Typ_Jedzenia, to Integer, the type of Index_Jedzenia. You need some way to convert this.
Additionally on the line you are seeing the error on, the first parameter of that entry is of type Typ_Jedzenia but you are passing in an Integer (Index_Jedzenia is an integer). Again, you can't implicitly convert types like that.
If Typ_Jedzenia is actually an integer, you can explicitly convert them. Otherwise you need to make a conversion function of some type and use that before passing in or assigning to different types.
I'm currently learning Ada during a university course on real-time programming languages and have a question about SPARK.
I'm working on a project with a task that monitors an off-grid power supply. This task is crucial for machine safety and should therefore be as error free as possible, say proven with SPARK. I was able to get a few things running with other questions on stackoverflow but I still run into errors that I was not able to fix with quick searches in the user guide.
The error is call to a volatile function in interfering context is not allowed in SPARK with reference to the line if monitoring_interface.is_all_config_set then ... in
task body monitoring_task is
next_time : Time;
begin
-- Initialisation of next execution time
next_time := Clock;
-- Superloop
loop
Put_Line ("Run task monitoring");
-- Load monitor configuration
monitor_pfc_voltage.config := monitoring_interface.get_monitor_pfc_voltage_config;
monitor_pfc_current.config := monitoring_interface.get_monitor_pfc_current_config;
monitor_output_voltage.config := monitoring_interface.get_monitor_output_voltage_config;
monitor_output_current.config := monitoring_interface.get_monitor_output_current_config;
-- Check if module has been configured correctly
-- Don't do anything otherwise
if monitoring_interface.is_all_config_set then -- <= erroneous line
do_monitoring;
end if;
next_time := next_time + TASK_PERIOD;
delay until next_time;
end loop;
end monitoring_task;
The function is_all_config_set is defined within a protected type that I use for inter task communication.
package PSU_Monitoring is
... Declaration of some types (Monitor_Config_T) ...
protected type Monitoring_Interface_T is
function is_all_config_set return Boolean;
procedure set_monitor_pfc_voltage_config (new_monitor_config : in Monitor_Config_T);
function get_monitor_pfc_voltage_config return Monitor_Config_T;
procedure set_monitor_pfc_current_config (new_monitor_config : in Monitor_Config_T);
function get_monitor_pfc_current_config return Monitor_Config_T;
procedure set_monitor_output_voltage_config (new_monitor_config : in Monitor_Config_T);
function get_monitor_output_voltage_config return Monitor_Config_T;
procedure set_monitor_output_current_config (new_monitor_config : in Monitor_Config_T);
function get_monitor_output_current_config return Monitor_Config_T;
private
-- Configuration for PFC intermediate voltage
monitor_pfc_voltage_config : Monitor_Config_T;
monitor_pfc_voltage_config_set : Boolean := False;
-- Configuration for PFC inductor current
monitor_pfc_current_config : Monitor_Config_T;
monitor_pfc_current_config_set : Boolean := False;
-- Configuration for output voltage
monitor_output_voltage_config : Monitor_Config_T;
monitor_output_voltage_config_set : Boolean := False;
-- Configuration for output inductor current
monitor_output_current_config : Monitor_Config_T;
monitor_output_current_config_set : Boolean := False;
end Monitoring_Interface_T;
monitoring_interface : Monitoring_Interface_T;
private
... Declaration of a task and some private constants and subprograms ...
end PSU_Monitoring
The respective body is
package body PSU_Monitoring is
protected body Monitoring_Interface_T is
function is_all_config_set return Boolean is
begin
return monitor_pfc_voltage_config_set and monitor_pfc_current_config_set and monitor_output_voltage_config_set and monitor_output_current_config_set;
end is_all_config_set;
procedure set_monitor_pfc_voltage_config (new_monitor_config : in Monitor_Config_T) is
begin
monitor_pfc_voltage_config := new_monitor_config;
monitor_pfc_voltage_config_set := True;
end set_monitor_pfc_voltage_config;
function get_monitor_pfc_voltage_config return Monitor_Config_T is
begin
return monitor_pfc_voltage_config;
end get_monitor_pfc_voltage_config;
procedure set_monitor_pfc_current_config (new_monitor_config : in Monitor_Config_T) is
begin
monitor_pfc_current_config := new_monitor_config;
monitor_pfc_current_config_set := True;
end set_monitor_pfc_current_config;
function get_monitor_pfc_current_config return Monitor_Config_T is
begin
return monitor_pfc_current_config;
end get_monitor_pfc_current_config;
procedure set_monitor_output_voltage_config (new_monitor_config : in Monitor_Config_T) is
begin
monitor_output_voltage_config := new_monitor_config;
monitor_output_voltage_config_set := True;
end set_monitor_output_voltage_config;
function get_monitor_output_voltage_config return Monitor_Config_T is
begin
return monitor_output_voltage_config;
end get_monitor_output_voltage_config;
procedure set_monitor_output_current_config (new_monitor_config : in Monitor_Config_T) is
begin
monitor_output_current_config := new_monitor_config;
monitor_output_current_config_set := True;
end set_monitor_output_current_config;
function get_monitor_output_current_config return Monitor_Config_T is
begin
return monitor_output_current_config;
end get_monitor_output_current_config;
end Monitoring_Interface_T;
... Definition of the remaining subprograms defined in the specification file ...
end PSU_Monitoring;
What is the problem here?
As Jeffrey was saying, we need to see the part of the program where the error is flagged. In general, this is related to functions with side effects, see reference manual:
http://docs.adacore.com/spark2014-docs/html/lrm/packages.html#external-state-variables
The same error message can be observed if you use the Clock function from the Real-Time package in the "wrong" way:
with Ada.Real_Time; use Ada.Real_Time;
with Ada.Text_IO; use Ada.Text_IO;
procedure Main with SPARK_Mode is
Last : Time := Clock;
begin
-- some stuff happening here ...
if Clock > Last + Milliseconds(100) then
Put_Line("Too late");
end if;
end Main;
Clock is a function that has side effects (it returns different values every time you call it), and in this example the function is used in what's called an "interfering context" (see link above for a definition).
The solution would be to rewrite your code slightly:
with Ada.Real_Time; use Ada.Real_Time;
with Ada.Text_IO; use Ada.Text_IO;
procedure Main with SPARK_Mode is
Last : Time := Clock;
begin
-- some code
declare
now : Time := Clock;
begin
if now > Last + Milliseconds(100) then
Put_Line("Too late");
end if;
end;
end Main;
So, basically, what you do is isolate calls to functions with side effects into a separate statement, saving the result in a variable, and then use the variable where you had your call before. This trick should help with your call to the protected object, as well.
If an assertion fails, I get the following output:
raised SYSTEM.ASSERTIONS.ASSERT_FAILURE : Dynamic_Predicate failed at file.adb:36
Can I get any more details? For example what the input was, or maybe a stack trace, or anything else that might help me in determining why the assertion failed?
You may catch System.Assertions.Assert_Failure to print stack trace using GNAT.Traceback (if you use GNAT) package or print values.
Something like here
pragma Assertion_Policy(CHECK);
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Traceback;
with System.Assertions;
with GNAT.Traceback.Symbolic;
procedure Main is
procedure Call_Stack is
Trace : GNAT.Traceback.Tracebacks_Array (1..1_000);
Length : Natural;
begin
GNAT.Traceback.Call_Chain (Trace, Length);
Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (Trace (1..Length)));
end Call_Stack;
type Day is new String (1 .. 10);
type Message is record
Sent : Day;
Received : Day;
end record with
Dynamic_Predicate => Message.Sent <= Message.Received;
M : Message;
begin
M := (Received => "1776-07-04", Sent => "1783-09-03");
exception
when System.Assertions.Assert_Failure =>
Call_Stack;
Put_Line(String(M.Sent));
Put_Line(String(M.Received));
end Main;
Or you may debug your program as I mentioned in comment
I am trying to define the PL/SQL function
CREATE OR REPLACE FUNCTION B2BOWNER.F_SSC_Page_Map_Select(
p_page_id IN B2BOWNER.SSC_Page_Map.PAGE_ID_NBR%TYPE,
p_page_type IN B2BOWNER.SSC_Page_Map.PAGE_TYPE%TYPE,
p_page_dcpn IN B2BOWNER.SSC_Page_Map.PAGE_DCPN%TYPE)
RETURN MAP_REC
AS
CURSOR MAP_CURSOR IS
SELECT *
FROM B2BOWNER.SSC_PAGE_MAP
WHERE PAGE_ID_NBR = p_page_id AND PAGE_TYPE = p_page_type;
MAP_REC MAP_CURSOR%ROWTYPE;
TABLE_DOES_NOT_EXIST exception;
PRAGMA EXCEPTION_INIT(TABLE_DOES_NOT_EXIST, -942); -- ORA-00942
BEGIN
FOR MAP_REC IN MAP_CURSOR
LOOP
System.out.println("ID: " + MAP_REC.PAGE_ID_NBR + " " + "TYPE: " + MAP_REC.PAGE_TYPE + " " + "DCPN: " + MAP_REC.PAGE_DCPN);
END LOOP;
RETURN MAP_REC;
EXCEPTION
WHEN TABLE_DOES_NOT_EXIST THEN
RETURN -1;
WHEN DUP_VAL_ON_INDEX THEN
RETURN -2;
WHEN INVALID_NUMBER THEN
RETURN -3;
WHEN OTHERS THEN
RETURN -4;
END F_SSC_Page_Map_Select;
SHOW ERRORS PROCEDURE B2BOWNER.F_SSC_Page_Map_Select;
GRANT EXECUTE ON B2BOWNER.F_SSC_Page_Map_Select TO B2B_USER_DBROLE;
and receive the following error
Warning: compiled but with compilation errors
No errors.
Grant complete.
[Warning] ORA-24344: success with compilation error
6/12 PLS-00320: the declaration of the type of this expression is incomplete or malformed
PL/SQL: Compilation unit analysis terminated
(1: 0): Warning: compiled but with compilation errors
A few things. First, the MAP_REC declared in the declaration section is not the same as the MAP_REC used in the cursor FOR loop. This was certainly surprising to me when I first encountered it but it's something we all have to get used to. To do what you're trying to do you'll need to either use the OPEN, FETCH, and CLOSE method of working with a cursor, or else copy the values from the cursor FOR loop variable to the 'declared' variable.
Secondly, you can't return a MAP_REC from this function as MAP_REC is declared inside the function and thus isn't known to the compiler when it processes the function definition. Best to use the specific table ROWTYPE.
Third, later in the code you have RETURN -1, etc, which won't work as a cursor %ROWTYPE variable. I suggest that instead of trying to return 'magic number' values to indicate specific failures you should simply let the exceptions propagate to the caller, who can then handle the exceptions as needed. That's why we have exceptions - to prevent having different error handling schemes for every single subroutine out there.
And finally: this is PL/SQL - we don't System.out.println here. :-)
A possible way to rewrite your code would be:
CREATE OR REPLACE FUNCTION B2BOWNER.F_SSC_Page_Map_Select(
p_page_id IN B2BOWNER.SSC_Page_Map.PAGE_ID_NBR%TYPE,
p_page_type IN B2BOWNER.SSC_Page_Map.PAGE_TYPE%TYPE,
p_page_dcpn IN B2BOWNER.SSC_Page_Map.PAGE_DCPN%TYPE)
RETURN B2BOWNER.SSC_PAGE_MAP%ROWTYPE
AS
CURSOR MAP_CURSOR IS
SELECT *
FROM B2BOWNER.SSC_PAGE_MAP
WHERE PAGE_ID_NBR = p_page_id AND
PAGE_TYPE = p_page_type;
MAP_REC B2BOWNER.SSC_PAGE_MAP%ROWTYPE;
bCursor_open BOOLEAN := FALSE;
BEGIN
OPEN MAP_CURSOR;
bCursor_open := TRUE;
LOOP
FETCH MAP_CURSOR
INTO MAP_REC;
EXIT WHEN MAP_CURSOR%NOT_FOUND;
DBMS_OUTPUT.PUT_LINE('ID: ' || MAP_REC.PAGE_ID_NBR || ' ' || 'TYPE: ' ||
MAP_REC.PAGE_TYPE || ' ' || 'DCPN: ' || MAP_REC.PAGE_DCPN);
END LOOP;
CLOSE MAP_CURSOR;
bCursor_open := FALSE;
RETURN MAP_REC;
EXCEPTION
WHEN OTHERS THEN
DBMS_OUTPUT.PUT_LINE('Error in F_SSC_Page_Map_Select: ' || SQLCODE || ' ' ||
SQLERRM);
IF bCursor_open THEN
CLOSE MAP_CURSOR;
END IF;
RAISE;
END F_SSC_Page_Map_Select;
Best of luck.
Share and enjoy.