ada/PolyORB
0
0
Fork 0
mirror of https://github.com/AdaCore/PolyORB.git synced 2026-02-12 13:01:15 -08:00
Code Issues Packages Projects Releases Wiki Activity

Fix TypeCode generation for unions whose discriminant is not

Browse Source 
of a base type.
Fixes PR idlac/28 (partial).

[Imported from Perforce change 2074 at 2006-12-01 19:09:57]

Subversion-branch: /trunk/adabroker
Subversion-revision: 32558
This commit is contained in:
Thomas Quinot
2000-07-05 19:37:32 +00:00
parent d7607eeb53
commit dc6a84276d
7 changed files with 131 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
broca/examples/all_types/all_types-impl.adb
View File

@@ -245,6 +245,14 @@ package body all_types.Impl is
return arg;
end echoUnion;
function echoUnionEnumSwitch
(Self : access Object;
arg : in myUnionEnumSwitch)
return myUnionEnumSwitch is
begin
return arg;
end echoUnionEnumSwitch;
function echoUsequence
(Self : access Object;
arg : in U_sequence)

5
broca/examples/all_types/all_types-impl.ads
View File

@@ -152,6 +152,11 @@ package all_types.Impl is
arg : in myUnion)
return myUnion;
function echoUnionEnumSwitch
(Self : access Object;
arg : in myUnionEnumSwitch)
return myUnionEnumSwitch;
function echoUsequence
(Self : access Object;
arg : in U_sequence)

7
broca/examples/all_types/all_types.idl
View File

@@ -43,6 +43,13 @@ interface all_types {
myUnion echoUnion (in myUnion arg);
union myUnionEnumSwitch switch (Color) {
case Red: long foo;
case Green: short bar;
case Blue: string baz;
};
myUnionEnumSwitch echoUnionEnumSwitch (in myUnionEnumSwitch arg);
// Arrays
// ------
typedef long simple_array[5];

17
broca/examples/all_types/client.adb
View File

@@ -102,7 +102,7 @@ begin
-- Unions
declare
Test_Unions : constant array (0 .. 3) of myUnion
Test_Unions : constant array (Integer range <>) of myUnion
:= ((Switch => 0, Unknown => 987),
(Switch => 1, Counter => 1212),
(Switch => 2, Flag => True),
@@ -117,6 +117,21 @@ begin
Output ("test union", Pass);
end;
declare
Test_Unions : constant array (Integer range <>) of myUnionEnumSwitch
:= ((Switch => Red, Foo => 31337),
(Switch => Green, Bar => 534),
(Switch => Blue, Baz => CORBA.To_CORBA_String ("grümpf")));
Pass : Boolean := True;
begin
for I in Test_Unions'Range loop
Pass := Pass and then echoUnionEnumSwitch (Myall_types, Test_Unions (I))
= Test_Unions (I);
exit when not Pass;
end loop;
Output ("test union with enum switch", Pass);
end;
-- Exceptions
Ok := False;
declare

54
broca/examples/all_types/dynclient.adb
View File

@@ -746,6 +746,45 @@ procedure DynClient is
(Result.Argument);
end EchoUnion;
function EchoUnionEnumSwitch
(Self : in CORBA.Object.Ref;
Arg : in All_Types.myUnionEnumSwitch)
return All_Types.myUnionEnumSwitch is
Operation_Name : CORBA.Identifier := To_CORBA_String ("echoUnionEnumSwitch");
Arg_Name : CORBA.Identifier := To_CORBA_String ("arg");
Request : CORBA.Request.Object;
Ctx : CORBA.Context.Ref := CORBA.Context.Nil_Ref;
Argument : CORBA.Any;
Arg_List : CORBA.NVList.Ref;
Result : CORBA.NamedValue;
Result_Name : CORBA.String := To_CORBA_String ("Result");
begin
-- creating the argument list
CORBA.ORB.Create_List (0, Arg_List);
Argument := All_Types.Helper.To_Any (Arg);
CORBA.NVList.Add_Item (Arg_List,
Arg_Name,
Argument,
CORBA.ARG_IN);
-- setting the result type
Result := (Name => Identifier (Result_Name),
Argument => Get_Empty_Any (All_Types.Helper.TC_MyunionEnumSwitch),
Arg_Modes => 0);
-- creating a request
CORBA.Object.Create_Request (Myall_Types,
Ctx,
Operation_Name,
Arg_List,
Result,
Request,
0);
-- sending message
CORBA.Request.Invoke (Request, 0);
-- getting the answer
return All_Types.Helper.From_Any
(Result.Argument);
end EchoUnionEnumSwitch;
function EchoUsequence
(Self : in CORBA.Object.Ref;
Arg : in All_Types.U_sequence)
@@ -1107,6 +1146,21 @@ begin
end loop;
Output ("test union", Pass);
end;
declare
Test_Unions : constant array (Integer range <>) of myUnionEnumSwitch
:= ((Switch => Red, Foo => 31337),
(Switch => Green, Bar => 534),
(Switch => Blue, Baz => CORBA.To_CORBA_String ("grümpf")));
Pass : Boolean := True;
begin
for I in Test_Unions'Range loop
Ada.Text_IO.Put_Line ("@@1 I = " & I'Img);
Pass := Pass and then echoUnionEnumSwitch (Myall_types, Test_Unions (I))
= Test_Unions (I);
exit when not Pass;
end loop;
Output ("test union with enum switch", Pass);
end;
-- Unbounded sequences
declare

51
broca/src/corba.adb
View File

@@ -812,30 +812,38 @@ package body CORBA is
end case;
end Concrete_Base_Type;
------------------------------
-- Member_Type_With_Label --
------------------------------
----------------------------
-- Member_Type_With_Label --
----------------------------
function Member_Type_With_Label
(Self : in Object;
Label : in Any;
Index : in CORBA.Unsigned_Long) return Object is
Index : in CORBA.Unsigned_Long)
return Object
is
Param_Nb : Unsigned_Long := Parameter_Count (Self);
Current_Member : Unsigned_Long := 0;
Default_Member : Unsigned_Long := -1;
Member_Nb : Long := -1;
Default_Nb : Long := -1;
begin
pragma Debug (O ("Member_Type_With_Label : enter"));
pragma Debug (O ("Member_Type_With_Label : Param_Nb = "
& Unsigned_Long'Image (Param_Nb)));
pragma Debug (O ("Member_Type_With_Label: enter"));
pragma Debug (O ("Member_Type_With_Label: Param_Nb = "
& Param_Nb'Img
& ", Index = "
& Index'Img));
-- See the big explanation after the declaration of
-- typecode.object in the private part of corba.typecode
-- TypeCode.Object in the private part of CORBA.TypeCode
-- to understand the magic numbers used here.
if Kind (Self) = Tk_Union then
-- look at the member until we got enough with the
-- good label or we reach the end
while Member_Nb < Long (Index) and
Param_Nb > 3 * Current_Member + 6 loop
-- Look at the members until we got enough with the
-- right label or we reach the end.
while Member_Nb < Long (Index)
and then Param_Nb > 3 * Current_Member + 6 loop
pragma Debug (O ("Member_Type_With_Label : enter loop"));
-- if it is a default label, add one to the count
if Default_Index (Self) = Long (Current_Member) then
@@ -858,13 +866,14 @@ package body CORBA is
-- next member please
Current_Member := Current_Member + 1;
end loop;
-- if we got enough member with the right label
if Member_Nb = Long (Index) then
pragma Debug (O ("Member_Type_With_Label : end"));
return From_Any (Get_Parameter (Self, 3 * Current_Member + 2));
-- else if we didn't got any matching label but
-- we have enough default ones
elsif Member_Nb = -1 and Default_Nb >= Long (Index) then
elsif Member_Nb = -1 and then Default_Nb >= Long (Index) then
pragma Debug (O ("Member_Type_With_Label : default end"));
return From_Any (Get_Parameter (Self, 3 * Default_Member + 5));
-- else raise error
@@ -874,8 +883,8 @@ package body CORBA is
begin
pragma Debug (O ("Member_Type_With_Label : "
& "end with exception"));
Broca.Exceptions.User_Raise_Exception (Bounds'Identity,
Member);
Broca.Exceptions.User_Raise_Exception
(Bounds'Identity, Member);
end;
end if;
else
@@ -884,8 +893,8 @@ package body CORBA is
begin
pragma Debug (O ("Member_Type_With_Label : "
& "end with exception"));
Broca.Exceptions.User_Raise_Exception (BadKind'Identity,
Member);
Broca.Exceptions.User_Raise_Exception
(BadKind'Identity, Member);
end;
end if;
end Member_Type_With_Label;
@@ -1347,16 +1356,16 @@ package body CORBA is
Content_TypeCode_Ptr (Get_Value (Right)).Value);
when Tk_Principal =>
pragma Debug (O ("Equal (Any) : end"));
pragma Debug (O ("Equal (Any) : end (Tk_Principal -> TRUE)"));
return True;
when Tk_Objref =>
pragma Debug (O ("Equal (Any) : end"));
pragma Debug (O ("Equal (Any) : end (Tk_Objref -> TRUE)"));
return True;
-- return Object.Is_Equivalent (Object.From_Any (Left),
-- Object.From_Any (Right));
when Tk_Struct | Tk_Union =>
pragma Debug (O ("Equal (Any) : end"));
pragma Debug (O ("Equal (Any) : end (Tk_Struct/Union -> TRUE)"));
return True;
-- agregate comparison (recursive)
-- declare
@@ -1393,7 +1402,7 @@ package body CORBA is
-- end;
when others =>
pragma Debug (O ("Equal (Any) : end"));
pragma Debug (O ("Equal (Any) : end (other TC kind -> FALSE)"));
-- unsupported type for comparison :
-- tk_principal, tk_objref
return False;

20
idlac/ada_be-idl2ada-helper.adb
View File

@@ -290,7 +290,7 @@ package body Ada_Be.Idl2Ada.Helper is
(CU : in out Compilation_Unit;
Type_Node : in Node_Id) is
begin
Add_With (CU, "CORBA", Use_It => False);
Add_With (CU, "CORBA");
PL (CU, "function From_Any (Item : in CORBA.Any)");
II (CU);
Put (CU, "return "
@@ -305,7 +305,7 @@ package body Ada_Be.Idl2Ada.Helper is
(CU : in out Compilation_Unit;
Type_Node : in Node_Id) is
begin
Add_With (CU, "CORBA", Use_It => False);
Add_With (CU, "CORBA");
PL (CU, "function To_Any (Item : in "
& Ada_Type_Name (Type_Node)
& ")");
@@ -1376,9 +1376,11 @@ package body Ada_Be.Idl2Ada.Helper is
(CU : in out Compilation_Unit;
Node : in Node_Id) is
begin
Add_With (CU, "CORBA", Use_It => True);
Add_With (CU, Ada_Helper_Name (Switch_Type (Node)));
-- From_Any
Add_With (CU, "CORBA", Use_It => True);
NL (CU);
Gen_From_Any_Profile (CU, Node);
PL (CU, " is");
@@ -1386,13 +1388,11 @@ package body Ada_Be.Idl2Ada.Helper is
PL (CU, "Label_Any : CORBA.Any :=");
II (CU);
PL (CU, "CORBA.Get_Aggregate_Element (Item,");
Add_With (CU, Ada_Helper_Name (Switch_Type (Node)));
PL (CU, " "
& Ada_Full_TC_Name (Switch_Type (Node)) & ",");
PL (CU, " "
& "CORBA.Unsigned_Long (0));");
DI (CU);
Add_With (CU, Ada_Helper_Name (Switch_Type (Node)));
PL (CU, "Label : "
& Ada_Type_Name (Switch_Type (Node))
& " := "
@@ -1441,7 +1441,9 @@ package body Ada_Be.Idl2Ada.Helper is
PL (CU, "Index := CORBA.Get_Aggregate_Element");
II (CU);
PL (CU, "(Item,");
Add_With (CU, Ada_Helper_Name (Case_Type (Case_Node)));
PL (CU, " "
& Ada_Full_TC_Name (Case_Type (Case_Node))
& ",");
@@ -1449,7 +1451,6 @@ package body Ada_Be.Idl2Ada.Helper is
I := I + 1;
DI (CU);
PL (CU, "I := I + 1;");
Add_With (CU, Ada_Helper_Name (Case_Type (Case_Node)));
PL (CU, "Result."
& Ada_Name (Case_Decl (Case_Node))
& " := "
@@ -1583,7 +1584,6 @@ package body Ada_Be.Idl2Ada.Helper is
PL (CU, "CORBA.TypeCode.Add_Parameter ("
& Ada_TC_Name (Node)
& ", CORBA.To_Any (Id));");
Add_With (CU, Ada_Helper_Name (Switch_Type (Node)));
PL (CU, "CORBA.TypeCode.Add_Parameter ("
& Ada_TC_Name (Node)
& ", CORBA.To_Any ("
@@ -1612,7 +1612,8 @@ package body Ada_Be.Idl2Ada.Helper is
if Default_Index (Node) = I then
PL (CU, "CORBA.TypeCode.Add_Parameter ("
& Ada_TC_Name (Node)
& ", CORBA.To_Any ("
& ", " & Ada_Helper_Name (Switch_Type (Node))
& ".To_Any ("
& Ada_Type_Name (Switch_Type (Node))
& "'First));");
Add_With (CU, Ada_Helper_Name (Case_Type (Case_Node)));
@@ -1632,7 +1633,8 @@ package body Ada_Be.Idl2Ada.Helper is
Get_Next_Node (It2, Label_Node);
Put (CU, "CORBA.TypeCode.Add_Parameter ("
& Ada_TC_Name (Node)
& ", CORBA.To_Any ("
& ", " & Ada_Helper_Name (Switch_Type (Node))
& ".To_Any ("
& Ada_Type_Name (Switch_Type (Node))
& " (");
Gen_Constant_Value (CU, Label_Node);