diff --git a/broca/examples/all_types/all_types-impl.adb b/broca/examples/all_types/all_types-impl.adb index 5e30cbe33..3c441abdd 100644 --- a/broca/examples/all_types/all_types-impl.adb +++ b/broca/examples/all_types/all_types-impl.adb @@ -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) diff --git a/broca/examples/all_types/all_types-impl.ads b/broca/examples/all_types/all_types-impl.ads index c63383302..86de80122 100644 --- a/broca/examples/all_types/all_types-impl.ads +++ b/broca/examples/all_types/all_types-impl.ads @@ -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) diff --git a/broca/examples/all_types/all_types.idl b/broca/examples/all_types/all_types.idl index 2301a3e01..707cce3de 100644 --- a/broca/examples/all_types/all_types.idl +++ b/broca/examples/all_types/all_types.idl @@ -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]; diff --git a/broca/examples/all_types/client.adb b/broca/examples/all_types/client.adb index ef099859c..2950fd2c9 100644 --- a/broca/examples/all_types/client.adb +++ b/broca/examples/all_types/client.adb @@ -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 diff --git a/broca/examples/all_types/dynclient.adb b/broca/examples/all_types/dynclient.adb index c509dbbcd..db1fcc1cb 100644 --- a/broca/examples/all_types/dynclient.adb +++ b/broca/examples/all_types/dynclient.adb @@ -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 diff --git a/broca/src/corba.adb b/broca/src/corba.adb index 6d36839da..2ce785fd8 100644 --- a/broca/src/corba.adb +++ b/broca/src/corba.adb @@ -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; diff --git a/idlac/ada_be-idl2ada-helper.adb b/idlac/ada_be-idl2ada-helper.adb index 2bbc56f17..a0152d4c7 100644 --- a/idlac/ada_be-idl2ada-helper.adb +++ b/idlac/ada_be-idl2ada-helper.adb @@ -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);