From 041eda478fcbccde3bb30a5e1fb5f391f59fb2ff Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Tue, 20 Nov 2001 15:38:19 +0000 Subject: [PATCH] A CORBA object now executes a request received from SOAP, with proper passing of parameter values. [Imported from Perforce change 3997 at 2006-12-01 19:29:38] Subversion-branch: /trunk/polyorb Subversion-revision: 33182 --- src/echo-impl.adb | 2 +- src/polyorb-any.adb | 23 ++++++++++++++- src/polyorb-any.ads | 11 ++++++- src/polyorb-requests.adb | 62 ++++++++++++++++++++++++++++++++++++++-- 4 files changed, 93 insertions(+), 5 deletions(-) diff --git a/src/echo-impl.adb b/src/echo-impl.adb index 354be6769..3003b911d 100644 --- a/src/echo-impl.adb +++ b/src/echo-impl.adb @@ -30,7 +30,7 @@ -- -- ------------------------------------------------------------------------------ --- $Id: //droopi/main/src/echo-impl.adb#9 $ +-- $Id: //droopi/main/src/echo-impl.adb#10 $ with Ada.Text_IO; diff --git a/src/polyorb-any.adb b/src/polyorb-any.adb index 5bb5339d8..1816abdfc 100644 --- a/src/polyorb-any.adb +++ b/src/polyorb-any.adb @@ -30,7 +30,7 @@ -- -- ------------------------------------------------------------------------------ --- $Id: //droopi/main/src/polyorb-any.adb#8 $ +-- $Id: //droopi/main/src/polyorb-any.adb#9 $ with Ada.Tags; @@ -2312,6 +2312,27 @@ package body PolyORB.Any is Any_Lock => A.Any_Lock); end Get_By_Ref; + procedure Copy_Any_Value (Dest : in out Any; Src : Any) + is + begin + if TypeCode.Kind (Get_Precise_Type (Dest)) + /= TypeCode.Kind (Get_Precise_Type (Src)) + then + raise TypeCode.Bad_TypeCode; + end if; + + Lock_W (Dest.Any_Lock); + if Dest.The_Value.all /= Null_Content_Ptr then + Deallocate (Dest.The_Value.all); + -- We can do a simple deallocate/replacement here + -- because The_Value.all.all is not alised (ie + -- it is pointed to only by the Any_Content_Ptr + -- The_Value.all). + end if; + Dest.The_Value.all := Duplicate (Get_Value (Src)); + Unlock_W (Dest.Any_Lock); + end Copy_Any_Value; + ----------------- -- Duplicate -- ----------------- diff --git a/src/polyorb-any.ads b/src/polyorb-any.ads index aa0e072ba..8fba7aa13 100644 --- a/src/polyorb-any.ads +++ b/src/polyorb-any.ads @@ -30,7 +30,7 @@ -- -- ------------------------------------------------------------------------------ --- $Id: //droopi/main/src/polyorb-any.ads#5 $ +-- $Id: //droopi/main/src/polyorb-any.ads#6 $ with Ada.Finalization; with Ada.Unchecked_Deallocation; @@ -614,6 +614,15 @@ package PolyORB.Any is (Tc : TypeCode.Object) return Any; + procedure Copy_Any_Value (Dest : in out Any; Src : Any); + -- Set the value of Dest from the value of Src (as + -- Set_Any_Value would do, but without the need to + -- know the precise type of Src). Dest and Src must be Any's + -- with identical typecodes. Dest may be empty. + -- This is not the same as Set_Any_Value (Dest, Src), which + -- sets the value of Dest (an Any which a Tk_Any type code) + -- to be Src (not the /value/ of Src). + function Get_By_Ref (A : in Any) return Any; diff --git a/src/polyorb-requests.adb b/src/polyorb-requests.adb index 8568bd831..f866f5e21 100644 --- a/src/polyorb-requests.adb +++ b/src/polyorb-requests.adb @@ -127,8 +127,66 @@ package body PolyORB.Requests is end; Self.Deferred_Arguments_Session := null; else - pragma Assert (Self.Deferred_Arguments_Session = null); - Args := Self.Args; + pragma Assert + (Self.Deferred_Arguments_Session = null + and then not Is_Nil (Self.Args)); + + pragma Debug (O ("in Arguments: " & Image (Self.Args))); + + declare + use PolyORB.Any; + use PolyORB.Any.NVList.Internals; + use PolyORB.Any.NVList.Internals.NV_Sequence; + P_Arg_Index : Integer := 1; + -- Index in Self.Args (protocol layer arguments) + begin + for A_Arg_Index in 1 .. Get_Count (Args) loop + -- Index in Args (application layer arguments) + declare + A_Arg : NamedValue + := Element_Of (List_Of (Args).all, + Integer (A_Arg_Index)); + P_Arg : constant NamedValue + := Element_Of (List_Of (Self.Args).all, P_Arg_Index); + begin + if A_Arg.Arg_Modes = ARG_IN + or else A_Arg.Arg_Modes = ARG_INOUT + then + -- Application says it wants this arg as + -- input: take it from P_Args. + Copy_Any_Value (A_Arg.Argument, P_Arg.Argument); + -- These MUST be type-compatible! + + P_Arg_Index := P_Arg_Index + 1; + else + -- An ARG_OUT argument + + if P_Arg.Arg_Modes = ARG_OUT then + -- present: skip it. + P_Arg_Index := P_Arg_Index + 1; + end if; + end if; + end; + end loop; + end; + + -- XXX This is not the whole story. + + -- In an ideal world, Self.Args (from the Protocol layer) + -- and Args (from the application layer) are mode-conformant. + -- Unfortunately, some protocols (eg SOAP) do not support + -- deferred unmarshalling, and insist on unmarshalling Self.Args + -- before Arguments is called. Consequence: 'OUT' mode arguments + -- might be missing in Self.Args, and 'INOUT' arguments might + -- be marked as 'IN'. Also, there is no guarantee that the order + -- of arguments is the same in Args and Self.Args. An attempt + -- should be made to reconcile argument names and argument types + -- (tricky. See how Ada compilers do parameter reconciliation with + -- support for both named and positional parameter associations.) + + -- Here we do our best by assuming that P_Args are exactly conformant + -- with A_Args, possibly with ARG_OUT arguments missing. + end if; end Arguments;