Ada95 Traceback function produces no output - ada

Using GNATMAKE 3.13a1 (20000509), the following function seems to produce no result. That is the log messages are never written to the log, nor is the stack-trace logged.
The surrounding logs, perform normally.
procedure log_Stack_Trace( label : in String;
memo : in String := "" )
is
length : Natural := 16;
trace : GNAT.Traceback.Tracebacks_Array( 1..length );
begin
trace_Debug( "--- Stacktrace [" & label & "] ---" );
if ( "" /= memo )
then
trace_Debug( "---" & memo );
end if;
GNAT.Traceback.Call_Chain( trace, length );
trace_Debug( GNAT.Traceback.Symbolic.Symbolic_Traceback( trace( 1..length ) ) );
end log_Stack_Trace;
Calling this procedure like ~
trace_Debug( "Before stack-trace" );
log_Stack_Trace( "HELLOOOO?" );
trace_Debug( "After stack-trace" );
Only gives me the log-output:
Before stack-trace
After stack-trace
The --- Stacktrace [ ... ] --- heading message (etc.) is never logged.
Is there something peculiar to GNat / Ada95 causing this? Do I have to actually have an exception to get a stack-trace (or suchlike?).

Related

Catch Precondition Assert_Failure

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;
--...

Why is my Ada program not outputting correctly?

Let me start by saying this is the first ada program I have ever created. I have no idea how it works, and my assignment is incredibly simple. However, the output is not working correctly. It works with the first variable, but not with the next two. It also prints the first variable weird. Here is my code:
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
Author, Title, Pages: String := " ";
begin
Put("Enter Author: ");
Get(Author);
Put("Enter Title: ");
Get(Title);
Put("Enter number of pages: ");
Get(Pages);
Put("Author: ");
Put(Author);
New_Line;
Put("Title: ");
Put(Title);
New_Line;
Put("Number of pages: ");
Put(Pages);
end Main;
The goal is simply to enter information about a book and the program reads it out to you. This is the output:
Enter Author: john
Enter Title: Enter number of pages: Author: j
Title: o
Number of pages: h
Side note, I couldn't get page numbers to work as an integer. The get and put methods just gave errors. That isn't important but if anyone can help make that an integer I would appreciate it.
Here's a possible solution:
with Ada.Text_IO;
procedure Text_Input is
type Page_Count is range 1 .. 10_000;
package Page_Count_Text_IO is new Ada.Text_IO.Integer_IO (Page_Count);
function Get_Line (Message : in String) return String;
function Get_Line (Message : in String) return Page_Count;
function Get_Line (Message : in String) return String is
begin
Ada.Text_IO.Put (Message);
return Ada.Text_IO.Get_Line;
end Get_Line;
function Get_Line (Message : in String) return Page_Count is
begin
return Result : Page_Count do
Ada.Text_IO.Put (Message);
Page_Count_Text_IO.Get (Result);
if Ada.Text_IO.Get_Line /= "" then
raise Constraint_Error
with "Page count followed by extra characters.";
end if;
end return;
end Get_Line;
Author : constant String := Get_Line ("Enter author: ");
Title : constant String := Get_Line ("Enter title: ");
Pages : constant Page_Count := Get_Line ("Enter number of pages: ");
begin
Ada.Text_IO.Put_Line ("Author: " & Author);
Ada.Text_IO.Put_Line ("Title: " & Title);
Ada.Text_IO.Put_Line ("Number of pages:" & Page_Count'Image (Pages));
end Text_Input;
Notice that I've made the Get_Line function for Page_Count check that you don't have any trailing garbage on the line, where you enter the number of pages.
I hope you don't disagree with my estimate that John will never write a single book of more than 10'000 pages. :-)

Determining why an Ada assertion failed

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

How to use refs to constant Strings in arrays and records?

I am planning to convert some programs written in C/C++ to Ada.
These make heavy use of constant char literals often as ragged arrays like:
const char * stringsA = { "Up", "Down", "Shutdown" };
or string references in records like:
typedef struct
{
int something;
const char * regexp;
const char * errormsg
} ERRORDESCR;
ERRORDESCR edscrs [ ] =
{
{ 1, "regexpression1", "Invalid char in person name" },
{ 2, "regexp2", "bad bad" }
};
The presets are calculated by the C/C++ compiler and I want the Ada compiler to be
able to do that too.
I used Google and searched for ragged arrays but could only find two ways of
presetting the strings. One in Rationale for Ada 95 by John Barnes and another
at http://computer-programming-forum.com/44-ada/d4767ad6125feac7.htm.
These are shown as stringsA and stringsB below.
StringsA is defined in two stages, which is a bit tedious if there are hundreds
of strings to set up. StringsB uses one step only, but is compiler dependent.
Question 1: are there other ways?
Question 2: would the second stringsB work with GNAT Ada?
I have not started converting. The packages below are just for experimenting
and teaching myself...
package ragged is
type String_ptr is access constant String;
procedure mydummy;
end ragged;
package body ragged is
s1: aliased constant String := "Up";
s2: aliased constant String := "Down";
s3: aliased constant String := "Shutdown";
stringsA: array (1 .. 3) of String_ptr :=
(s1'Access, s2'Access, s3'Access); -- works
stringsB: array (1 .. 3) of String_ptr :=
(new String'("Up"), new String'("Down"),
new String'("Shutdown")); -- may work, compiler-dependent
-- this would be convenient and clear...
--stringsC: array (1 .. 3) of String_ptr :=
-- ("Up", "Down", "Shutdown"); -- BUT Error, expected String_ptr values
--stringsD: array (1 .. 3) of String_ptr :=
--("Up"'Access, "Down"'Access, "Shutdown"'Access); --Error - bad Access use
--stringsE: array (1 .. 3) of String_ptr :=
--(String_ptr("Up"), String_ptr("Down"),
-- String_ptr("Shutdown")); -- Error, invalid conversion
procedure mydummy is
begin
null;
end;
end ragged;
A little judicious operator overloading can do this in a less cluttered manner:
(Within the package body)
function New_String(S : String) return String_Ptr is
begin
return new String'(S);
end New_String;
function "+" (S : String) return String_Ptr renames New_String;
Now you can do:
stringsC: array (1 .. 3) of String_ptr := (+"Up", +"Down", +"Shutdown");
Not enough space in comment for this
Test program
package raggedtest is
type String_ptr is access constant String;
procedure mytest;
end raggedtest;
with ada.text_IO; use Ada.Text_IO;
package body raggedtest is
s1: aliased constant String := "Up";
s2: aliased constant String := "Down";
s3: aliased constant String := "Shutdown";
stringsA: array (1 .. 3) of String_ptr :=
(s1'Access, s2'Access, s3'Access);
stringsB: array (1 .. 3) of String_ptr :=
(new String'("UpB"), new String'("DownB"),
new String'("ShutdownB"));
function New_String(S : String) return String_Ptr is
begin
return new String'(S);
end New_String;
function "+" (S : String) return String_Ptr renames New_String;
stringsC: array (1 .. 3) of String_ptr := (+"UpC", +"DownC", +"ShutdownC");
procedure mytest is
begin
put ( "s1A: " ); put( stringsA(1).all ); New_line;
put ( "s2A " ); put( stringsA(2).all ); New_line;
put ( "s3A: " ); put( stringsA(3).all ); New_line;
put ( "s1B: " ); put( stringsB(1).all ); New_line;
put ( "s2B " ); put( stringsB(2).all ); New_line;
put ( "s3B: " ); put( stringsB(3).all ); New_line;
put ( "s1C: " ); put( stringsC(1).all ); New_line;
put ( "s2C " ); put( stringsC(2).all ); New_line;
put ( "s3C: " ); put( stringsC(3).all ); New_line;
end;
end raggedtest;
with raggedtest; use raggedtest;
procedure main is
begin
mytest;
end main;

Function reading from standard input without any "in" parameters

Perhaps this is simple, and I am just missing some basic information, but I can't seem to find the answer anywhere.
I'm writing a Get_Word function for class, here is the relevant section of the spec file my prof wrote:
function Get_Word return Ustring;
-- return a space-separated word from standard input
procedure Fill_Word_List(Wl : in out Ustring_Vector);
-- read a text file from standard in and add all
-- space-separated words to the word list wl
I've written the Get_Word function, and am trying to test it out with this code:
with Ada.Text_IO; use Ada.Text_Io;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure ngramtest is
Name : String(1..80);
File : File_Type;
Size : Natural;
function Get_Word return String is
-- I'm using a strings instead of Unbounded_Strings for testing purposes.
Word : String(1..80) := (others => ' ');
Char : Character;
File : File_Type;
Eol : Boolean;
I : Integer := 1;
begin
--this code below, when uncommented reveals whether or not the file is open.
--if Is_Open(File) then
-- Word := (1..80 => 'y');
--else
-- Word := (1..80 => 'n');
--end if;
loop
Look_Ahead(File, Char, Eol);
if Eol then
exit;
elsif Char = ' ' then
exit;
else
Get (File, Char);
Word(I) := Char;
I := I + 1;
end if;
end loop;
return Word(1..Word'Last);
end Get_Word;
begin
Put ("Enter filename: ");
Get_Line (Name, Size);
Open (File, Mode => In_File, Name => Name(1..Size));
Put (Get_Word);
Close(File);
end ngramtest;
It compiles, but at runtime I get an exception telling me that the file isn't open, and the commented out section returns "nnnnnn..." meaning that the file is not open within the function.
My question is how am I to read from standard input if i'm not allowed to use in parameters in my function? Without them the function won't be able to access files.
Essentially, how can I "Get_Word"?
Sorry if this is simple, but I'm completely lost.
You need to set your "File" variable to standard input:
File : File_Type := Ada.Text_IO.Standard_Input;

Resources