Re: orbit-perl patch

[Sreeji K Das <bksys vsnl com>]

Hi
I had sent the above patch to this list long back. The following code
snippet fails.

....
..
$Server = CreateServer();
$NameComponent =
{
  'id'   => 'DepositServer',
  'kind' => 'Accounting',
};

$NameServer = Object2Ref($IOR_of_Name_Server);
$NameServer->bind([$NameComponent], $Server);
..
..

The bind() call fails, due to a wrong checking of $Server. As a result,
you cannot register an object with the Naming Service from perl. The
attached patch fixes the problem. I had posted a test script to demo. the
problem. If needed I can search & find it out.

BTW, as I see it, there is not much devel. taking place with
CORBA::ORBit. Owen, any plans for a latest release ? Is ORBit2 ripe enough
to create perl bindings ? 

Sreeji

On Wed, 9 Jan 2002, Huw Rogers wrote:

> I enclose an accumulated patch to
> orbit-perl, against the latest CVS version
> as of 9th January 2002.
> 
> This works well with ORBit 0.5.13.
> 
> Here's the fix list:
> 
> * implemented support for null and void Anys (myself)
> 
> * fixed serious refcount problem with inout args in server.c
>   which resulted in freeing of previously freed memory and
>   thus memory corruption
> 
> * fixed handling of inout args in client.c (related to above) (myself)
> 
> * fixed typecode memory leak in demarshal.c (myself)
> 
> * added _narrow() in ORBit.xs, as originally
>   suggested by Alex Hornby in
>   http://mail.gnome.org/archives/orbit-list/2001-April/msg00067.html
>   (his original patch isn't quite right for the current version)
> 
> * corrected spelling of error messages
>   in ORBit.xs ("privided" -> "provided") (myself)
> 
> * corrected spelling of create_reference_object_with_id()
>   to create_reference_with_id(), as originally
>   suggested by Mark McLoughlin in
>  
> http://mail.gnome.org/archives/orbit-perl-list/2001-April/msg00000.html
> 
> * fixed invalid pointer arithmetic on void * types
>   and other non-gcc compilation issues (myself)
> 
> * added parameter checking to XS(_porbit_repoid) as
>   originally suggested by someone on some mailing list
>   but I can't find the post
> 
> There are various other places where arguments to XS
> stubs are not checked and core dumps can be created
> by passing in incorrect arguments from perl; I might
> come up with some additional patches for those issues
> later on. For now, this fixes some major problems
> with inout parameters, Any support, and compilation
> in non-gcc environments.
> 
> 	-Huw Rogers
--- CORBA-ORBit-0.4.3/marshal.c	Thu Mar 22 12:35:46 2001
+++ CORBA-ORBit-0.4.3/marshal.new.c	Thu Mar 22 12:34:38 2001
@@ -414,27 +414,45 @@
 put_objref (GIOPSendBuffer *buf, CORBA_TypeCode tc, SV *sv)
 {
     CORBA_Object obj;
-    PORBitIfaceInfo *info = porbit_find_interface_description (tc->repo_id);
+    PORBitIfaceInfo *info;
 
-    if (!info)
-	croak ("Attempt to marshall unknown object type");
-    
-    if (!SvOK(sv))
-	obj = CORBA_OBJECT_NIL;
-    else {
-	/* FIXME: This check isn't right at all if the object
-	 * is of an unknown type. (Or if the type we have
-	 * for the object is not the most derived type.)
-	 * We should call the server side ISA and then
-	 * downcast in this case?
-	 */
-	if (!sv_derived_from (sv, info->pkg)) {
-	    warn ("Value is not a %s", info->pkg);
-	    return CORBA_FALSE;
-	}
+		if (tc->repo_id[0] != NULL)
+		{
+			info = porbit_find_interface_description (tc->repo_id);
 
-	obj = (CORBA_Object)SvIV((SV*)SvRV(sv));
-    }
+			if (!info)
+				croak ("Attempt to marshall unknown object type");
+    
+			if (!SvOK(sv))
+		obj = CORBA_OBJECT_NIL;
+			else {
+		/* FIXME: This check isn't right at all if the object
+		 * is of an unknown type. (Or if the type we have
+		 * for the object is not the most derived type.)
+		 * We should call the server side ISA and then
+		 * downcast in this case?
+		 */
+		if (!sv_derived_from (sv, info->pkg)) {
+				warn ("Value is not a %s", info->pkg);
+				return CORBA_FALSE;
+		}
+
+		obj = (CORBA_Object)SvIV((SV*)SvRV(sv));
+			}
+		}
+		else
+		{
+			/* We simply check whether SV is an object. Is that right ? - Sreeji */
+			if (!SvOK(sv))
+		obj = CORBA_OBJECT_NIL;
+			else {
+				if (!sv_isobject (sv)) {
+						warn ("Value is not an Object Reference");
+						return CORBA_FALSE;
+				}
+				obj = (CORBA_Object)SvIV((SV*)SvRV(sv));
+			}
+		}
     
     ORBit_marshal_object (buf, obj);
     return CORBA_TRUE;
@@ -702,3 +720,4 @@
 	return CORBA_FALSE;
     }
 }
+