From ikvello at common-lisp.net  Fri May  2 14:02:15 2008
From: ikvello at common-lisp.net (ikvello at common-lisp.net)
Date: Fri,  2 May 2008 10:02:15 -0400 (EDT)
Subject: [rdnzl-cvs] r10 - trunk/rdnzl-cpp/RDNZL
Message-ID: <20080502140215.338E54C001@common-lisp.net>

Author: ikvello
Date: Fri May  2 10:02:14 2008
New Revision: 10

Modified:
   trunk/rdnzl-cpp/RDNZL/InvocationResult.cpp
Log:
CAST: Test of IsAssignale fixed, support for __ComObjects added, and better error-reporting for illegal casts. Also, test of SVN commits.

Modified: trunk/rdnzl-cpp/RDNZL/InvocationResult.cpp
==============================================================================
--- trunk/rdnzl-cpp/RDNZL/InvocationResult.cpp	(original)
+++ trunk/rdnzl-cpp/RDNZL/InvocationResult.cpp	Fri May  2 10:02:14 2008
@@ -73,17 +73,53 @@
 void *setDotNetContainerType(Type ^newType, void *ptr) {
   try {
     DotNetContainer *container = static_cast<DotNetContainer *>(ptr);
-    Type ^oldType = container->getContainerType();
-    
-    if (oldType->IsAssignableFrom(newType)) {
-      container->setContainerType(newType);
-    } else {
-      Object ^newObject = Convert::ChangeType(container->getContainerObject(), newType);
-      container->setContainerObject(newObject);
+   
+    // IOK 2008-04-25 we need the 'true' type of the object,
+    // not the 'nominal' type stored in the container, because for instance
+    // Excel will return an Array as an Object in certain situations.
+    // Type ^oldType = container->getContainerType();
+    Object ^object = container->getContainerObject();
+    Type ^oldType = object->GetType();
+   
+    // IOK 2008-04-25 The normal case - assigning to the new type is legal.
+    if (newType->IsAssignableFrom(oldType)) {
       container->setContainerType(newType);
+      return new InvocationResult();
+    }
+   
+    // When the object is actually a System.__ComObject, we can't use
+    // IsAssignable and must use QueryInterface through interop services.
+    // This happens for instance for certain objects returned from Office
+    // Interop. IOK 2008-04-25
+	if (Marshal::IsComObject(object) && newType->IsInterface) {
+		// IOK 2007-05-02 Might want to wrap this in a try{}, and 
+		//  save the exception for later just in case we could have
+		//  won using IConvert here.
+        System::IntPtr returnvalue = Marshal::GetComInterfaceForObject(object,newType);
+        bool success = (returnvalue != System::IntPtr::Zero);
+        if (success) {
+            Marshal::Release(returnvalue);
+            container->setContainerType(newType);
+            return new InvocationResult();
+        }
     }
-    // return void result
-    return new InvocationResult();
+
+    // Not directly assignable, and not a __ComObject. IConvertible objects
+	// needs to be ChangeType'd then..
+	if (nullptr != oldType->GetInterface("System.IConvertible")) {
+     Object ^newObject = Convert::ChangeType(object, newType);
+     container->setContainerObject(newObject);
+     container->setContainerType(newType);
+	 return new InvocationResult();	
+	}
+
+	// Nothing worked, so return an exception 
+	return new InvocationResult(
+				gcnew System::InvalidCastException(
+				"Invalid cast from '" + oldType->FullName + "' to '" + newType->FullName +"'"), true);
+		
+
+  // This handles exceptions thrown by Marshall::GetComInterfaceForObject and Convert::ChangeType.
   } catch (Exception ^e) {
     return new InvocationResult(e, true);
   }


From ikvello at common-lisp.net  Fri May  2 14:35:33 2008
From: ikvello at common-lisp.net (ikvello at common-lisp.net)
Date: Fri,  2 May 2008 10:35:33 -0400 (EDT)
Subject: [rdnzl-cvs] r11 - trunk/rdnzl-cpp/RDNZL
Message-ID: <20080502143533.3E0FE702F7@common-lisp.net>

Author: ikvello
Date: Fri May  2 10:35:32 2008
New Revision: 11

Modified:
   trunk/rdnzl-cpp/RDNZL/Property.cpp
Log:
Handle "AmbiguosMatch" exception produced by GetProperty in cases where a class has two properties by the same name but different return-types.

Modified: trunk/rdnzl-cpp/RDNZL/Property.cpp
==============================================================================
--- trunk/rdnzl-cpp/RDNZL/Property.cpp	(original)
+++ trunk/rdnzl-cpp/RDNZL/Property.cpp	Fri May  2 10:35:32 2008
@@ -42,6 +42,34 @@
    throw gcnew Exception (msg);
 }
 
+
+// IOK 2008-05-02: helper function for finding the most specific property with a given name.
+PropertyInfo^ GetPropertyDisambiguatingSearch(Type^ t,String^ pname, BindingFlags bindingAttr, cli::array<Type^> ^realTypes) {
+	// Primary case is just to call GetProperty. If this throws AmbiguousMatchException, this
+	// means that two properties with different return-types are present in the object (since we
+	// always pass the full set of argument types). We want the 'most specific' one, so we start
+	// searching up the inheritance tree. IOK 2008-05-02
+	try { 
+       PropertyInfo ^pi = t->GetProperty(pname, bindingAttr, nullptr, nullptr, realTypes, nullptr);
+          // The normal case, only one property with the given name found, or none.
+       return pi;
+    // Oh no, the class has several properties so named. Try to find the most specific one.
+    } catch (System::Reflection::AmbiguousMatchException ^e) {
+		e; // Shutting up the compiler since we won't be referencing this variable
+        BindingFlags declaredOnlyFlags = static_cast<BindingFlags>(bindingAttr | BindingFlags::DeclaredOnly);
+        // Starting at the given type, search upwards the inheritance hierachy for the property
+        // using the DeclaredOnly flag. 
+		for (Type^ t2 = t; nullptr != t2->BaseType; t2 = t2->BaseType) {
+          PropertyInfo ^pi = t2->GetProperty(pname , declaredOnlyFlags, nullptr, nullptr, realTypes, nullptr);
+          if (pi != nullptr) return pi;
+		}
+		// We know one will be found, but the compiler doesn't.
+		return static_cast<PropertyInfo^>(nullptr);
+	}
+}
+ 
+
+
 // helper function to get values of static and instance properties
 void *Property::getPropertyValue(Object ^o, Type  ^t, const __wchar_t *propertyName, BindingFlags bindingAttr, int nargs, void *args[]) {
   try {
@@ -56,8 +84,9 @@
       realTypes[i] = c->getContainerType();
     }
 
-    // find property by name, binding attributes and index signature
-    PropertyInfo ^pi = t->GetProperty(gcnew String(propertyName), bindingAttr, nullptr, nullptr, realTypes, nullptr);
+    // find property by name, binding attributes and index signature, handling ambiguos property references
+	// by returning the most specific.
+    PropertyInfo ^pi = GetPropertyDisambiguatingSearch(t,gcnew String(propertyName), bindingAttr,realTypes);
 
     if (pi == nullptr)
       throwPropertyNotFoundError(t, propertyName, realTypes, bindingAttr);
@@ -109,7 +138,7 @@
     }
 
     // find property by name, binding attributes and index signature
-    PropertyInfo ^pi = t->GetProperty(gcnew String(propertyName), bindingAttr, nullptr, nullptr, realTypes, nullptr);
+    PropertyInfo ^pi = GetPropertyDisambiguatingSearch(t,gcnew String(propertyName), bindingAttr,realTypes);
 
     if (pi == nullptr)
       throwPropertyNotFoundError(t, propertyName, realTypes, bindingAttr);


From ikvello at common-lisp.net  Fri May  9 14:53:30 2008
From: ikvello at common-lisp.net (ikvello at common-lisp.net)
Date: Fri,  9 May 2008 10:53:30 -0400 (EDT)
Subject: [rdnzl-cvs] r12 - trunk/rdnzl-cpp/RDNZL
Message-ID: <20080509145330.5339B1E0A7@common-lisp.net>

Author: ikvello
Date: Fri May  9 10:53:29 2008
New Revision: 12

Modified:
   trunk/rdnzl-cpp/RDNZL/InvokeMember.cpp
   trunk/rdnzl-cpp/RDNZL/Property.cpp
Log:
Added support for accessing properties and methods of ComObjects with unknown interface (except for IDispatch)

Modified: trunk/rdnzl-cpp/RDNZL/InvokeMember.cpp
==============================================================================
--- trunk/rdnzl-cpp/RDNZL/InvokeMember.cpp	(original)
+++ trunk/rdnzl-cpp/RDNZL/InvokeMember.cpp	Fri May  9 10:53:29 2008
@@ -93,8 +93,21 @@
     }
 
     MethodInfo ^mi = findMethod(t, methodName, realTypes, bindingAttr);
-    if (mi == nullptr)
-      throwMethodNotFoundError(t, methodName, realTypes, bindingAttr);
+	if (mi == nullptr) {
+	  // IOK 2008-05-09 no methodinfo can mean two things: One, that there
+	  // was no method, and second, that we are dealing with a __ComObject
+	  // directly and not through an interface. These objects are sometimes
+      // returned by applications like Excel. We can then call the method
+      // using IDispatch via InvokeMember. But, the returned object will
+	  // also then typically be __ComObject, since we have no MethodInfo
+	  // object to inspect for the return-type. The user must explicitly cast to
+	  // the approprate type.
+		if (!Marshal::IsComObject(o)) throwMethodNotFoundError(t, methodName, realTypes, bindingAttr);
+		String ^name = gcnew String(methodName);
+		Object ^newInstance = t->InvokeMember(name, BindingFlags::InvokeMethod, nullptr, o, realArgs);
+		if (nullptr == newInstance) return new InvocationResult();
+		else return new InvocationResult(newInstance,newInstance->GetType());
+	}
 
     Object ^newInstance = mi->Invoke(o, realArgs);
     

Modified: trunk/rdnzl-cpp/RDNZL/Property.cpp
==============================================================================
--- trunk/rdnzl-cpp/RDNZL/Property.cpp	(original)
+++ trunk/rdnzl-cpp/RDNZL/Property.cpp	Fri May  9 10:53:29 2008
@@ -86,10 +86,21 @@
 
     // find property by name, binding attributes and index signature, handling ambiguos property references
 	// by returning the most specific.
-    PropertyInfo ^pi = GetPropertyDisambiguatingSearch(t,gcnew String(propertyName), bindingAttr,realTypes);
+	String ^propname = gcnew String(propertyName);
+    PropertyInfo ^pi = GetPropertyDisambiguatingSearch(t, propname, bindingAttr,realTypes);
 
-    if (pi == nullptr)
-      throwPropertyNotFoundError(t, propertyName, realTypes, bindingAttr);
+	if (pi == nullptr) {
+		// That the property isn't found either means it isn't there, or that our object was
+		// a __ComObject with no known interface; for which GetProperty does not work :(.
+		if (!Marshal::IsComObject(o)) throwPropertyNotFoundError(t, propertyName, realTypes, bindingAttr);
+		// Oh bother. We have a plain__ComObject, so we have to use InvokeMember, which will return
+		// another  __ComObject with no extra type information - the user must explicitly CAST this
+		// to something useful. IOK 2008-05-08
+		// Won't pass the ParameterModifier and namedParameters arguments to InvokeMember,
+		// it's not supported upstream and also not neccessary I think. IOK 2008-05-08
+		Object ^prop = t->InvokeMember(propname, BindingFlags::GetProperty, nullptr, o, realArgs);
+		return new InvocationResult(prop, prop->GetType());
+	}	
 
     return new InvocationResult(pi->GetValue(o, realArgs), pi->PropertyType);
   } catch (TargetInvocationException ^e) {
@@ -138,10 +149,23 @@
     }
 
     // find property by name, binding attributes and index signature
-    PropertyInfo ^pi = GetPropertyDisambiguatingSearch(t,gcnew String(propertyName), bindingAttr,realTypes);
+	String ^propname = gcnew String(propertyName);
+    PropertyInfo ^pi = GetPropertyDisambiguatingSearch(t,propname, bindingAttr,realTypes);
 
-    if (pi == nullptr)
-      throwPropertyNotFoundError(t, propertyName, realTypes, bindingAttr);
+	if (pi == nullptr) {	
+		// That the property isn't found either means it isn't there, or that our object was
+		// a __ComObject with no known interface; for which GetProperty does not work :(.
+		if (!Marshal::IsComObject(o)) throwPropertyNotFoundError(t, propertyName, realTypes, bindingAttr);
+		// See comments for getPropertyValue. The call below is the same, except that BindingFlags 
+		// are SetProperty, and that the args array needs to have the new values as the
+		// *last* element of the arguments.
+		Object ^newValue = static_cast<DotNetContainer *>(args[0])->getContainerObject();
+		Array::Resize(realArgs,nargs);
+		realArgs->SetValue(newValue,(nargs -1));
+
+		Object ^prop = t->InvokeMember(propname, BindingFlags::SetProperty, nullptr, o, realArgs);
+		return new InvocationResult();
+	}	
 
     // note that the new value is the first element of args
     pi->SetValue(o, static_cast<DotNetContainer *>(args[0])->getContainerObject(), realArgs);


From ikvello at common-lisp.net  Tue May 13 16:08:05 2008
From: ikvello at common-lisp.net (ikvello at common-lisp.net)
Date: Tue, 13 May 2008 12:08:05 -0400 (EDT)
Subject: [rdnzl-cvs] r13 - in trunk/rdnzl: . examples
Message-ID: <20080513160805.005F23001D@common-lisp.net>

Author: ikvello
Date: Tue May 13 12:08:05 2008
New Revision: 13

Modified:
   trunk/rdnzl/RDNZL.dll
   trunk/rdnzl/examples/excel.lisp
Log:
RDNZL.dll compiled with recent changes and examples updated

Modified: trunk/rdnzl/RDNZL.dll
==============================================================================
Binary files. No diff available.

Modified: trunk/rdnzl/examples/excel.lisp
==============================================================================
--- trunk/rdnzl/examples/excel.lisp	(original)
+++ trunk/rdnzl/examples/excel.lisp	Tue May 13 12:08:05 2008
@@ -78,16 +78,15 @@
 (defun get-excel-range (file-name range)
   (let* ((app (new "ApplicationClass"))
          (workbooks [%Workbooks app])
-         (workbook (cast [Open workbooks file-name
+         (workbook [Open workbooks file-name
                                +missing+ nil +missing+
                                +missing+ +missing+ +missing+
                                +missing+ +missing+ +missing+
                                +missing+ +missing+ +missing+
-                               +missing+ +missing+]
-                         "WorkbookClass"))
+                               +missing+ +missing+])
          (worksheets [%Worksheets workbook])
-         (sheet (cast [get_Item worksheets 1] "Worksheet"))
-         (range [get_Range sheet range +missing+]))
+         (sheet [%Item worksheets 1])
+         (range [%Range sheet range +missing+]))
     (prog1 (cast [%Value2 [%Cells range]] "System.Array")
       [Quit app])))