what is the main Difference between out mode and in out mode? - ada

Difference between out mode and in out mode? As far i have collected the info is
the main difference i know is that in both out and in out mode the actual parameter is expected to be altered even writing and reading is also possible then what is main difference please help me to understand?

The best explanation of the difference is in RM 6.4.1(11-15).
Semantically, there is a difference only for parameters that are passed by copy. If you call a subprogram that has an in out parameter, the actual parameter is expected to have a legitimate value before the call. On entry, the subprogram makes a copy of the variable and checks to make sure it satisfies the constraints.
For an out parameter, the actual parameter does not need to have a value going in; it could be uninitialized garbage. The intent is that the subprogram will not use the value of this parameter until it has been set, by the subprogram (it can be set either by assignment or by being passed as an out parameter to some other subprogram, or to a Default_Value, or perhaps by other means). This is not enforced, however.
This can cause different behavior in some cases. For example:
subtype Int10 is Integer range 1 .. 10;
procedure Proc (Param : in out Int10) is
begin
Param := 5;
end Proc;
Y : Integer := 100;
...
Proc (Y);
Since Param is an in out parameter, the constraints are checked on entry. Thus, the call to Proc(Y) raises a Constraint_Error. However:
subtype Int10 is Integer range 1 .. 10;
procedure Proc (Param : out Int10) is
begin
Param := 5;
end Proc;
Y : Integer := 100;
...
Proc (Y);
In this case, no Constraint_Error is raised. In fact, Y does not need to be initialized at all, because the expectation is that the procedure will not use the input value. According to the RM, the value is not even copied, for certain classes of parameter types. So in this case:
Save_Param : Integer;
procedure Proc (Param : out Int10) is
begin
Save_Param := Param; -- legal but not recommended
Param := 5;
end Proc;
Y : Integer := 3;
...
Proc (Y);
Save_Param will probably be set to some garbage value, not 3. (In Ada 2012, there is a Default_Value aspect that can be applied to subtypes; in a case like that, an out parameter would be set to this default value instead of uninitialized garbage, while an in out parameter would still get the value from the actual parameter.)
For parameters that are passed by reference, there really is no difference in behavior.
The rules in Ada 83 were different. A subprogram with an in out parameter could both read and write that parameter, while a subprogram with an out parameter was allowed to assign to the parameter but could not do anything that would read that parameter's value (barring some cases where there was no way around reading discriminants). Thus:
procedure Proc (Param : out Int10) is
begin
Param := 5;
Save_Param := Param; -- illegal in Ada 83, legal in Ada 95 and later versions
end Proc;
In other words, an out parameter really was output-only. The rule was relaxed in Ada 95, though, as programmers found it too restrictive.

Related

How do I enforce that a type hold only be a fixed set of non-contiguous values?

I was expecting this program to raise an error when I feed it 3 as a valid Scale value, but no such luck:
with Ada.Text_IO; use Ada.Text_IO;
procedure predicate is
type Scale is new Integer
with Dynamic_Predicate => Scale in 1 | 2 | 4 | 8;
GivesWarning : Scale := 3; -- gives warning
begin
Put_Line ("Hello World");
loop
Put_Line ("Gimme a value");
declare
AnyValue : Integer := Integer'Value (Get_Line);
S : Scale := Scale (AnyValue); -- no check done!
begin
Put_Line ("okay, that works" & S'Image);
end;
end loop;
end predicate;
I found this related question, but there the requirement is to use an enum., and the solution is to define an array from enum -> value.
I want something that gives me at least a warning at compile time, and allows me to check at runtime as well, and that raises an error if I try to put an invalid value in. Then, if I can use SPARK to prove that no invalid values can occur, I could turn off said checks. I was under the impression that this was how Static_ / Dynamic_ predicates work, so the example above took me by surprise.
You need to enable assertions. Either compile with -gnata or set an appropriate Assertion_Policy
pragma Assertion_Policy(Dynamic_Predicate => Check);

in Delphi 5, is a TList parameter always passed by reference?

I am migrating some code from Delphi 5 to a modern platform. Currently I have the compiled code (which works in my environment) and the source code (which cannot be compiled in my environment). This means I can't really experiment with the code by changing it or inserting breakpoints or dumping values. In looking at one particular passage of code, I see that one Procedure (ProcedureA) is calling another (ProcedureB) and passing in parameters that must be by reference, since otherwise ProcedureB would have no effect. It's my understanding that a var prefix must be added to parameters in a Procedure's parameter list in order for them to be passed by reference, but this is not being done here. One of the parameters, though, is of type TList, which I know to be essentially an array of pointers. My question is: are parameters of type TList (as well as others having to do with pointers) implicitly passed by reference?
Here's the code:
Procedure ProcedureB(PartyHeaderInformationPtr : PartyHeaderInformationPointer;
PartyHeaderTable : TTable;
_PrisonCode : String;
_FineType : TFineTypes;
PartyHeaderInformationList : TList);
begin
with PartyHeaderInformationPtr^, PartyHeaderTable do
begin
AssessmentYear := FieldByName('TaxRollYr').Text;
PartyType := FieldByName('PartyType').Text;
PartyNumber := FieldByName('PartyNo').AsInteger;
PrisonCode := _PrisonCode;
FineType := _FineType;
end; {with PartyHeaderInformationPtr^ ...}
PartyHeaderInformationList.Add(PartyHeaderInformationPtr);
end; {AddPartyHeaderPointerInformation}
{=================================================================}
Procedure ProcedureA(PartyHeaderTable : TTable;
PartyDetailTable : TTable;
PartyHeaderInformationList : TList);
var
Done, FirstTimeThrough : Boolean;
PrisonPartyFound, JunglePartyFound : Boolean;
PrisonPartyYear, PrisonCode, PartyType : String;
PartyHeaderInformationPtr : PartyHeaderInformationPointer;
begin
PartyHeaderTable.Last;
PrisonPartyYear := '';
PrisonPartyFound := False;
JunglePartyFound := False;
Done := False;
FirstTimeThrough := True;
repeat
If FirstTimeThrough
then FirstTimeThrough := False
else PartyHeaderTable.Prior;
If PartyHeaderTable.BOF
then Done := True;
If not Done
then
begin
PartyType := PartyHeaderTable.FieldByName('PartyType').Text;
If ((not JunglePartyFound) and
((PartyType = 'MU') or
(PartyType = 'TO')))
then
begin
JunglePartyFound := True;
New(PartyHeaderInformationPtr);
AddPartyHeaderPointerInformation(PartyHeaderInformationPtr,
PartyHeaderTable,
'', ltPlace,
PartyHeaderInformationList);
end; {If ((not JunglePartyFound) and ...}
end; {If not Done}
until Done;
end; {FillPartyHeaderInformationList}
Yes.
In Delphi, classes are reference types.
Every variable of type TBitmap, TList, TButton, TStringList, TForm etc. is nothing but a pointer to the object, so an object is always passed "by reference". It is only this address, this native-sized integer, that is given to the called routine.
Consequently, even without var, the called routine can alter the object since it, like the caller, has the address to it. But the pointer itself is passed by value, so if the called routine alters the parameter pointer to point to a different object, the caller will not see that; only the called routine's copy of the address is changed. With var, the pointer itself is passed by reference, so the called routine can change that too: it can change the original object, and it can make the caller's variable point to a different object, if it wants to.
On the other hand, value types like integers, booleans, sets, static arrays, and records are passed by value, so -- without any parameter decoration such as var -- the called routine gets a copy, and any changes made are only made to that copy. The caller will not see its variable being modified. If you use a var parameter, however, the variable will be passed by reference.
So, in your case, it has nothing to do with TList being a "list" or being something that "contains pointers". It's about TList being a class.

Passing struct/record from assembler to Ada

I'm attempting to pass a structure from (x86) assembler to Ada on the stack. I've been able to successfully use this pattern in C to accept to wrap a large number of arguments passed from assembly inside a struct and I'm wondering if this will work in a similar way in Ada.
Here is a (contrived, minimal) example:
When I do this, debugging the callee shows that the passed record contains uninitialised data. It appears that Ada is interpreting the C calling convention differently despite the export directive.
The RM contains information about passing structs from Ada to C, saying that it will automatically pass a record as a pointer type, but the inverse does not appear to be true. If you accept a single access type it will simply be filled with the first value on the stack, as one would expect from cdecl.
( Please excuse any minor errors, this isn't my actual code. )
#####################################################################
# Caller
#
# This pushes the values onto the stack and calls the Ada function
#####################################################################
.global __example_function
.type __example_function, #function
__example_function:
push $1
push $2
push $3
push $4
call accepts_struct
ret
----------------------------------------------------------------------------
-- Accepts_Struct
--
-- Purpose:
-- Attempts to accept arguments pass on the stack as a struct.
----------------------------------------------------------------------------
procedure Accepts_Struct (
Struct : Struct_Passed_On_Stack
)
with Export,
Convention => C,
External_Name => "accepts_struct";
----------------------------------------------------------------------------
-- Ideally the four variables passed on the stack would be accepted as
-- the values of this struct.
----------------------------------------------------------------------------
type Struct_Passed_On_Stack is
record
A : Unsigned_32;
B : Unsigned_32;
C : Unsigned_32;
D : Unsigned_32;
end record
with Convention => C;
On the other hand, this works just fine:
procedure Accepts_Struct (
A : Unsigned_32;
B : Unsigned_32;
C : Unsigned_32;
D : Unsigned_32
)
with Export,
Convention => C,
External_Name => "accepts_struct";
That's not a big deal in this minimal case, but if I'm passing 16 or more variables it gets a bit onerous. If you're wondering why I'm doing this, it's an exception handler where the processor automatically passes variables onto the stack to show register states.
Any help here would be greatly appreciated.
The record version does not work because a record is not stored on the stack. Instead 4 Unsigned_32 elements are stored on the stack. If you really want to work with a record instead of four separate unsigned integer values you can assign the four values to the members of your record within the call to "accepts_struct".
Ada expects the first entry in the stack to be a record, not an unsigned_32.
The Ada LRM, section 6.4.1 states:
For the evaluation of a parameter_association: The actual parameter is
first evaluated. For an access parameter, the access_definition is
elaborated, which creates the anonymous access type. For a parameter
(of any mode) that is passed by reference (see 6.2), a view conversion
of the actual parameter to the nominal subtype of the formal parameter
is evaluated, and the formal parameter denotes that conversion. For an
in or in out parameter that is passed by copy (see 6.2), the formal
parameter object is created, and the value of the actual parameter is
converted to the nominal subtype of the formal parameter and assigned
to the formal.
Furthermore, the passing mode for parameters is described in section 6.2:
6.2 Formal Parameter Modes
A parameter_specification declares a formal parameter of mode in, in
out, or out. Static Semantics
A parameter is passed either by copy or by reference. When a parameter
is passed by copy, the formal parameter denotes a separate object from
the actual parameter, and any information transfer between the two
occurs only before and after executing the subprogram. When a
parameter is passed by reference, the formal parameter denotes (a view
of) the object denoted by the actual parameter; reads and updates of
the formal parameter directly reference the actual parameter object.
A type is a by-copy type if it is an elementary type, or if it is a
descendant of a private type whose full type is a by-copy type. A
parameter of a by-copy type is passed by copy, unless the formal
parameter is explicitly aliased.
A type is a by-reference type if it is a descendant of one of the
following:
a tagged type;
a task or protected type;
an explicitly limited record type;
a composite type with a subcomponent of a by-reference type;
a private type whose full type is a by-reference type.
A parameter of a by-reference type is passed by reference, as is an
explicitly aliased parameter of any type. Each value of a by-reference
type has an associated object. For a parenthesized expression,
qualified_expression, or type_conversion, this object is the one
associated with the operand. For a conditional_expression, this object
is the one associated with the evaluated dependent_expression.
For other parameters, it is unspecified whether the parameter is
passed by copy or by reference.
It appears that your compiler is trying to pass the struct by reference rather than by copy. In C all parameters are passed by copy.
Maybe you already solved the problem, but if not, then you might also want to have at look at the interrupt function attribute provided by GCC (see here). I've translated a test of the GCC testsuite which pushes values to the stack (as described in section 6.12 of the Intel SDM) and reads them back in an ISR. The translated Ada version seems to work well. See here for the original C version. See the GCC ChangeLog for some additional info.
main.adb
with PR68037_1;
procedure Main is
begin
PR68037_1.Run;
end Main;
pr68037_1.ads
package PR68037_1 is
procedure Run;
end PR68037_1;
pr68037_1.adb
with System.Machine_Code;
with Ada.Assertions;
with Interfaces.C;
with GNAT.OS_Lib;
package body PR68037_1 is
-- Ada-like re-implementation of
-- gcc/testsuite/gcc.dg/guality/pr68037-1.c
subtype uword_t is Interfaces.C.unsigned_long; -- for x86-64
ERROR : constant uword_t := 16#1234567_0#;
IP : constant uword_t := 16#1234567_1#;
CS : constant uword_t := 16#1234567_2#;
FLAGS : constant uword_t := 16#1234567_3#;
SP : constant uword_t := 16#1234567_4#;
SS : constant uword_t := 16#1234567_5#;
type interrupt_frame is
record
ip : uword_t;
cs : uword_t;
flags : uword_t;
sp : uword_t;
ss : uword_t;
end record
with Convention => C;
procedure fn (frame : interrupt_frame; error : uword_t)
with Export, Convention => C, Link_Name => "__fn";
pragma Machine_Attribute (fn, "interrupt");
--------
-- fn --
--------
procedure fn (frame : interrupt_frame; error : uword_t) is
use Ada.Assertions;
use type uword_t;
begin
-- Using the assertion function here. In general, be careful when
-- calling subprograms from an ISR. For now it's OK as we will not
-- return from the ISR and not continue the execution of an interrupted
-- program.
Assert (frame.ip = IP , "Mismatch IP");
Assert (frame.cs = CS , "Mismatch CS");
Assert (frame.flags = FLAGS, "Mismatch FLAGS");
Assert (frame.sp = SP , "Mismatch SP");
Assert (frame.ss = SS , "Mismatch SS");
-- At the end of this function IRET will be executed. This will
-- result in a segmentation fault as the value for EIP is nonsense.
-- Hence, abort the program before IRET is executed.
GNAT.OS_Lib.OS_Exit (0);
end fn;
---------
-- Run --
---------
procedure Run is
use System.Machine_Code;
use ASCII;
begin
-- Mimic the processor behavior when an ISR is invoked. See also:
--
-- Intel (R) 64 and IA-32 Architectures / Software Developer's Manual
-- Volume 3 (3A, 3B, 3C & 3D) : System Programming Guide
-- Section 6.12: Exception and Interrupt Handling
--
-- Push the data to the stack and jump unconditionally to the
-- interrupt service routine.
Asm
(Template =>
"push %0" & LF &
"push %1" & LF &
"push %2" & LF &
"push %3" & LF &
"push %4" & LF &
"push %5" & LF &
"jmp __fn",
Inputs =>
(uword_t'Asm_Input ("l", SS),
uword_t'Asm_Input ("l", SP),
uword_t'Asm_Input ("l", FLAGS),
uword_t'Asm_Input ("l", CS),
uword_t'Asm_Input ("l", IP),
uword_t'Asm_Input ("l", ERROR)),
Volatile => True);
end Run;
end PR68037_1;
I compiled the program in GNAT CE 2019 with compiler options -g -mgeneral-regs-only (copied from the GCC test). Note that the parameter interrupt_frame will be passed by reference (see RM B.3 69/2).

Circular dependency between new vector package and procedure

I am attempting to understand how to fix this circular dependency. All the examples I can find online suggest using a limited with, but then they demonstrate the use with two basic types, whereas this is a bit more advanced. The circular dependency is between the two files below. I thought it was between package Chessboard ... and the Piece type, but now I am not so sure. Attempting to put the package Chessboard ... line within chess_types.ads after the Piece type is declared and removing the use and with of Chessboard results in an error: this primitive operation is declared too late for the Move procedure. I am stuck on how to get out of this dependency. Any help would be much appreciated!
Thank you
chessboard.ads:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
with Chess_Types;
use Chess_Types;
package Chessboard is new Indefinite_Vectors(Board_Index, Piece'Class);
chess_types.ads:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
with Chessboard;
use Chessboard;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Integer;
end record;
procedure Move_Piece(Board: in Vector; P: in Piece; Move_To: in Integer);
end Chess_Types;
More Code for question in comments:
Chess_Types.Piece_Types.ads:
package Chess_Types.Piece_Types is
type Pawn is new Piece with
record
First_Move : Boolean := True;
end record;
overriding
procedure Move_Piece(Board: in CB_Vector'Class; Po: in Pawn; Move_To: in Board_Index);
-- Other piece types declared here
end Chess_Types.Piece_Types;
Chess_Types.Piece_Types.adb:
with Ada.Text_IO;
use Ada.Text_IO;
package body Chess_Types.Piece_Types is
procedure Move_Piece(Board: in CB_Vector'Class; Po: in Pawn; Move_To: in Board_Index) is
Index_From, Index_To : Board_Index;
Move_From : Board_Index := Po.Coordinate;
begin
-- Obtain locations of Pawn to move from (Index_From) and to (Index_To)
-- in terms of the single dimension vector
for I in Board.First_Index .. Board.Last_Index loop
if Board.Element(I).Coordinate = Move_From then
Index_From := I;
end if;
if Board.Element(I).Coordinate = Move_To then
Index_To := I;
end if;
end loop;
-- Determine if the requested move is legal, and if so, do the move.
-- More possibilties to be entered, very primitive for simple checking.
if Move_To - Move_From = 2 and then Po.First_Move = True then
Board.Swap(I => Index_From, J => Index_To); -- "actual for "Container" must be a variable"
Board.Element(Index_From).First_Move := False; -- "no selector for "First_Move" for type "Piece'Class"
elsif Move_To - Po.Coordinate = 1 then
Board.Swap(Index_From, Index_To); -- "actual for "Container" must be a variable"
end if;
-- Test to make sure we are in the right Move_Piece procedure
Put_Line("1");
end Move_Piece;
-- Other piece type move_piece procedures defined here
end Chess_types.Piece_Types;
As a note to understand further, the Coordinate component of each piece correspond to ICCF numeric notation, which is two digits, so there needs to be some type of conversion between the vector and the ICCF notation, hence the reason for the whole for loop at the start.
This is a tough one. It looks like limited with and generics don't play nice together. The only way to make it work is to go back to using your own access type:
with Ada.Containers.Vectors;
use Ada.Containers;
limited with Chess_Types;
use Chess_Types;
package Chessboard_Package is
subtype Board_Index is Integer range 1 .. 64;
type Piece_Acc is access all Piece'Class;
package Chessboard is new Vectors(Board_Index, Piece_Acc);
end Chessboard_Package;
I had to put the instantiation into a new package, and move the Board_Index there too. Also, I changed it to Vectors since Piece_Acc is a definite type and there's no point in using Indefinite_Vectors. But in any event, this defeats the purpose. I'm just not sure Ada gives you a way to do what you want with two packages like this.
Even doing it in one package is not easy:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is tagged record ... end record;
type CB_Vector is tagged;
procedure Move_Piece (Board : in CB_Vector'Class;
P : in Piece;
Move_To : in Board_Index);
package Chessboard is new Indefinite_Vectors(Board_Index, Piece'Class);
type CB_Vector is new Chessboard.Vector with null record;
end Chess_Types;
This compiles, but I had to add extra stuff to get around some of the language rules (in particular, when you instantiate a generic, that "freezes" all prior tagged types so that you can no longer declare a new primitive operation of the type); also, I had to make the Board parameter a classwide type to avoid running into the rule about primitive operations of multiple tagged types.
As I understand it, this will do what you want.
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is abstract tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Board_Index;
end record;
type Piece_Ptr is access all Piece'Class;
package Chessboard is new Indefinite_Vectors(Board_Index, Piece_Ptr);
procedure Move_Piece (Board : in Chessboard.Vector;
P : in Piece'Class;
Move_To : in Board_Index) is abstract;
end Chess_Types;
NOTES:
Piece is now abstract, as is the Move_Piece method. This will mean you now need to derive your other piece types (package piece_type-rook.ads, with a move_piece method for rook) etc...
Chessboard now contains pointers (Class wide pointers), beware allocating, deallocating, deep copy, shallow copy issues when using it.
You should now be able to call Move_Piece on any dereference of a piece_ptr and have it dispatch to the correct method.
The Move_To parameter is now the same type as the Board_Index. (Coordinate also brought in line) -- this seems a bit clunky, perhaps rethink this. (Row & Column Indices defining a 2D array perhaps? --No need for Indefinite_Vectors)
To answer the second question in the comment:
To use First_Move, the procedure has to know that it's a Pawn. If the object is declared with type Piece'Class, you can't access components that are defined only for one of the derived types. (That's true in most OO languages.) This may indicate a flaw in your design; if you have a procedure that takes a Piece'Class as a parameter, but you want to do something that makes sense only for a Pawn, then maybe you should add another operation to your Piece that does a default action for most pieces (perhaps it does nothing) and then override it for Pawn. Other possibilities are to use a type conversion:
procedure Something (P : Piece'Class) is ...
if Pawn(P).First_Move then ...
which will raise an exception if P isn't a Pawn. If you want to test first, you can say "if P in Pawn". I sometimes write code like:
if P in Pawn then
declare
P_Pawn : Pawn renames Pawn(P);
begin
if P_Pawn.First_Move then ...
end;
end if;
But defining a new polymorphic operation is preferable. (Note: I haven't tested the above code, hope I didn't make a syntax error somewhere.)

Ada String Concatenation

I have a function that returns a string for a particular item, and I need to call that function numerous times and combine those strings into one. The combined string is bounded. I've made sure to fill it when space characters when it initializes but I keep getting "length check failed" errors. Is there something basic I'm doing wrong here?
FOR I IN 1..Collection.Size LOOP
Combined_String := combined_string & Tostring(Collection.Book(I));
END LOOP;
Unbounded_String is probably the easiest way to go:
with Ada.Strings.Unbounded;
use Ada.Strings.unbounded;
...
Temp_Unbounded_String : Unbounded_String; -- Is empty by default.
...
for I in 1 .. Collection.Size loop
Append(Temp_Unbounded_String, ToString(Collection.Book(I));
end loop;
If you then need to have the result placed in your fixed length standard string:
declare
Temp_String : constant String := To_String(Temp_Unbounded_String);
begin
-- Beware! If the length of the Temp_String is greater than that of the
-- fixed-length string, a Constraint_Error will be raised. Some verification
-- of source and target string lengths must be performed!
Combined_String(Temp_String'Range) := Temp_String;
end;
Alternatively, you can use the Ada.Strings.Fixed Move() procedure to bring the Unbounded_String into the target fixed-length string:
Ada.Strings.Fixed.Move(To_String(Temp_Unbounded_String), Combined_String);
In this case, if the source string is "too long", by default a Length_Error exception is raised. There are other parameters to Move() that can modify the behavior in that situation, see the provided link on Move for more detail.
In order to assign Combined_String, you must assign the full correct length at once. You can't "build up" a string and assign it that way in Ada.
Without seeing the rest of your code, I think Ada.Strings.Unbounded is probably what you should be using.
I know this is an ancient question, but now that Ada 2012 is out I thought I'd share an idiom I've been finding myself using...
declare
function Concatenate(i: Collection'index)
is
(tostring(Collection(i) &
if (i = Collection'last) then
("")
else
(Concatenate(i+1))
);
s: string := Concatenate(Collection'first);
begin
Put_Line(s);
end;
Typed off the top of my head, so it'll be full of typos; and if you want it to work on empty collections you'll need to tweak the logic (should be obvious).
Ada 2012's expression functions are awesome!
Ada works best when you can use perfectly-sized arrays and strings. This works wonderfully for 99% of string uses, but causes problems any time you need to progressively build a string from something else.
Given that, I'd really like to know why you need that combined string.
If you really need it like that, there are two good ways I know of to do it. The first is to use "unbounded" (dynamically-sized) strings from Ada.Strings.Unbounded, as Dave and Marc C suggested.
The other is to use a bit of functional programming (in this case, recursion) to create your fixed string. Eg:
function Combined_String (String_Collection : in String_Collection_Type) return String is
begin
if String_Collection'length = 1 then
return String_Collection(String_Collection'first);
end if;
return String_Collection(String_Collection'first) &
Combined_String (String_Collection'first + 1 .. String_Collection'last);
end Combined_String;
I don't know what type you used for Collection, so I'm making some guesses. In particular, I'm assuming its an unconstrained array of fixed strings. If it's not, you will need to replace some of the above code with whatever your container uses to return its bounds, access elements, and perform slicing.
From AdaPower.com:
function Next_Line(File : in Ada.Text_IO.File_Type :=
Ada.Text_Io.Standard_Input) return String is
Answer : String(1..256);
Last : Natural;
begin
Ada.Text_IO.Get_Line(File => File,
Item => Answer,
Last => Last);
if Last = Answer'Last then
return Answer & Next_Line(File);
else
return Answer(1..Last);
end if;
end Next_Line;
As you can see, this method builds a string (using Get_Line) of unlimited* length from the file it's reading from. So what you'll need to do, in order to keep what you have is something on the order of:
function Combined_String (String_Collection : in String_Collection_Type)
Return String is
begin
if String_Collection'length = 1 then
Return String_Collection(String_Collection'First).All;
end if;
Recursion:
Declare
Data : String:= String_Collection(String_Collection'First).All;
SubType Constraint is Positive Range
Positive'Succ(String_Collection'First)..String_Collection'Last;
Begin
Return Data & Combined_String( String_Collection(Constraint'Range) );
End Recursion;
end Combined_String;
Assuming that String_Collection is defined as:
Type String_Collection is Array (Positive Range <>) of Access String;
*Actually limited by Integer'Range, IIRC

Resources