1 /**
2  * The variant module contains a variant, or polymorphic type.
3  *
4  * Copyright: Copyright (C) 2005-2009 The Tango Team.  All rights reserved.
5  * License:   BSD style: $(LICENSE)
6  * Authors:   Daniel Keep, Sean Kelly
7  */
8 module tango.core.Variant;
9 
10 private import tango.core.Memory : GC;
11 private import tango.core.Vararg;
12 private import tango.core.Traits;
13 private import tango.core.Tuple;
14 
15 private import tango.core.Compiler;
16 
17 private extern(C) Object _d_toObject(void*);
18 
19 /*
20  * This is to control when we compile in vararg support.  Vararg is a complete
21  * pain in the arse.  I haven't been able to test under GDC at all (and
22  * support for it may disappear soon anyway) and LDC refuses to build for me.
23  *
24  * As other compilers are tested and verified to work, they should be added
25  * below.  It would also probably be a good idea to verify the platforms for
26  * which it works.
27  */
28 
29 version( DigitalMars )
30 {
31     version( X86 )
32     {
33         version( Windows )
34         {
35             version=EnableVararg;
36         }
37         else version( Posix )
38         {
39             version=EnableVararg;
40         }
41     }
42     version( X86_64 )
43     {
44         version( Windows )
45         {
46             version=EnableVararg;
47         }
48         else version( Posix )
49         {
50             version=EnableVararg;
51         }
52 
53         version = DigitalMarsX64;
54 
55         import tango.math.Math : max;
56 
57     }
58 }
59 else version( LDC )
60 {
61     version( X86 )
62     {
63         version( linux )
64         {
65             version=EnableVararg; // thanks rawler
66         }
67     }
68     else version( X86_64 )
69     {
70         version( linux )
71         {
72             version=EnableVararg; // thanks mwarning
73         }
74 
75         import tango.math.Math : max;
76     }
77 }
78 else version( DDoc )
79 {
80     // Let's hope DDoc is smart enough to catch this...
81     version=EnableVararg;
82 }
83 
84 version( EnableVararg ) {} else
85 {
86     pragma(msg, "Note: Variant vararg functionality not supported for this "
87             "compiler/platform combination.");
88     pragma(msg, "To override and enable vararg support anyway, compile with "
89             "the EnableVararg version.");
90 }
91 
92 private
93 {
94     /*
95      * This is used to store the actual value being kept in a Variant.
96      */
97     struct VariantStorage
98     {
99         union
100         {
101             /*
102              * Contains heap-allocated storage for values which are too large
103              * to fit into the Variant directly.
104              */
105             void[] heap;
106 
107             /*
108              * Used to store arrays directly.  Note that this is NOT an actual
109              * array; using a void[] causes the length to change, which screws
110              * up the ptr() property.
111              *
112              * WARNING: this structure MUST match the ABI for arrays for this
113              * platform.  AFAIK, all compilers implement arrays this way.
114              * There needs to be a case in the unit test to ensure this.
115              */
116             struct Array
117             {
118                 size_t length;
119                 const(void)* ptr;
120             }
121             Array array;
122 
123             // Used to simplify dealing with objects.
124             Object obj;
125 
126             // Used to address storage as an array.
127             ubyte[array.sizeof] data;
128         }
129 
130         /*
131          * This is used to set the array structure safely.  We're essentially
132          * just ensuring that if a garbage collection happens mid-assign, we
133          * don't accidentally mark bits of memory we shouldn't.
134          *
135          * Of course, the compiler could always re-order the length and ptr
136          * assignment.  Oh well.
137          */
138         void setArray(const(void)* ptr, size_t length)
139         {
140             array.length = 0;
141             array.ptr = ptr;
142             array.length = length;
143         }
144     }
145 
146     // Determines if the given type is an Object (class) type.
147     template isObject(T)
148     {
149         static if( is( T : Object ) )
150             const isObject = true;
151         else
152             const isObject = false;
153     }
154 
155     // Determines if the given type is an interface
156     template isInterface(T)
157     {
158         static if( is( T == interface ) )
159             const isInterface = true;
160         else
161             const isInterface = false;
162     }
163 
164     // A list of all basic types
165     alias Tuple!(bool, char, wchar, dchar,
166             byte, short, int, long, //cent,
167             ubyte, ushort, uint, ulong, //ucent,
168             float, double, real,
169             ifloat, idouble, ireal,
170             cfloat, cdouble, creal) BasicTypes;
171 
172     // see isBasicType
173     template isBasicTypeImpl(T, U)
174     {
175         const isBasicTypeImpl = is( T == U );
176     }
177 
178     // see isBasicType
179     template isBasicTypeImpl(T, U, Us...)
180     {
181         static if( is( T == U ) )
182             const isBasicTypeImpl = true;
183         else
184             const isBasicTypeImpl = isBasicTypeImpl!(T, Us);
185     }
186 
187     // Determines if the given type is one of the basic types.
188     template isBasicType(T)
189     {
190         const isBasicType = isBasicTypeImpl!(T, BasicTypes);
191     }
192 
193     /*
194      * Used to determine if we can cast a value of the given TypeInfo to the
195      * specified type implicitly.  This should be somewhat faster than the
196      * version in RuntimeTraits since we can basically eliminate half of the
197      * tests.
198      */
199     bool canImplicitCastToType(dsttypeT)(TypeInfo srctype)
200     {
201         /*
202          * Before we do anything else, we need to "unwrap" typedefs to
203          * get at the real type.  While we do that, make sure we don't
204          * accidentally jump over the destination type.
205          */
206         while( cast(TypeInfo_Typedef) srctype !is null )
207         {
208             if( srctype is typeid(dsttypeT) )
209                 return true;
210             srctype = cast()srctype.next;
211         }
212 
213         /*
214          * First, we'll generate tests for the basic types.  The list of
215          * things which can be cast TO basic types is finite and easily
216          * computed.
217          */
218         foreach( T ; BasicTypes )
219         {
220             // If the current type is the target...
221             static if( is( dsttypeT == T ) )
222             {
223                 // ... then for all of the other basic types ...
224                 foreach( U ; BasicTypes )
225                 {
226                     static if
227                     (
228                         // ... if that type is smaller than ...
229                         U.sizeof < T.sizeof
230 
231                         // ... or the same size and signed-ness ...
232                         || ( U.sizeof == T.sizeof &&
233                             ((isCharType!(T) || isUnsignedIntegerType!(T))
234                              ^ !(isCharType!(U) || isUnsignedIntegerType!(U)))
235                         )
236                     )
237                     {
238                         // ... test.
239                         if( srctype is typeid(U) )
240                             return true;
241                     }
242                 }
243                 // Nothing matched; no implicit casting.
244                 return false;
245             }
246         }
247 
248         /*
249          * Account for static arrays being implicitly convertible to dynamic
250          * arrays.
251          */
252         static if( is( T[] : dsttypeT ) )
253         {
254             if( typeid(T[]) is srctype )
255                 return true;
256 
257             if( auto ti_sa = cast(TypeInfo_StaticArray) srctype )
258                 return ti_sa.next is typeid(T);
259 
260             return false;
261         }
262 
263         /*
264          * Any pointer can be cast to void*.
265          */
266         else static if( is( dsttypeT == void* ) )
267             return (cast(TypeInfo_Pointer) srctype) !is null;
268 
269         /*
270          * Any array can be cast to void[], however remember that it has to
271          * be manually adjusted to preserve the correct length.
272          */
273         else static if( is( dsttypeT == void[] ) )
274             return ((cast(TypeInfo_Array) srctype) !is null)
275                 || ((cast(TypeInfo_StaticArray) srctype) !is null);
276 
277         else return false;
278     }
279 
280     /*
281      * Aliases itself to the type used to return a value of type T out of a
282      * function.  This is basically a work-around for not being able to return
283      * static arrays.
284      */
285     template returnT(T)
286     {
287         static if( isStaticArrayType!(T) )
288             alias typeof(T.dup) returnT;
289         else
290             alias T returnT;
291     }
292 
293     /*
294      * Here are some tests that perform runtime versions of the compile-time
295      * traits functions.
296      */
297 
298     bool isBasicTypeInfo(TypeInfo ti)
299     {
300         foreach( T ; BasicTypes )
301             if( ti is typeid(T) )
302                 return true;
303         return false;
304     }
305 
306     private import RuntimeTraits = tango.core.RuntimeTraits;
307 
308     alias RuntimeTraits.isStaticArray isStaticArrayTypeInfo;
309     alias RuntimeTraits.isClass isObjectTypeInfo;
310     alias RuntimeTraits.isInterface isInterfaceTypeInfo;
311 }
312 
313 /**
314  * This exception is thrown whenever you attempt to get the value of a Variant
315  * without using a compatible type.
316  */
317 class VariantTypeMismatchException : Exception
318 {
319     this(TypeInfo expected, TypeInfo got)
320     {
321         super("cannot convert "~expected.toString()
322                     ~" value to a "~got.toString());
323     }
324 }
325 
326 /**
327  * This exception is thrown when you attempt to use an empty Variant with
328  * varargs.
329  */
330 class VariantVoidVarargException : Exception
331 {
332     this()
333     {
334         super("cannot use Variants containing a void with varargs");
335     }
336 }
337 
338 /**
339  * The Variant type is used to dynamically store values of different types at
340  * runtime.
341  *
342  * You can create a Variant using either the pseudo-constructor or direct
343  * assignment.
344  *
345  * -----
346  *  Variant v = Variant(42);
347  *  v = "abc";
348  * -----
349  */
350 struct Variant
351 {
352     /**
353      * This pseudo-constructor is used to place a value into a new Variant.
354      *
355      * Params:
356      *  value = The value you wish to put in the Variant.
357      *
358      * Returns:
359      *  The new Variant.
360      *
361      * Example:
362      * -----
363      *  auto v = Variant(42);
364      * -----
365      */
366     static Variant opCall(T)(T value)
367     {
368         Variant _this;
369 
370         static if( isStaticArrayType!(T) )
371             _this = value.dup;
372 
373         else
374             _this = value;
375 
376         return _this;
377     }
378 
379     /**
380      * This pseudo-constructor creates a new Variant using a specified
381      * TypeInfo and raw pointer to the value.
382      *
383      * Params:
384      *  type = Type of the value.
385      *  ptr  = Pointer to the value.
386      *
387      * Returns:
388      *  The new Variant.
389      *
390      * Example:
391      * -----
392      *  int life = 42;
393      *  auto v = Variant(typeid(typeof(life)), &life);
394      * -----
395      */
396     static Variant opCall()(TypeInfo type, void* ptr)
397     {
398         Variant _this;
399         Variant.fromPtr(type, ptr, _this);
400         return _this;
401     }
402 
403     /**
404      * This operator allows you to assign arbitrary values directly into an
405      * existing Variant.
406      *
407      * Params:
408      *  value = The value you wish to put in the Variant.
409      *
410      * Returns:
411      *  The new value of the assigned-to variant.
412      *
413      * Example:
414      * -----
415      *  Variant v;
416      *  v = 42;
417      * -----
418      */
419     Variant opAssign(T)(T value)
420     {
421         static if( isStaticArrayType!(T) )
422         {
423             return (this = value.dup);
424         }
425         else static if( is(T == Variant) )
426         {
427             type = value.type;
428             this.value = value.value;
429             return this;
430         }
431         else
432         {
433             type = typeid(T);
434 
435             static if( isDynamicArrayType!(T) )
436             {
437                 this.value.setArray(value.ptr, value.length);
438             }
439             else static if( isInterface!(T) )
440             {
441                 this.value.obj = cast(Object) value;
442             }
443             else
444             {
445                 /*
446                  * If the value is small enough to fit in the storage
447                  * available, do so.  If it isn't, then make a heap copy.
448                  *
449                  * Obviously, this pretty clearly breaks value semantics for
450                  * large values, but without a postblit operator, there's not
451                  * much we can do.  :(
452                  */
453                 static if( T.sizeof <= this.value.data.length )
454                 {
455                     this.value.data[0..T.sizeof] =
456                         (cast(ubyte*)&value)[0..T.sizeof];
457                 }
458                 else
459                 {
460                     auto buffer = (cast(ubyte*)&value)[0..T.sizeof].dup;
461                     this.value.heap = cast(void[])buffer;
462                 }
463             }
464             return this;
465         }
466     }
467 
468     /**
469      * This member can be used to determine if the value stored in the Variant
470      * is of the specified type.  Note that this comparison is exact: it does
471      * not take implicit casting rules into account.
472      *
473      * Returns:
474      *  true if the Variant contains a value of type T, false otherwise.
475      *
476      * Example:
477      * -----
478      *  auto v = Variant(cast(int) 42);
479      *  assert(   v.isA!(int) );
480      *  assert( ! v.isA!(short) ); // note no implicit conversion
481      * -----
482      */
483     @property bool isA(T)()
484     {
485         return cast(bool)(typeid(T) is type);
486     }
487 
488     /**
489      * This member can be used to determine if the value stored in the Variant
490      * is of the specified type.  This comparison attempts to take implicit
491      * conversion rules into account.
492      *
493      * Returns:
494      *  true if the Variant contains a value of type T, or if the Variant
495      *  contains a value that can be implicitly cast to type T; false
496      *  otherwise.
497      *
498      * Example:
499      * -----
500      *  auto v = Variant(cast(int) 42);
501      *  assert( v.isA!(int) );
502      *  assert( v.isA!(short) ); // note implicit conversion
503      * -----
504      */
505     @property bool isImplicitly(T)()
506     {
507         static if( is( T == class ) || is( T == interface ) )
508         {
509             // Check for classes and interfaces first.
510             if( cast(TypeInfo_Class) type || cast(TypeInfo_Interface) type )
511                 return (cast(T) value.obj) !is null;
512 
513             else
514                 // We're trying to cast TO an object, but we don't have
515                 // an object stored.
516                 return false;
517         }
518         else
519         {
520             // Test for basic types (oh, and dynamic->static arrays and
521             // pointers.)
522             return ( cast(bool)(typeid(T) is type)
523                     || canImplicitCastToType!(T)(type) );
524         }
525     }
526 
527     /**
528      * This determines whether the Variant has an assigned value or not.  It
529      * is simply short-hand for calling the isA member with a type of void.
530      *
531      * Returns:
532      *  true if the Variant does not contain a value, false otherwise.
533      */
534     @property bool isEmpty()
535     {
536         return isA!(void);
537     }
538 
539     /**
540      * This member will clear the Variant, returning it to an empty state.
541      */
542     void clear()
543     {
544         _type = typeid(void);
545         value = value.init;
546     }
547 
548     version( DDoc )
549     {
550         /**
551          * This is the primary mechanism for extracting a value from a Variant.
552          * Given a destination type S, it will attempt to extract the value of the
553          * Variant into that type.  If the value contained within the Variant
554          * cannot be implicitly cast to the given type S, it will throw an
555          * exception.
556          *
557          * You can check to see if this operation will fail by calling the
558          * isImplicitly member with the type S.
559          *
560          * Note that attempting to get a statically-sized array will result in a
561          * dynamic array being returned; this is a language limitation.
562          *
563          * Returns:
564          *  The value stored within the Variant.
565          */
566         @property T get(T)()
567         {
568             // For actual implementation, see below.
569         }
570     }
571     else
572     {
573         @property returnT!(S) get(S)()
574         {
575             alias returnT!(S) T;
576 
577             // If we're not dealing with the exact same type as is being
578             // stored, we fail NOW if the type in question isn't an object (we
579             // can let the runtime do the test) and if it isn't something we
580             // know we can implicitly cast to.
581             if( type !is typeid(T)
582                     // Let D do runtime check itself
583                     && !isObject!(T)
584                     && !isInterface!(T)
585 
586                     // Allow implicit upcasts
587                     && !canImplicitCastToType!(T)(type)
588               )
589                 throw new VariantTypeMismatchException(type,typeid(T));
590 
591             // Handle basic types, since they account for most of the implicit
592             // casts.
593             static if( isBasicType!(T) )
594             {
595                 if( type is typeid(T) )
596                 {
597                     // We got lucky; the types match exactly.  If the type is
598                     // small, grab it out of storage; otherwise, copy it from
599                     // the heap.
600                     static if( T.sizeof <= value.sizeof )
601                         return *cast(T*)(&value);
602 
603                     else
604                         return *cast(T*)(value.heap.ptr);
605                 }
606                 else
607                 {
608                     // This handles implicit coercion.  What it does is finds
609                     // the basic type U which is actually being stored.  It
610                     // then unpacks the value of type U stored in the Variant
611                     // and casts it to type T.
612                     //
613                     // It is assumed that this is valid to perform since we
614                     // should have already eliminated invalid coercions.
615                     foreach( U ; BasicTypes )
616                     {
617                         if( type is typeid(U) )
618                         {
619                             static if( U.sizeof <= value.sizeof )
620                                 return cast(T) *cast(U*)(&value);
621 
622                             else
623                                 return cast(T) *cast(U*)(value.heap.ptr);
624                         }
625                     }
626                     throw new VariantTypeMismatchException(type,typeid(T));
627                 }
628             }
629             else static if( isDynamicArrayType!(T) )
630             {
631                 return (cast(typeof(T.init.ptr)) value.array.ptr)
632                     [0..value.array.length];
633             }
634             else static if( isObject!(T) || isInterface!(T) )
635             {
636                 return cast(T)this.value.obj;
637             }
638             else
639             {
640                 static if( T.sizeof <= this.value.data.length )
641                 {
642                     T result;
643                     (cast(ubyte*)&result)[0..T.sizeof] =
644                         this.value.data[0..T.sizeof];
645                     return result;
646                 }
647                 else
648                 {
649                     T result;
650                     (cast(ubyte*)&result)[0..T.sizeof] =
651                         (cast(ubyte[])this.value.heap)[0..T.sizeof];
652                     return result;
653                 }
654             }
655         }
656     }
657 
658     /**
659      * The following operator overloads are defined for the sake of
660      * convenience.  It is important to understand that they do not allow you
661      * to use a Variant as both the left-hand and right-hand sides of an
662      * expression.  One side of the operator must be a concrete type in order
663      * for the Variant to know what code to generate.
664      */
665     auto opBinary(immutable(char)[] op, T)(T rhs)
666     {
667         mixin("return get!(T) " ~ op ~ " rhs;");
668     }
669     
670     auto opBinaryRight(immutable(char)[] op, T)(T lhs)
671     {
672         mixin("return lhs " ~ op ~ " get!(T);");
673     }
674     
675     Variant opOpAssign(immutable(char)[] op, T)(T value)
676     {
677         mixin("return (this = get!(T) " ~ op ~ " value);"); 
678     }
679 
680     /**
681      * The following operators can be used with Variants on both sides.  Note
682      * that these operators do not follow the standard rules of
683      * implicit conversions.
684      */
685     int opEquals(T)(T rhs)
686     {
687         static if( is( T == Variant ) )
688             return opEqualsVariant(rhs);
689 
690         else
691             return get!(T) == rhs;
692     }
693 
694     /* This opCmp is not detectable as one for the purposes of TypeInfo_Struct.xopCmp.
695      * Try doing opCmp(const ref Variant) and opCmp(...). My tests indicate that this may work. */
696     /// ditto
697     int opCmp(T)(T rhs)
698     {
699         static if( is( T == Variant ) )
700             return opCmpVariant(rhs);
701         else
702         {
703             auto lhs = get!(T);
704             return (lhs < rhs) ? -1 : (lhs == rhs) ? 0 : 1;
705         }
706     }
707 
708     /// ditto
709     hash_t toHash()
710     {
711         return type.getHash(this.ptr);
712     }
713 
714     /**
715      * Returns a string representation of the type being stored in this
716      * Variant.
717      *
718      * Returns:
719      *  The string representation of the type contained within the Variant.
720      */
721     string toString()
722     {
723         return type.toString();
724     }
725 
726     /**
727      * This can be used to retrieve the TypeInfo for the currently stored
728      * value.
729      */
730     @property TypeInfo type()
731     {
732         return _type;
733     }
734 
735     /**
736      * This can be used to retrieve a pointer to the value stored in the
737      * variant.
738      */
739     @property void* ptr()
740     {
741         if( type.tsize <= value.sizeof )
742             return &value;
743 
744         else
745             return value.heap.ptr;
746     }
747 
748     version( EnableVararg )
749     {
750         /**
751          * Converts a vararg function argument list into an array of Variants.
752          */
753         static Variant[] fromVararg(TypeInfo[] types, void* args)
754         {
755             auto vs = new Variant[](types.length);
756 
757             foreach( i, ref v ; vs )
758             {
759                 version(DigitalMarsX64)
760                 {
761                     scope void[] buffer = new void[types[i].tsize];
762                     va_arg(cast(va_list)args, types[i], buffer.ptr);
763                     Variant.fromPtr(types[i], buffer.ptr, v);
764                 }
765                 else
766                 {
767                     args = Variant.fromPtr(types[i], args, v);
768                 }
769             }
770 
771             return vs;
772         }
773 
774         /// ditto
775         static Variant[] fromVararg(...)
776         {
777             version(DigitalMarsX64)
778             {
779                 va_list ap;
780                 va_start(ap, __va_argsave);
781 
782                 scope (exit) va_end(ap);
783 
784                 return Variant.fromVararg(_arguments, ap);
785             }
786             else
787                 return Variant.fromVararg(_arguments, _argptr);
788         }
789 
790         /+
791         /**
792          * Converts an array of Variants into a vararg function argument list.
793          *
794          * This will allocate memory to store the arguments in; you may destroy
795          * this memory when you are done with it if you feel so inclined.
796          */
797         deprecated static void toVararg(Variant[] vars, out TypeInfo[] types, out va_list args)
798         {
799             // First up, compute the total amount of space we'll need.  While
800             // we're at it, work out if any of the values we're storing have
801             // pointers.  If they do, we'll need to tell the GC.
802             size_t size = 0;
803             bool noptr = true;
804             foreach( ref v ; vars )
805             {
806                 auto ti = v.type;
807                 size += (ti.tsize + size_t.sizeof-1) & ~(size_t.sizeof-1);
808                 noptr = noptr && (ti.flags & 2);
809             }
810 
811             // Create the storage, and tell the GC whether it needs to be scanned
812             // or not.
813             auto storage = new ubyte[size];
814             GC.setAttr(storage.ptr,
815                 (GC.getAttr(storage.ptr) & ~GC.BlkAttr.NO_SCAN)
816                 | (noptr ? GC.BlkAttr.NO_SCAN : 0));
817 
818             // Dump the variants into the storage.
819             args = storage.ptr;
820             auto arg_temp = args;
821 
822             types = new TypeInfo[vars.length];
823 
824             foreach( i, ref v ; vars )
825             {
826                 types[i] = v.type;
827                 arg_temp = v.toPtr(arg_temp);
828             }
829         }
830         +/
831     } // version( EnableVararg )
832 
833 private:
834     TypeInfo _type = typeid(void);
835     VariantStorage value;
836 
837     @property TypeInfo type(TypeInfo v)
838     {
839         return (_type = v);
840     }
841 
842     /*
843      * Creates a Variant using a given TypeInfo and a void*.  Returns the
844      * given pointer adjusted for the next vararg.
845      */
846     static void* fromPtr(TypeInfo type, void* ptr, out Variant r)
847     {
848         /*
849          * This function basically duplicates the functionality of
850          * opAssign, except that we can't generate code based on the
851          * type of the data we're storing.
852          */
853 
854         if( type is typeid(void) )
855             throw new VariantVoidVarargException;
856 
857         r.type = type;
858 
859         if( isStaticArrayTypeInfo(type) )
860         {
861             /*
862              * Static arrays are passed by-value; for example, if type is
863              * typeid(int[4]), then ptr is a pointer to 16 bytes of memory
864              * (four 32-bit integers).
865              *
866              * It's possible that the memory being pointed to is on the
867              * stack, so we need to copy it before storing it.  type.tsize
868              * tells us exactly how many bytes we need to copy.
869              *
870              * Sadly, we can't directly construct the dynamic array version
871              * of type.  We'll store the static array type and cope with it
872              * in isImplicitly(S) and get(S).
873              */
874             r.value.heap = ptr[0 .. type.tsize].dup;
875         }
876         else
877         {
878             if( isObjectTypeInfo(type)
879                 || isInterfaceTypeInfo(type) )
880             {
881                 /*
882                  * We have to call into the core runtime to turn this pointer
883                  * into an actual Object reference.
884                  */
885                 r.value.obj = _d_toObject(*cast(void**)ptr);
886             }
887             else
888             {
889                 if( type.tsize <= this.value.data.length )
890                 {
891                     // Copy into storage
892                     r.value.data[0 .. type.tsize] =
893                         (cast(ubyte*)ptr)[0 .. type.tsize];
894                 }
895                 else
896                 {
897                     // Store in heap
898                     auto buffer = (cast(ubyte*)ptr)[0 .. type.tsize].dup;
899                     r.value.heap = cast(void[])buffer;
900                 }
901             }
902         }
903 
904         // Compute the "advanced" pointer.
905         return ptr + ( (type.tsize + size_t.sizeof-1) & ~(size_t.sizeof-1) );
906     }
907 
908     /+version( EnableVararg )
909     {
910         /*
911          * Takes the current Variant, and dumps its contents into memory pointed
912          * at by a void*, suitable for vararg calls.
913          *
914          * It also returns the supplied pointer adjusted by the size of the data
915          * written to memory.
916          */
917         void* toPtr(void* ptr)
918         {
919             version( GNU )
920             {
921                 pragma(msg, "WARNING: tango.core.Variant's vararg support has "
922                         "not been tested with this compiler." );
923             }
924             version( LDC )
925             {
926                 pragma(msg, "WARNING: tango.core.Variant's vararg support has "
927                         "not been tested with this compiler." );
928             }
929 
930             if( type is typeid(void) )
931                 throw new VariantVoidVarargException;
932 
933             if( isStaticArrayTypeInfo(type) )
934             {
935                 // Just dump straight
936                 ptr[0 .. type.tsize] = this.value.heap[0 .. type.tsize];
937             }
938             else
939             {
940                 if( isInterfaceTypeInfo(type) )
941                 {
942                     /*
943                      * This is tricky.  What we actually have stored in
944                      * value.obj is an Object, not an interface.  What we
945                      * need to do is manually "cast" value.obj to the correct
946                      * interface.
947                      *
948                      * We have the original interface's TypeInfo.  This gives us
949                      * the interface's ClassInfo.  We can also obtain the object's
950                      * ClassInfo which contains a list of Interfaces.
951                      *
952                      * So what we need to do is loop over the interfaces obj
953                      * implements until we find the one we're interested in.  Then
954                      * we just read out the interface's offset and adjust obj
955                      * accordingly.
956                      */
957                     auto type_i = cast(TypeInfo_Interface) type;
958                     bool found = false;
959                     foreach( i ; this.value.obj.classinfo.interfaces )
960                     {
961                         if( i.classinfo is type_i.info )
962                         {
963                             // Found it
964                             void* i_ptr = (cast(void*) this.value.obj) + i.offset;
965                             *cast(void**)ptr = i_ptr;
966                             found = true;
967                             break;
968                         }
969                     }
970                     assert(found,"Could not convert Object to interface; "
971                             "bad things have happened.");
972                 }
973                 else
974                 {
975                     if( type.tsize <= this.value.data.length )
976                     {
977                         // Value stored in storage
978                         ptr[0 .. type.tsize] = this.value.data[0 .. type.tsize];
979                     }
980                     else
981                     {
982                         // Value stored on heap
983                         ptr[0 .. type.tsize] = this.value.heap[0 .. type.tsize];
984                     }
985                 }
986             }
987 
988             // Compute the "advanced" pointer.
989             return ptr + ( (type.tsize + size_t.sizeof-1) & ~(size_t.sizeof-1) );
990         }
991     } // version( EnableVararg )
992     +/
993 
994     /*
995      * Performs a type-dependant comparison.  Note that this obviously doesn't
996      * take into account things like implicit conversions.
997      */
998     int opEqualsVariant(Variant rhs)
999     {
1000         if( type != rhs.type ) return false;
1001         return cast(bool) type.equals(this.ptr, rhs.ptr);
1002     }
1003 
1004     /*
1005      * Same as opEqualsVariant except it does opCmp.
1006      */
1007     int opCmpVariant(Variant rhs)
1008     {
1009         if( type != rhs.type )
1010             throw new VariantTypeMismatchException(type, rhs.type);
1011         return type.compare(this.ptr, rhs.ptr);
1012     }
1013 }
1014 
1015 debug( UnitTest )
1016 {
1017     /*
1018      * Language tests.
1019      */
1020 
1021     unittest
1022     {
1023         {
1024             int[2] a;
1025             void[] b = a;
1026             int[]  c = cast(int[]) b;
1027             assert( b.length == 2*int.sizeof );
1028             assert( c.length == a.length );
1029         }
1030 
1031         {
1032             struct A { size_t l; void* p; }
1033             const(char)[] b = "123";
1034             A a = *cast(A*)(&b);
1035 
1036             assert( a.l == b.length );
1037             assert( a.p == b.ptr );
1038         }
1039     }
1040 
1041     /*
1042      * Basic tests.
1043      */
1044 
1045     unittest
1046     {
1047         Variant v;
1048         assert( v.isA!(void), v.type.toString() );
1049         assert( v.isEmpty, v.type.toString() );
1050 
1051         // Test basic integer storage and implicit casting support
1052         v = 42;
1053         assert( v.isA!(int), v.type.toString() );
1054         assert( v.isImplicitly!(long), v.type.toString() );
1055         assert( v.isImplicitly!(ulong), v.type.toString() );
1056         assert( !v.isImplicitly!(uint), v.type.toString() );
1057         assert( v.get!(int) == 42 );
1058         assert( v.get!(long) == 42L );
1059         assert( v.get!(ulong) == 42uL );
1060 
1061         // Test clearing
1062         v.clear();
1063         assert( v.isA!(void), v.type.toString() );
1064         assert( v.isEmpty, v.type.toString() );
1065 
1066         // Test strings
1067         v = "Hello, World!"c;
1068         assert( v.isA!(immutable(char)[]), v.type.toString() );
1069         assert( !v.isImplicitly!(wchar[]), v.type.toString() );
1070         assert( v.get!(immutable(char)[]) == "Hello, World!" );
1071 
1072         // Test array storage
1073         v = [1,2,3,4,5];
1074         assert( v.isA!(int[]), v.type.toString() );
1075         assert( v.get!(int[]) == [1,2,3,4,5] );
1076 
1077         // Make sure arrays are correctly stored so that .ptr works.
1078         {
1079             int[] a = [1,2,3,4,5];
1080             v = a;
1081             auto b = *cast(int[]*)(v.ptr);
1082 
1083             assert( a.ptr == b.ptr );
1084             assert( a.length == b.length );
1085         }
1086 
1087         // Test pointer storage
1088         v = &v;
1089         assert( v.isA!(Variant*), v.type.toString() );
1090         assert( !v.isImplicitly!(int*), v.type.toString() );
1091         assert( v.isImplicitly!(void*), v.type.toString() );
1092         assert( v.get!(Variant*) == &v );
1093 
1094         // Test object storage
1095         {
1096             scope o = new Object;
1097             v = o;
1098             assert( v.isA!(Object), v.type.toString() );
1099             assert( v.get!(Object) is o );
1100         }
1101 
1102         // Test interface support
1103         {
1104             interface A {}
1105             interface B : A {}
1106             class C : B {}
1107             class D : C {}
1108 
1109             A a = new D;
1110             Variant v2 = a;
1111             B b = v2.get!(B);
1112             C c = v2.get!(C);
1113             D d = v2.get!(D);
1114         }
1115 
1116         // Test class/interface implicit casting
1117         {
1118             class G {}
1119             interface H {}
1120             class I : G {}
1121             class J : H {}
1122             struct K {}
1123 
1124             scope a = new G;
1125             scope c = new I;
1126             scope d = new J;
1127             K e;
1128 
1129             Variant v2 = a;
1130             assert( v2.isImplicitly!(Object), v2.type.toString() );
1131             assert( v2.isImplicitly!(G), v2.type.toString() );
1132             assert(!v2.isImplicitly!(I), v2.type.toString() );
1133 
1134             v2 = c;
1135             assert( v2.isImplicitly!(Object), v2.type.toString() );
1136             assert( v2.isImplicitly!(G), v2.type.toString() );
1137             assert( v2.isImplicitly!(I), v2.type.toString() );
1138 
1139             v2 = d;
1140             assert( v2.isImplicitly!(Object), v2.type.toString() );
1141             assert(!v2.isImplicitly!(G), v2.type.toString() );
1142             assert( v2.isImplicitly!(H), v2.type.toString() );
1143             assert( v2.isImplicitly!(J), v2.type.toString() );
1144 
1145             v2 = e;
1146             assert(!v2.isImplicitly!(Object), v2.type.toString() );
1147         }
1148 
1149         // Test doubles and implicit casting
1150         v = 3.1413;
1151         assert( v.isA!(double), v.type.toString() );
1152         assert( v.isImplicitly!(real), v.type.toString() );
1153         assert( !v.isImplicitly!(float), v.type.toString() );
1154         assert( v.get!(double) == 3.1413 );
1155 
1156         // Test storage transitivity
1157         auto u = Variant(v);
1158         assert( u.isA!(double), u.type.toString() );
1159         assert( u.get!(double) == 3.1413 );
1160 
1161         // Test operators
1162         v = 38;
1163         assert( v + 4 == 42 );
1164         assert( 4 + v == 42 );
1165         assert( v - 4 == 34 );
1166         assert( 4 - v == -34 );
1167         assert( v * 2 == 76 );
1168         assert( 2 * v == 76 );
1169         assert( v / 2 == 19 );
1170         assert( 2 / v == 0 );
1171         assert( v % 2 == 0 );
1172         assert( 2 % v == 2 );
1173         assert( (v & 6) == 6 );
1174         assert( (6 & v) == 6 );
1175         assert( (v | 9) == 47 );
1176         assert( (9 | v) == 47 );
1177         assert( (v ^ 5) == 35 );
1178         assert( (5 ^ v) == 35 );
1179         assert( v << 1 == 76 );
1180         assert( 1 << Variant(2) == 4 );
1181         assert( v >> 1 == 19 );
1182         assert( 4 >> Variant(2) == 1 );
1183 
1184         assert( Variant("abc") ~ "def" == "abcdef" );
1185         assert( "abc" ~ Variant("def") == "abcdef" );
1186 
1187         // Test op= operators
1188         v = 38; v += 4; assert( v == 42 );
1189         v = 38; v -= 4; assert( v == 34 );
1190         v = 38; v *= 2; assert( v == 76 );
1191         v = 38; v /= 2; assert( v == 19 );
1192         v = 38; v %= 2; assert( v == 0 );
1193         v = 38; v &= 6; assert( v == 6 );
1194         v = 38; v |= 9; assert( v == 47 );
1195         v = 38; v ^= 5; assert( v == 35 );
1196         v = 38; v <<= 1; assert( v == 76 );
1197         v = 38; v >>= 1; assert( v == 19 );
1198 
1199         v = "abc"; v ~= "def"; assert( v == "abcdef" );
1200 
1201         // Test comparison
1202         assert( Variant(0) < Variant(42) );
1203         assert( Variant(42) > Variant(0) );
1204         assert( Variant(21) == Variant(21) );
1205         assert( Variant(0) != Variant(42) );
1206         assert( Variant("bar") == Variant("bar") );
1207         assert( Variant("foo") != Variant("bar") );
1208 
1209         // Test variants as AA keys
1210         static if(DMDFE_Version != 2065 && DMDFE_Version != 2066)
1211         {
1212             {
1213                 auto v1 = Variant(42);
1214                 auto v2 = Variant("foo");
1215                 auto v3 = Variant(1+2.0i);
1216 
1217                 int[Variant] hash;
1218                 hash[v1] = 0;
1219                 hash[v2] = 1;
1220                 hash[v3] = 2;
1221 
1222                 assert( hash[v1] == 0 );
1223                 assert( hash[v2] == 1 );
1224                 assert( hash[v3] == 2 );
1225             }
1226         }
1227 
1228         // Test AA storage
1229         {
1230             int[char[]] hash;
1231             hash["a"] = 1;
1232             hash["b"] = 2;
1233             hash["c"] = 3;
1234             Variant vhash = hash;
1235 
1236             assert( vhash.get!(int[char[]])["a"] == 1 );
1237             assert( vhash.get!(int[char[]])["b"] == 2 );
1238             assert( vhash.get!(int[char[]])["c"] == 3 );
1239         }
1240     }
1241 
1242     /*
1243      * Vararg tests.
1244      */
1245 
1246     version( EnableVararg )
1247     {
1248         private import tango.core.Vararg;
1249 
1250         unittest
1251         {
1252             class A
1253             {
1254                 @property const(char)[] msg() { return "A"; }
1255             }
1256             class B : A
1257             {
1258                 @property override const(char)[] msg() { return "B"; }
1259             }
1260             interface C
1261             {
1262                 @property const(char)[] name();
1263             }
1264             class D : B, C
1265             {
1266                 @property override const(char)[] msg() { return "D"; }
1267                 @property override const(char)[] name() { return "phil"; }
1268             }
1269 
1270             struct S { int a, b, c, d; }
1271 
1272             Variant[] scoop(...)
1273             {
1274                 version(DigitalMarsX64)
1275                 {
1276                     va_list ap;
1277                     va_start(ap, __va_argsave);
1278 
1279                     scope (exit) va_end(ap);
1280 
1281                     return Variant.fromVararg(_arguments, ap);
1282                 }
1283                 else
1284                 {
1285                     return Variant.fromVararg(_arguments, _argptr);
1286                 }
1287             }
1288 
1289             auto va_0 = cast(char)  '?';
1290             auto va_1 = cast(short) 42;
1291             auto va_2 = cast(int)   1701;
1292             auto va_3 = cast(long)  9001;
1293             auto va_4 = cast(float) 3.14;
1294             auto va_5 = cast(double)2.14;
1295             auto va_6 = cast(real)  0.1;
1296             auto va_7 = "abcd"[];
1297             S    va_8 = { 1, 2, 3, 4 };
1298             A    va_9 = new A;
1299             B    va_a = new B;
1300             C    va_b = new D;
1301             D    va_c = new D;
1302 
1303             auto vs = scoop(va_0, va_1, va_2, va_3,
1304                             va_4, va_5, va_6, va_7,
1305                             va_8, va_9, va_a, va_b, va_c);
1306 
1307             assert( vs[0x0].get!(typeof(va_0)) == va_0 );
1308             assert( vs[0x1].get!(typeof(va_1)) == va_1 );
1309             assert( vs[0x2].get!(typeof(va_2)) == va_2 );
1310             assert( vs[0x3].get!(typeof(va_3)) == va_3 );
1311             assert( vs[0x4].get!(typeof(va_4)) == va_4 );
1312             assert( vs[0x5].get!(typeof(va_5)) == va_5 );
1313             assert( vs[0x6].get!(typeof(va_6)) == va_6 );
1314             assert( vs[0x7].get!(typeof(va_7)) == va_7 );
1315             assert( vs[0x8].get!(typeof(va_8)) == va_8 );
1316             assert( vs[0x9].get!(typeof(va_9)) is va_9 );
1317             assert( vs[0xa].get!(typeof(va_a)) is va_a );
1318             assert( vs[0xb].get!(typeof(va_b)) is va_b );
1319             assert( vs[0xc].get!(typeof(va_c)) is va_c );
1320 
1321             assert( vs[0x9].get!(typeof(va_9)).msg == "A" );
1322             assert( vs[0xa].get!(typeof(va_a)).msg == "B" );
1323             assert( vs[0xc].get!(typeof(va_c)).msg == "D" );
1324 
1325             assert( vs[0xb].get!(typeof(va_b)).name == "phil" );
1326             assert( vs[0xc].get!(typeof(va_c)).name == "phil" );
1327 
1328             /+
1329             version (none) version(X86) // TODO toVararg won't work in x86_64 as it is now
1330             {
1331                 TypeInfo[] types;
1332                 void* args;
1333 
1334                 Variant.toVararg(vs, types, args);
1335 
1336                 assert( types[0x0] is typeid(typeof(va_0)) );
1337                 assert( types[0x1] is typeid(typeof(va_1)) );
1338                 assert( types[0x2] is typeid(typeof(va_2)) );
1339                 assert( types[0x3] is typeid(typeof(va_3)) );
1340                 assert( types[0x4] is typeid(typeof(va_4)) );
1341                 assert( types[0x5] is typeid(typeof(va_5)) );
1342                 assert( types[0x6] is typeid(typeof(va_6)) );
1343                 assert( types[0x7] is typeid(typeof(va_7)) );
1344                 assert( types[0x8] is typeid(typeof(va_8)) );
1345                 assert( types[0x9] is typeid(typeof(va_9)) );
1346                 assert( types[0xa] is typeid(typeof(va_a)) );
1347                 assert( types[0xb] is typeid(typeof(va_b)) );
1348                 assert( types[0xc] is typeid(typeof(va_c)) );
1349 
1350                 auto ptr = args;
1351 
1352                 auto vb_0 = va_arg!(typeof(va_0))(ptr);
1353                 auto vb_1 = va_arg!(typeof(va_1))(ptr);
1354                 auto vb_2 = va_arg!(typeof(va_2))(ptr);
1355                 auto vb_3 = va_arg!(typeof(va_3))(ptr);
1356                 auto vb_4 = va_arg!(typeof(va_4))(ptr);
1357                 auto vb_5 = va_arg!(typeof(va_5))(ptr);
1358                 auto vb_6 = va_arg!(typeof(va_6))(ptr);
1359                 auto vb_7 = va_arg!(typeof(va_7))(ptr);
1360                 auto vb_8 = va_arg!(typeof(va_8))(ptr);
1361                 auto vb_9 = va_arg!(typeof(va_9))(ptr);
1362                 auto vb_a = va_arg!(typeof(va_a))(ptr);
1363                 auto vb_b = va_arg!(typeof(va_b))(ptr);
1364                 auto vb_c = va_arg!(typeof(va_c))(ptr);
1365 
1366                 assert( vb_0 == va_0 );
1367                 assert( vb_1 == va_1 );
1368                 assert( vb_2 == va_2 );
1369                 assert( vb_3 == va_3 );
1370                 assert( vb_4 == va_4 );
1371                 assert( vb_5 == va_5 );
1372                 assert( vb_6 == va_6 );
1373                 assert( vb_7 == va_7 );
1374                 assert( vb_8 == va_8 );
1375                 assert( vb_9 is va_9 );
1376                 assert( vb_a is va_a );
1377                 assert( vb_b is va_b );
1378                 assert( vb_c is va_c );
1379 
1380                 assert( vb_9.msg == "A" );
1381                 assert( vb_a.msg == "B" );
1382                 assert( vb_c.msg == "D" );
1383 
1384                 assert( vb_b.name == "phil" );
1385                 assert( vb_c.name == "phil" );
1386             }
1387             +/
1388         }
1389     }
1390 }