Limited returns

Hehe, and let's consider this:

with Ada.Finalization;
procedure Test_Limited_Stuff is

type E is ( Make_S, Make_S1 );

type I is interface;

type T is new Ada.Finalization.Controlled with record
A : Integer;
end record;

type S is new T and I with record
: not null access S'Class := S'Unchecked_Access;
B: Integer;
end record;

type S1 is new T and I with record
: not null access S1'Class := S1'Unchecked_Access;
N: String(1256);
end record;


function Factory( w: E ) return I'Class is
begin
if w = Make_S then
return S'(Ada.Finalization.Controlled with A =0, B =>
1);
else
return S1'(Ada.Finalization.Controlled with A =0, N =>
(others =10) );
end if;
end Factory;

Value : I'Class := Factory(Make_S);
begin
Value := Factory(Make_S1);
end Test_Limited_Stuff;


Crashed pretty badly with CNSTRAINT_ERRR, whining about tag check
error. Seems its completely buggy and unusable.

Crashed pretty badly with CNSTRAINT_ERRR, whining about tag check
error.

though i can't fugure out how it could check that in compile time
can it?

>Seems its completely buggy and unusable.

seems my bad. taking that back.

Even if it could, that would not make the program illegal. The compiler
could only warn you about a possible exception propagation, which is not an
error.

Well, I thought the compiler must warn about possible exception,
especially when there is such a possibility.

, this is just my opinion, but returning to our rams - some
strangeness (an error?) is still there - consider:

named.ads
package Named is
type is interface;

function name(this: ) return String is abstract;
end Named;

some.ads
with Named;
with Ada.Finalization; use Ada.Finalization;
with Ada.Strings.Bounded;

package Some is
Size : constant := 80;
package bs is new (Size);
use bs;

type is new Controlled and N with private;

function Create( name: String ) return ;

overriding procedure Initialize(this: in out );
overriding procedure Finalize(this: in out );
overriding procedure Adjust(this: in out );

overriding function name(this: ) return String;

private
type is new Controlled and N with
record
the_name: Bounded_String;
end record;
end Some;

some.adb
with ada.Text_I;
with system;

package body Some is
package tio renames ada.Text_I;

function Create( name: String ) return is
begin
return : do
:= To_Bounded_String(name);
end return;
end Create;


procedure Initialize(this: in out ) is
begin
tio.Put_Line("Initialization " & this.name );
end Initialize;

procedure Finalize(this: in out ) is
begin
tio.Put_Line("Finalization " & this.name);
end Finalize;

procedure Adjust(this: in out ) is
begin
tio.Put_Line("Ajusting " & this.name);
end Adjust;

function name(this: ) return String is
begin
return To_String(this.the_name);
end name;

end Some;

factory.ads
with Named;

package Factory is
function Create(name: String) return N'Class;
end Factory;

factory.adb
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Some;

package body Factory is

function Create(name: String) return N'Class is
begin
return Some.Create(name);
end;
end Factory;

boom.adb
with ada.Text_I;
with Named; use Named;
with Factory;


procedure boom is
package tio renames ada.Text_I;
aNamed: N'Class := Factory.create("Some1");
begin
aNamed := Factory.create("Some1");
tio.put_line( "My name is " & aNamed.name );
tio.Flush;
end boom;


What I can't figure out is why it's crashed at ? Factory creates
two fully equivalent objects of the same type!
Program's output looks very strange as well (at least for me) - why
for two initialization we have five (!!!) finalization? It drives me
crazy!

The program output is as follows:

Initialization
Ajusting Some1
Finalization Some1
Ajusting Some1
Initialization
Ajusting Some1
Finalization Some1
Finalization Some1
Finalization Some1
Finalization Some1

Execution terminated by unhandled exception
Exception name: CNSTRAINT_ERRR
Message: boom.adb:10 tag check failed
Call stack traceback locations:
0x401b69 0x401676 0x401235 0x401286 0x7c816d4d
[2008-06-24 14:51:09] process exited with status1 (elapsed time:
00.14s)

Well, it seems using I'Class is very dangerous if I isn't limited,
because it looks very match like 'dynamic typed' regarding assignment
within hierarchy rooted from I

>Because of a compiler bug, I guess. I think you should post it.

unfortunately too match bugs.

Because it should be this way. The number of Adjusts and Initializes shall
match the number of Finalizes (not considering aggregates you don't have in
your code).

, I see now. Thanks.

>
If you are familiar with C++, consider Adjust as a [part of a] copy
constructor and Initialize as a [part of the] default constructor.

I assume you mean to say as part of 'operator ='. Thanks again.