How to rename an Ada constant defined in the private part - constants

I want to rename a constant in the public part of a package (the original name is deprecated) that is defined in the private part. I tried this but GNAT says:
full constant declaration appears too late
package Sample is
type The_Type is private;
My_Constant : constant The_Type;
My_Renamed_Constant : The_Type;
private
type The_Type is ...;
My_Constant : constant The_Type := ...;
My_Renamed_Constant : The_Type renames My_Constant;
end Sample;

Is there a reason you want a rename instead of (say)
function My_Renamed_Constant return The_Type;
which simply returns My_Constant in the package body?
Functionally identical... and should inline if you're worried about speed.
Later in the deprecation process, make My_Renamed_Constant the constant and My_Constant the function instead. Then, when you think you're ready to retire it, have function My_Constant raise Program_Error or a custom exception indicating "using deprecated constant" to catch any usage you missed.

You probably don’t need to use a renaming; would this do? (this may depend on exactly what the full declaration of The_Type is in your case)
package Sample is
type The_Type is private;
My_Constant : constant The_Type;
My_Renamed_Constant : constant The_Type;
private
type The_Type is new Integer;
My_Constant : constant The_Type := 42;
My_Renamed_Constant : constant The_Type := My_Constant;
end Sample;

Related

Delphi AV when using TStringList in a custom class

In Delphi Rio, I have created a class whose purpose is to read a record from a database. This record is purely read only, and after reading, I need to derive some additional properties. My problem has to do with a Stringlist I am wanting to use in my class definition. I have a private class member called fVENDORS_TO_COLORCODE. This is a comma separated string. I am wanting to make a property that is a TStringlist. I am using TStringList.CommaToText to load my value into the Tstringlist. I do this in the Create Constructor. The issue I am having is that while the StringList is valid in the constructor, it is nil outside of the constructor, and I don't know what I am doing wrong. Here is the relevant portions of code.
type
TProfileDef = class(TObject)
private
fNAME: String;
fVENDORS_TO_COLORCODE: String; // incoming comma separated string. Example string: Microsoft,IBM
fVENDORS_TO_COLORCODE_SL : TStringList;
..
public
constructor Create(ProfileName: String);
destructor Destroy; override;
published
property NAME: String read fNAME;
property VENDORS_TO_COLORCODE: String read fVENDORS_TO_COLORCODE;
property VENDORS_TO_COLORCODE_SL : TStringList read fVENDORS_TO_COLORCODE_SL;
..
end;
implementation
destructor TProfileDef.Destroy;
begin
inherited;
fVENDORS_TO_COLORCODE_SL.Free;
end;
constructor TProfileDef.Create(ProfileName: String);
var
fVENDORS_SL: TStringList;
fVENDORS_TO_COLORCODE_SL: TStringList;
TempVendorList : String;
begin
inherited Create;
fName := ProfileName;
.. [Find my record based on ProfileName, and load the DB columns into the private variables]..
// Load the Color Code String into a StringList;
fVENDORS_TO_COLORCODE_SL := TStringList.Create;
fVENDORS_TO_COLORCODE_SL.CommaToText := fVENDORS_TO_COLORCODE;
end;
Within the Constructor, the fVENDORS_TO_COLORCODE_SL stringlist is created, and data is added...
The issue is when I try to use it...
var
TestClass: TProfileDef;
begin
TestClass := TProfileDef.Create('Sample Profile');
// TestClass.Name is valid
// TestClass.VENDORS_TO_COLORCODE_SL is nil, and trying to access gives AV
Somehow I am defining this wrong, but I can't determine what it is is, in order to correct it.
Your class has a private field
fVENDORS_TO_COLORCODE_SL: TStringList;
Your constructor should create a TStringList object and have this variable point to it. I assume that is your intention, at least. However, your constructor has a local variable with the same name, fVENDORS_TO_COLORCODE_SL, so the line
fVENDORS_TO_COLORCODE_SL := TStringList.Create;
indeed creates a TStringList object, but the pointer is saved to this local variable, and the class's field with the same name remains nil.
Solution: Remove the declaration of the local variable in the constructor.
// Load the Color Code String into a StringList;
fVENDORS_TO_COLORCODE_SL := TStringList.Create;
This line here in the constructor is the problem. You have two variables named fVENDORS_TO_COLORCODE_SL. One is a private member of the class declared in the private section of th class declaration, the other is a local variable declared in the var section of the constructor.
Guess which one takes precedence. That's right, the local variable in the constructor. That line initialized the local variable named fVENDORS_TO_COLORCODE_SL, the private class member with the same name is still nil.
As a general rule I preface local variables in a method with an l and only preface class members with an f to avoid just this sort of problem.
Rename your local variables in the constructor like so:
constructor TProfileDef.Create(ProfileName: String);
var
lVENDORS_SL: TStringList;
lVENDORS_TO_COLORCODE_SL: TStringList;
lTempVendorList : String;
begin
Then update your code and rebuild. Things should start to become obvious pretty quickly.

What are the semantics of input variables passed by reference?

Beckhoff's TwinCat-3, as well as Codesys 3 it's based on, adds references as an extension to IEC-61131-3 languages. I'm wondering what is the exact grammar and semantics of this non-standard addition (that's the problem with them: nobody bothers documenting them as well as a standard would).
It the following F_IsNonEmpty function valid and doing what one would expect, when invoked from the F_Test test function below?
FUNCTION F_IsNonEmpty : BOOL
VAR_INPUT
text : REFERENCE TO STRING;
END_VAR
F_IsNonEmpty := LEN(text) > 0;
END_FUNCTION
FUNCTION F_Test1
VAR
testMessage : STRING := '123';
END_VAR
IF F_IsNonEmpty(text := testMessage) THEN
{...}
END_IF
END_FUNCTION
Given that the target of the reference must be initialized using the REF= operator (v.s. e.g. C++ where reference targets are immutable), I'd have expected that the following invoking code would be correct instead - but it doesn't even compile:
FUNCTION F_Test2
VAR
testMessage : STRING := '123';
END_VAR
IF F_IsNonEmpty(text REF= testMessage) THEN
{...}
END_IF
END_FUNCTION
It seems that F_Test1 works correctly, but I'd like someone who actually uses Codesys 3 or TwinCat-3 REFERENCE TO feature to confirm.
When you use a REFERENCE in a VAR_INPUT, it's as if you were using a VAR_IN_OUT variable.
Otherwise if you declare your REFERENCE in the VAR section, you need to use REF= when assigning another variable to it (or get an exception).
In essence, REFERENCE (like a VAR_IN_OUT var) is a more convenient and "safe" pointer because the dereference operator ^ is not needed and because the type is checked at compile time.

Ada Access to parameterless procedure "wrong convention"

I have the following binding:
function atexit(proc : access Procedure) return Integer with
Import, Convention => C;
As well as the procedure:
procedure Exiting is
begin
Put_Line("Exiting");
end Exiting;
When I try to call it like:
I : Integer := atexit(Exiting'Access);
it fails with subprogram "Exited" has wrong convention
however providing my own (incompatable) atexit which accepts a parameter, and modifying Exiting to use that same parameter, allows passing the procedure just fine.
So it seems like the issue is passing a parameterless procedure as an access type.
I've tried giving a named access type like
type Procedure_Access is access Procedure;
But the result is exactly the same.
How can I pass a parameterless procedure then?
You might have forgotten the Convention aspects in the declarations of Exiting and Procedure_Access. The following works in GNAT CE 2018:
foo.c
int _atexit(void (*f)(void))
{
(*f)();
return 0;
}
main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces.C; use Interfaces.C;
procedure Main is
type proc_ptr is access procedure
with Convention => C;
function atexit(proc : proc_ptr) return int
with Import, Convention => C, Link_Name => "_atexit";
procedure Exiting
with Convention => C;
procedure Exiting is
begin
Put_Line("Exiting");
end Exiting;
I : Integer := Integer (atexit (Exiting'Access));
begin
Put_Line("atexit returned " & I'Image);
end Main;
default.gpr
project Default is
for Source_Dirs use ("src");
for Object_Dir use "obj";
for Main use ("main.adb");
for Languages use ("Ada", "C");
end Default;
output
Exiting
atexit returned 0

What is the best way for implementing something similar to an interface with Ada 95?

I want to implement something similar to an interface using Ada 95 (so the typical OO interfaces are not available). I've done it by using generics and a set of "pointer to method" within a record. The code is below.
EDIT: I know that it can be done by passing subprograms as formal parameters to the generic package, but I would like to avoid passing too many parameters to it.
I think that there must be a much better way for implementing what I want, so I would like if I'm right and, if so, I would like to see an example of code.
The "interface" is declared in a generic package called Drivers. There, there is a record which is meant to contain a variable of a generic type that represents the driver and a record which contains its operations:
drivers.ads
generic
type T is private;
type Error is private;
NOT_IMPLEMENTED_CODE : Error;
package Drivers is
type Driver is private;
-- Need to declare these types because I compile with Ada 95.
type ToStringPtr is access function(self : in T) return String;
type ReadLinePtr is access procedure(self : in T; buffer : out String; err : out Error);
type DriverOps is
record
to_string_op : ToStringPtr := null;
read_line_op : ReadLinePtr := null;
end record;
function create_driver(underlying : T; ops : DriverOps) return Driver;
function to_string(self : in Driver) return String;
procedure read_line(self : in Driver; buffer : out String; err : out Error);
private
type Driver is
record
underlying : T;
ops : DriverOps;
end record;
end Drivers;
drivers.adb
package body Drivers is
function create_driver(underlying : T; ops : DriverOps) return Driver is
begin
return (underlying, ops);
end create_driver;
function to_string(self : in Driver) return String is
begin
if self.ops.to_string_op /= null then
return self.ops.to_string_op(self.underlying);
else
return "";
end if;
end to_string;
procedure read_line(self : in Driver; buffer : out String; err : out Error) is
begin
if self.ops.read_line_op /= null then
self.ops.read_line_op(self.underlying, buffer, err);
else
err := NOT_IMPLEMENTED_CODE;
end if;
end read_line;
end Drivers;
main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Fixed;
with Drivers;
procedure main is
type Error is (SUCCESS, NOT_IMPLEMENTED, UNKNOWN);
type MyInt is new Integer;
function to_string(self : in MyInt) return String is
begin
return Integer'Image( Integer(self) ); --'
end to_string;
procedure read_line(self : in MyInt; buffer : out String; err : out Error) is
begin
Ada.Strings.Fixed.Move(
Target => buffer,
Source => "Lets suppose we have read this from a device" & ASCII.LF,
Pad => ASCII.NUL);
err := SUCCESS;
end read_line;
package IntDrivers is new Drivers(MyInt, Error, NOT_IMPLEMENTED);
use IntDrivers;
underlying : MyInt := 25;
int_driver_ops : DriverOps := (
to_string_op => to_string'access, --'
read_line_op => read_line'access --'
);
my_driver : Driver := create_driver(underlying, int_driver_ops);
buffer : String(1..256) := (others => Character'Val(0)); --'
err : Error := SUCCESS;
begin
Put_Line(to_string(my_driver));
read_line(my_driver, buffer, err);
Put(buffer);
Put_Line(Error'Image(err)); --'
end main;
The only one I known of is described below, and may not be canonical. This is not strictly interface inheritance, but it can put you in the right direction.
It requires to use a discriminant tagged record.
The trick is to define 2 tagged types. One is your classic class definition, the other is used as "interface" inheritance.
You can then manipulate an object that gives access to the interface contract and the class contract using discriminants. Declaring both in the same package should give you full visibility over private parts, to be confirmed.
In short :
type InterfaceX is abstract ....; -- abstract class and services
type ClassA is tagged ...; -- or is new ....
type Trick (component : ClassA) is new InterfaceX ...; -- this type gives you access to classA and interfaceX primitives
Trick object realizes your InterfaceX contract.
You will have to define instantiaton/accessors to either ClassA object or the Trick object. I think types should also be limited.
I always hear people call this "Rosen trick", guess it is named after J.-P. Rosen.
Maybe you will find some more precise answers here http://www.adaic.org/resources/add_content/standards/95rat/rat95html/rat95-p2-4.html#6
An interface is an abstract tagged null record in Ada 95:
package Abstract_Driver is
type Instance is abstract tagged null record;
subtype Class is Instance'Class; --' (defect syntax highlighter)
function Image (Item : in Instance) return String is abstract;
procedure Read_Line (Item : in out Instance;
Buffer : out String) is abstract;
end Abstract_Driver;
with Abstract_Driver;
package Text_IO_Driver is
subtype Parent is Abstract_Driver.Instance;
type Instance is new Parent with private;
subtype Class is Instance'Class; --' (defect syntax highlighter)
function Image (Item : in Instance) return String;
Buffer_Too_Small : exception;
procedure Read_Line (Item : in out Instance;
Buffer : out String);
private
type Instance is new Parent with null record;
end Text_IO_Driver;
with Ada.Text_IO;
package body Text_IO_Driver is
function Image (Item : in Instance) return String is
begin
return "Ada.Text_IO.Standard_Input";
end Image;
procedure Read_Line (Item : in out Instance;
Buffer : out String) is
Last : Natural;
begin
Buffer := (Buffer'Range => ' '); --' (defect syntax highlighter)
Ada.Text_IO.Get_Line (Item => Buffer,
Last => Last);
if Last = Buffer'Last then --' (defect syntax highlighter)
raise Buffer_Too_Small;
end if;
end Read_Line;
end Text_IO_Driver;

Error When Editing Member Variable in Class

I'm trying to use a class in my program.
TStack = Class
Public
constructor Create; Overload;
Procedure Add(Frm:TForm);
Procedure Remove();
Procedure Do_Close;
Private
List : Array[1..Max_Forms] of Rec;
Count : Byte;
End;
Constructor:
constructor TStack.Create;
begin
Self.Count := 0;
end;
Procedure TStack.Add(Frm:TForm);
begin
Inc(Self.Count);
List[Count].Form := #Frm;
List[Count].Width := Frm.Width;
List[Count].Height := Frm.Height;
List[Count].left := Frm.Left;
List[Count].Top := Frm.Top;
end;
I can't change value of Count variable! It cause Run-Time error : Access violation....Write of address 000001E4
What's the problem?!
FOR MORE INFORMATION:
I'm trying to store a pointer to each form in a structure like this :
Rec = Record
Form : ^TForm;
Maximized : Boolean;
Width,
Height,
left,
Top : Integer;
End;
And then
Procedure TStack.Do_Close;
var
i : integer;
MyForm : TForm;
begin
i := .....some code here.......;
MyForm := #List[i].Form;
ShowMessage('I will close '+MyForm.Caption);
MyForm.Close;
end;
AND call constructor like this to initialize 'Count':
Stack.Create;
As described in comments you are attempting to create the object like this:
var
Stack: TStack;
....
Stack.Create;
This is a classic mistake, and one that we've all made. You are calling a method on an uninitialized instance variable.
In order to instantiate a class you need to write this:
Stack := TStack.Create;
On top of that I have the following comments:
Use zero-based indexing for arrays. That's the convention everywhere in Delphi apart from anachronistic strings. And even that is changing in newer versions.
Don't use static arrays for a stack unless you have a good reason for doing so. You'll just run the risk of running out of space. Or allocating more memory than you need. Use a dynamic array.
Rather than a dynamic array, you could use TList<T>.
Even so, one wonders why you are making your own stack class when there is the perfectly good TStack<T>.
You store the address of a local variable in your stack. In TStack.Add you add #Frm into the container. As soon as TStack.Add returns, #Frm is meaningless. That's because Frm is a local variable whose life ends when the function that owns it returns. I think you want to take a copy of Frm.
Picking up item 5 in more detail, your record is declared like this:
Rec = Record
Form : ^TForm;
Maximized : Boolean;
Width,
Height,
left,
Top : Integer;
End;
It is a mistake to use ^TForm. That is a pointer to a variable holding a pointer to an object. That's two levels of indirection, one too many. You must declare the Form field to be of type TForm. I suggest you revise the way Delphi object reference variables work. Delphi classes are what is known as reference types. A variable of type TMyClass where TMyClass is class(...) is already a pointer. The language automatically de-references the pointer when you use the . operator to access members.