/[eiffelstudio]/trunk/eweasel/tests/incr071/internal.e-dotnet
ViewVC logotype

Contents of /trunk/eweasel/tests/incr071/internal.e-dotnet

Parent Directory Parent Directory | Revision Log Revision Log


Revision 65297 - (show annotations)
Thu Nov 30 20:22:33 2006 UTC (13 years ago) by manus
File size: 35323 byte(s)
Moved from trunk/Src/eweasel to trunk/eweasel so that a simple checkout of the source code is not penalized by the lenghty process of checking out all the tests of eweasel.
1 indexing
2 description: "[
3 Access to internal object properties.
4 This class may be used as ancestor by classes needing its facilities.
5 ]"
6 status: "See notice at end of class"
7 date: "$Date: 2005-03-14 16:20:22 -0800 (Mon, 14 Mar 2005) $"
8 revision: "$Revision: 81874 $"
9
10 class
11 INTERNAL
12
13 feature -- Conformance
14
15 is_instance_of (object: ANY; type_id: INTEGER): BOOLEAN is
16 -- Is `object' an instance of type `type_id'?
17 require
18 object_not_void: object /= Void
19 type_id_nonnegative: type_id >= 0
20 local
21 l_types: like known_types
22 do
23 l_types := known_types
24 l_types.search (type_id)
25 if l_types.found then
26 Result := l_types.found_item.is_instance_of_type (object)
27 end
28 end
29
30 type_conforms_to (type1, type2: INTEGER): BOOLEAN is
31 -- Does `type1' conform to `type2'?
32 require
33 type1_nonnegative: type1 >= 0
34 type2_nonnegative: type2 >= 0
35 local
36 l_child, l_parent: SYSTEM_TYPE
37 l_types: like known_types
38 do
39 if type1 = type2 then
40 Result := True
41 else
42 l_types := known_types
43 l_types.search (type1)
44 if l_types.found then
45 l_child := l_types.found_item
46 l_types.search (type2)
47 if l_types.found then
48 l_parent := l_types.found_item
49 Result := l_parent.is_assignable_from (l_child)
50 end
51 end
52 end
53 end
54
55 feature -- Creation
56
57 dynamic_type_from_string (class_type: STRING): INTEGER is
58 -- Dynamic type corresponding to `class_type'.
59 -- If no dynamic type available, returns -1.
60 require
61 class_type_not_void: class_type /= Void
62 local
63 t: SYSTEM_TYPE
64 l_class_type: SYSTEM_STRING
65 do
66 l_class_type := class_type.to_cil
67 load_assemblies
68 eiffel_type_mapping.search (class_type)
69 if eiffel_type_mapping.found then
70 -- It is an Eiffel type which was recorded in `load_assemblies'.
71 t := eiffel_type_mapping.found_item
72 else
73 -- Could not find it, let's try the .NET name.
74 t := feature {SYSTEM_TYPE}.get_type_string (l_class_type)
75 end
76 if t /= Void then
77 Result := get_type_index (t)
78 else
79 Result := -1
80 end
81 ensure
82 dynamic_type_from_string_valid: Result = -1 or else Result >= 0
83 end
84
85 new_instance_of (type_id: INTEGER): ANY is
86 -- New instance of dynamic `type_id'.
87 -- Note: returned object is not initialized and may
88 -- hence violate its invariant.
89 require
90 type_id_nonnegative: type_id >= 0
91 not_special_type: not is_special_type (type_id)
92 local
93 c: CONSTRUCTOR_INFO
94 l_types: like known_types
95 do
96 l_types := known_types
97 l_types.search (type_id)
98 if l_types.found then
99 c := l_types.found_item.get_constructor (feature {SYSTEM_TYPE}.empty_types)
100 if c /= Void then
101 Result ?= c.invoke (Void)
102 end
103 end
104 ensure
105 not_special_type: not is_special (Result)
106 dynamic_type_set: dynamic_type (Result) = type_id
107 end
108
109 new_special_any_instance (type_id, count: INTEGER): SPECIAL [ANY] is
110 -- New instance of dynamic `type_id' that represents
111 -- a SPECIAL with `count' element. To create a SPECIAL of
112 -- basic type, use `TO_SPECIAL'.
113 require
114 count_valid: count >= 0
115 type_id_nonnegative: type_id >= 0
116 special_type: is_special_any_type (type_id)
117 do
118 check
119 False
120 end
121 ensure
122 special_type: is_special (Result)
123 dynamic_type_set: dynamic_type (Result) = type_id
124 count_set: Result.count = count
125 end
126
127 feature -- Status report
128
129 is_special_any_type (type_id: INTEGER): BOOLEAN is
130 -- Is type represented by `type_id' represent
131 -- a SPECIAL [XX] where XX is a reference type.
132 require
133 type_id_nonnegative: type_id >= 0
134 do
135 check
136 False
137 end
138 end
139
140 is_special_type (type_id: INTEGER): BOOLEAN is
141 -- Is type represented by `type_id' represent
142 -- a SPECIAL [XX] where XX is a reference type
143 -- or a basic type.
144 require
145 type_id_nonnegative: type_id >= 0
146 do
147 check
148 False
149 end
150 end
151
152 is_special (object: ANY): BOOLEAN is
153 -- Is `object' a special object?
154 -- It only recognized a special object
155 -- initialized within a TO_SPECIAL object.
156 require
157 object_not_void: object /= Void
158 local
159 cvs: SPECIAL [ANY]
160 do
161 cvs ?= object
162 Result := cvs /= Void
163 end
164
165 is_marked (obj: ANY): BOOLEAN is
166 -- Is `obj' marked?
167 require
168 object_not_void: obj /= Void
169 do
170 Result := Marked_objects.contains (obj)
171 end
172
173 feature -- Access
174
175 Pointer_type: INTEGER is 0
176
177 Reference_type: INTEGER is 1
178
179 Character_type: INTEGER is 2
180
181 Boolean_type: INTEGER is 3
182
183 Integer_type, integer_32_type: INTEGER is 4
184
185 Real_type: INTEGER is 5
186
187 Double_type: INTEGER is 6
188
189 Expanded_type: INTEGER is 7
190
191 Bit_type: INTEGER is 8
192
193 Integer_8_type: INTEGER is 9
194
195 Integer_16_type: INTEGER is 10
196
197 Integer_64_type: INTEGER is 11
198
199 Wide_character_type: INTEGER is 12
200
201 natural_8_type: INTEGER is 13
202
203 natural_16_type: INTEGER is 14
204
205 natural_32_type: INTEGER is 15
206
207 natural_64_type: INTEGER is 16
208
209 max_predefined_type: INTEGER is 17
210 -- See non-exported definition of `object_type' below.
211
212 class_name (object: ANY): STRING is
213 -- Name of the class associated with `object'
214 require
215 object_not_void: object /= Void
216 do
217 Result := object.generator
218 end
219
220 class_name_of_type (type_id: INTEGER): STRING is
221 -- Name of class associated with dynamic type `type_id'.
222 require
223 type_id_nonnegative: type_id >= 0
224 local
225 l_types: like known_types
226 l_name: EIFFEL_NAME_ATTRIBUTE
227 l_type: SYSTEM_TYPE
228 l_attributes: NATIVE_ARRAY [SYSTEM_OBJECT]
229 do
230 l_types := known_types
231 l_types.search (type_id)
232 if l_types.found then
233 l_type := l_types.found_item
234 l_attributes := l_type.get_custom_attributes (eiffel_name_attribute_type, False)
235 if l_attributes.count > 0 then
236 -- This is an eiffel defined attribute
237 check
238 valid_number_of_custom_attributes: l_attributes.count = 1
239 end
240 l_name ?= l_attributes.item (0)
241 Result := l_name.name
242 else
243 Result := l_type.name
244 end
245 end
246 end
247
248 type_name (object: ANY): STRING is
249 -- Name of `object''s generating type (type of which `object'
250 -- is a direct instance).
251 require
252 object_not_void: object /= Void
253 do
254 Result := object.generating_type
255 end
256
257 type_name_of_type (type_id: INTEGER): STRING is
258 -- Name of `type_id''s generating type (type of which `type_id'
259 -- is a direct instance).
260 require
261 type_id_nonnegative: type_id >= 0
262 do
263 check
264 False
265 end
266 end
267
268 dynamic_type (object: ANY): INTEGER is
269 -- Dynamic type of `object'
270 require
271 object_not_void: object /= Void
272 local
273 l_obj: SYSTEM_OBJECT
274 do
275 l_obj := object
276 Result := get_type_index (l_obj.get_type)
277 ensure
278 dynamic_type_nonnegative: Result >= 0
279 end
280
281 generic_count (obj: ANY): INTEGER is
282 -- Number of generic parameter in `obj'.
283 require
284 obj_not_void: obj /= Void
285 do
286 Result := feature {ISE_RUNTIME}.generic_parameter_count (obj)
287 end
288
289 generic_count_of_type (type_id: INTEGER): INTEGER is
290 -- Number of generic parameter in `type_id'.
291 require
292 type_id_nonnegative: type_id >= 0
293 do
294 check
295 False
296 end
297 end
298
299 generic_dynamic_type (object: ANY; i: INTEGER): INTEGER is
300 -- Dynamic type of generic parameter of `object' at
301 -- position `i'.
302 require
303 object_not_void: object /= Void
304 object_generic: generic_count (object) > 0
305 i_valid: i > 0 and i <= generic_count (object)
306 local
307 generic_type: SYSTEM_TYPE
308 do
309 generic_type := feature {ISE_RUNTIME}.type_of_generic_parameter (object, i)
310 Result := get_type_index (generic_type)
311 ensure
312 dynamic_type_nonnegative: Result >= 0
313 end
314
315 generic_dynamic_type_of_type (type_id, i: INTEGER): INTEGER is
316 -- Dynamic type of generic parameter of `type_id' at position `i'.
317 require
318 type_id_nonnegative: type_id >= 0
319 type_id_generic: generic_count_of_type (type_id) > 0
320 i_valid: i > 0 and i <= generic_count_of_type (type_id)
321 do
322 check
323 False
324 end
325 ensure
326 dynamic_type_nonnegative: Result >= 0
327 end
328
329 field (i: INTEGER; object: ANY): ANY is
330 -- Object attached to the `i'-th field of `object'
331 -- (directly or through a reference)
332 require
333 object_not_void: object /= Void
334 index_large_enough: i >= 1
335 index_small_enough: i <= field_count (object)
336 not_special: not is_special (object)
337 local
338 l_obj: SYSTEM_OBJECT
339 l_nat8: NATURAL_8
340 l_nat16: NATURAL_16
341 l_nat32: NATURAL_32
342 l_nat64: NATURAL_64
343 l_int8: INTEGER_8
344 l_int16: INTEGER_16
345 l_int32: INTEGER
346 l_int64: INTEGER_64
347 l_char: CHARACTER
348 l_boolean: BOOLEAN
349 l_real: REAL
350 l_double: DOUBLE
351 l_pointer: POINTER
352 l_dtype: INTEGER
353 do
354 l_dtype := dynamic_type (object)
355 l_obj := field_of_type (i, object, l_dtype)
356 inspect
357 field_type_of_type (i, l_dtype)
358 when Pointer_type then
359 l_pointer ?= l_obj
360 Result := l_pointer
361
362 when Character_type then
363 l_char ?= l_obj
364 Result := l_char
365
366 when Boolean_type then
367 l_boolean ?= l_obj
368 Result := l_boolean
369
370 when natural_8_type then
371 l_nat8 ?= l_obj
372 Result := l_nat8
373
374 when natural_16_type then
375 l_nat16 ?= l_obj
376 Result := l_nat16
377
378 when natural_32_type then
379 l_nat32 ?= l_obj
380 Result := l_nat32
381
382 when natural_64_type then
383 l_nat64 ?= l_obj
384 Result := l_nat64
385
386 when Integer_8_type then
387 l_int8 ?= l_obj
388 Result := l_int8
389
390 when Integer_16_type then
391 l_int16 ?= l_obj
392 Result := l_int16
393
394 when Integer_32_type then
395 l_int32 ?= l_obj
396 Result := l_int32
397
398 when Integer_64_type then
399 l_int64 ?= l_obj
400 Result := l_int64
401
402 when Real_type then
403 l_real ?= l_obj
404 Result := l_real
405
406 when Double_type then
407 l_double ?= l_obj
408 Result := l_double
409
410 else
411 -- A reference, so nothing to be done
412 Result := l_obj
413 end
414 end
415
416 field_name (i: INTEGER; object: ANY): STRING is
417 -- Name of `i'-th field of `object'
418 require
419 object_not_void: object /= Void
420 index_large_enough: i >= 1
421 index_small_enough: i <= field_count (object)
422 not_special: not is_special (object)
423 do
424 Result := field_name_of_type (i, dynamic_type (object))
425 ensure
426 Result_exists: Result /= Void
427 end
428
429 field_name_of_type (i: INTEGER; type_id: INTEGER): STRING is
430 -- Name of `i'-th field of dynamic type `type_id'.
431 require
432 type_id_nonnegative: type_id >= 0
433 index_large_enough: i >= 1
434 index_small_enought: i <= field_count_of_type (type_id)
435 local
436 m: like get_members
437 l_field: FIELD_INFO
438 l_name: EIFFEL_NAME_ATTRIBUTE
439 l_attributes: NATIVE_ARRAY [SYSTEM_OBJECT]
440 do
441 m := get_members (type_id)
442 if m /= Void and then m.valid_index (i) then
443 l_field := m.i_th (i)
444 l_attributes := l_field.get_custom_attributes_type (eiffel_name_attribute_type, False)
445 if l_attributes.count > 0 then
446 -- This is an eiffel defined attribute
447 check
448 valid_number_of_custom_attributes: l_attributes.count = 1
449 end
450 l_name ?= l_attributes.item (0)
451 Result := l_name.name
452 else
453 Result := l_field.name
454 end
455 end
456 end
457
458 field_offset (i: INTEGER; object: ANY): INTEGER is
459 -- Offset of `i'-th field of `object'
460 require
461 object_not_void: object /= Void
462 index_large_enough: i >= 1
463 index_small_enough: i <= field_count (object)
464 not_special: not is_special (object)
465 do
466 Result := 4 * i
467 end
468
469 field_type (i: INTEGER; object: ANY): INTEGER is
470 -- Abstract type of `i'-th field of `object'
471 require
472 object_not_void: object /= Void
473 index_large_enough: i >= 1
474 index_small_enough: i <= field_count (object)
475 do
476 Result := field_type_of_type (i, dynamic_type (object))
477 ensure
478 field_type_nonnegative: Result >= 0
479 end
480
481 field_type_of_type (i: INTEGER; type_id: INTEGER): INTEGER is
482 -- Abstract type of `i'-th field of dynamic type `type_id'
483 require
484 type_id_nonnegative: type_id >= 0
485 index_large_enough: i >= 1
486 index_small_enough: i <= field_count_of_type (type_id)
487 local
488 l_m: like get_members
489 l_field: FIELD_INFO
490 l_type: SYSTEM_TYPE
491 do
492 l_m := get_members (type_id)
493 if l_m /= Void and then l_m.valid_index (i) then
494 l_field := l_m.i_th (i)
495 l_type := l_field.field_type
496 if abstract_types.contains (l_type) then
497 Result ?= abstract_types.item (l_type)
498 else
499 -- FIXME: BIT not supported
500 if
501 l_type.is_subclass_of (
502 feature {SYSTEM_TYPE}.get_type_string (("System.Enum").to_cil))
503 then
504 Result := Expanded_type
505 else
506 Result := Reference_type
507 end
508 end
509 end
510 ensure
511 field_type_nonnegative: Result >= 0
512 end
513
514 field_static_type_of_type (i: INTEGER; type_id: INTEGER): INTEGER is
515 -- Static type of declared `i'-th field of dynamic type `type_id'
516 require
517 type_id_nonnegative: type_id >= 0
518 index_large_enough: i >= 1
519 index_small_enough: i <= field_count_of_type (type_id)
520 local
521 l_m: like get_members
522 l_field: FIELD_INFO
523 do
524 l_m := get_members (type_id)
525 if l_m /= Void and then l_m.valid_index (i) then
526 l_field := l_m.i_th (i)
527 Result := get_type_index (l_field.field_type)
528 end
529 ensure
530 field_type_nonnegative: Result >= 0
531 end
532
533 expanded_field_type (i: INTEGER; object: ANY): STRING is
534 -- Class name associated with the `i'-th
535 -- expanded field of `object'
536 require
537 object_not_void: object /= Void
538 index_large_enough: i >= 1
539 index_small_enough: i <= field_count (object)
540 is_expanded: field_type (i, object) = Expanded_type
541 do
542 check
543 False
544 end
545 ensure
546 Result_exists: Result /= Void
547 end
548
549 character_field (i: INTEGER; object: ANY): CHARACTER is
550 -- Character value of `i'-th field of `object'
551 require
552 object_not_void: object /= Void
553 index_large_enough: i >= 1
554 index_small_enough: i <= field_count (object)
555 character_field: field_type (i, object) = Character_type
556 do
557 Result ?= field_of_type (i, object, dynamic_type (object))
558 end
559
560 boolean_field (i: INTEGER; object: ANY): BOOLEAN is
561 -- Boolean value of `i'-th field of `object'
562 require
563 object_not_void: object /= Void
564 index_large_enough: i >= 1
565 index_small_enough: i <= field_count (object)
566 boolean_field: field_type (i, object) = Boolean_type
567 do
568 Result ?= field_of_type (i, object, dynamic_type (object))
569 end
570
571 natural_8_field (i: INTEGER; object: ANY): NATURAL_8 is
572 -- NATURAL_8 value of `i'-th field of `object'
573 require
574 object_not_void: object /= Void
575 index_large_enough: i >= 1
576 index_small_enough: i <= field_count (object)
577 natural_8_field: field_type (i, object) = natural_8_type
578 do
579 Result ?= field_of_type (i, object, dynamic_type (object))
580 end
581
582 natural_16_field (i: INTEGER; object: ANY): NATURAL_16 is
583 -- NATURAL_16 value of `i'-th field of `object'
584 require
585 object_not_void: object /= Void
586 index_large_enough: i >= 1
587 index_small_enough: i <= field_count (object)
588 natural_16_field: field_type (i, object) = natural_16_type
589 do
590 Result ?= field_of_type (i, object, dynamic_type (object))
591 end
592
593 natural_32_field (i: INTEGER; object: ANY): NATURAL_32 is
594 -- NATURAL_32 value of `i'-th field of `object'
595 require
596 object_not_void: object /= Void
597 index_large_enough: i >= 1
598 index_small_enough: i <= field_count (object)
599 natural_field: field_type (i, object) = natural_32_type
600 do
601 Result ?= field_of_type (i, object, dynamic_type (object))
602 end
603
604 natural_64_field (i: INTEGER; object: ANY): NATURAL_64 is
605 -- NATURAL_64 value of `i'-th field of `object'
606 require
607 object_not_void: object /= Void
608 index_large_enough: i >= 1
609 index_small_enough: i <= field_count (object)
610 natural_64_field: field_type (i, object) = natural_64_type
611 do
612 Result ?= field_of_type (i, object, dynamic_type (object))
613 end
614
615 integer_8_field (i: INTEGER; object: ANY): INTEGER_8 is
616 -- Integer value of `i'-th field of `object'
617 require
618 object_not_void: object /= Void
619 index_large_enough: i >= 1
620 index_small_enough: i <= field_count (object)
621 integer_8_field: field_type (i, object) = Integer_8_type
622 do
623 Result ?= field_of_type (i, object, dynamic_type (object))
624 end
625
626 integer_16_field (i: INTEGER; object: ANY): INTEGER_16 is
627 -- Integer value of `i'-th field of `object'
628 require
629 object_not_void: object /= Void
630 index_large_enough: i >= 1
631 index_small_enough: i <= field_count (object)
632 integer_16_field: field_type (i, object) = Integer_16_type
633 do
634 Result ?= field_of_type (i, object, dynamic_type (object))
635 end
636
637 integer_field, integer_32_field (i: INTEGER; object: ANY): INTEGER is
638 -- Integer value of `i'-th field of `object'
639 require
640 object_not_void: object /= Void
641 index_large_enough: i >= 1
642 index_small_enough: i <= field_count (object)
643 integer_32_field: field_type (i, object) = Integer_32_type
644 do
645 Result ?= field_of_type (i, object, dynamic_type (object))
646 end
647
648 integer_64_field (i: INTEGER; object: ANY): INTEGER_64 is
649 -- Integer value of `i'-th field of `object'
650 require
651 object_not_void: object /= Void
652 index_large_enough: i >= 1
653 index_small_enough: i <= field_count (object)
654 integer_64_field: field_type (i, object) = Integer_64_type
655 do
656 Result ?= field_of_type (i, object, dynamic_type (object))
657 end
658
659 real_field (i: INTEGER; object: ANY): REAL is
660 -- Real value of `i'-th field of `object'
661 require
662 object_not_void: object /= Void
663 index_large_enough: i >= 1
664 index_small_enough: i <= field_count (object)
665 real_field: field_type (i, object) = Real_type
666 do
667 Result ?= field_of_type (i, object, dynamic_type (object))
668 end
669
670 pointer_field (i: INTEGER; object: ANY): POINTER is
671 -- Pointer value of `i'-th field of `object'
672 require
673 object_not_void: object /= Void
674 index_large_enough: i >= 1
675 index_small_enough: i <= field_count (object)
676 pointer_field: field_type (i, object) = Pointer_type
677 do
678 Result ?= field_of_type (i, object, dynamic_type (object))
679 end
680
681 double_field (i: INTEGER; object: ANY): DOUBLE is
682 -- Double precision value of `i'-th field of `object'
683 require
684 object_not_void: object /= Void
685 index_large_enough: i >= 1
686 index_small_enough: i <= field_count (object)
687 double_field: field_type (i, object) = Double_type
688 do
689 Result ?= field_of_type (i, object, dynamic_type (object))
690 end
691
692 feature -- Version
693
694 compiler_version: INTEGER is
695 do
696 -- Built-in.
697 end
698
699 feature -- Element change
700
701 set_reference_field (i: INTEGER; object: ANY; value: ANY) is
702 require
703 object_not_void: object /= Void
704 index_large_enough: i >= 1
705 index_small_enough: i <= field_count (object)
706 reference_field: field_type (i, object) = Reference_type
707 value_conforms_to_field_static_type:
708 value /= Void implies
709 type_conforms_to (dynamic_type (value),
710 field_static_type_of_type (i, dynamic_type (object)))
711 do
712 internal_set_reference_field (i, object, value)
713 end
714
715 set_double_field (i: INTEGER; object: ANY; value: DOUBLE) is
716 require
717 object_not_void: object /= Void
718 index_large_enough: i >= 1
719 index_small_enough: i <= field_count (object)
720 double_field: field_type (i, object) = Double_type
721 do
722 internal_set_reference_field (i, object, value)
723 end
724
725 set_character_field (i: INTEGER; object: ANY; value: CHARACTER) is
726 -- Set character value of `i'-th field of `object' to `value'
727 require
728 object_not_void: object /= Void
729 index_large_enough: i >= 1
730 index_small_enough: i <= field_count (object)
731 character_field: field_type (i, object) = Character_type
732 do
733 internal_set_reference_field (i, object, value)
734 end
735
736 set_boolean_field (i: INTEGER; object: ANY; value: BOOLEAN) is
737 require
738 object_not_void: object /= Void
739 index_large_enough: i >= 1
740 index_small_enough: i <= field_count (object)
741 boolean_field: field_type (i, object) = Boolean_type
742 do
743 internal_set_reference_field (i, object, value)
744 end
745
746 set_natural_8_field (i: INTEGER; object: ANY; value: NATURAL_8) is
747 require
748 object_not_void: object /= Void
749 index_large_enough: i >= 1
750 index_small_enough: i <= field_count (object)
751 natural_8_field: field_type (i, object) = natural_8_type
752 do
753 internal_set_reference_field (i, object, value)
754 end
755
756 set_natural_16_field (i: INTEGER; object: ANY; value: NATURAL_16) is
757 require
758 object_not_void: object /= Void
759 index_large_enough: i >= 1
760 index_small_enough: i <= field_count (object)
761 natural_16_field: field_type (i, object) = natural_16_type
762 do
763 internal_set_reference_field (i, object, value)
764 end
765
766 set_natural_field (i: INTEGER; object: ANY; value: NATURAL_64) is
767 require
768 object_not_void: object /= Void
769 index_large_enough: i >= 1
770 index_small_enough: i <= field_count (object)
771 natural_32_field: field_type (i, object) = natural_32_type
772 do
773 internal_set_reference_field (i, object, value)
774 end
775
776 set_natural_64_field (i: INTEGER; object: ANY; value: NATURAL_64) is
777 require
778 object_not_void: object /= Void
779 index_large_enough: i >= 1
780 index_small_enough: i <= field_count (object)
781 natural_64_field: field_type (i, object) = natural_64_type
782 do
783 internal_set_reference_field (i, object, value)
784 end
785
786 set_integer_8_field (i: INTEGER; object: ANY; value: INTEGER_8) is
787 require
788 object_not_void: object /= Void
789 index_large_enough: i >= 1
790 index_small_enough: i <= field_count (object)
791 integer_8_field: field_type (i, object) = Integer_8_type
792 do
793 internal_set_reference_field (i, object, value)
794 end
795
796 set_integer_16_field (i: INTEGER; object: ANY; value: INTEGER_16) is
797 require
798 object_not_void: object /= Void
799 index_large_enough: i >= 1
800 index_small_enough: i <= field_count (object)
801 integer_16_field: field_type (i, object) = Integer_16_type
802 do
803 internal_set_reference_field (i, object, value)
804 end
805
806 set_integer_field, set_integer_32_field (i: INTEGER; object: ANY; value: INTEGER) is
807 require
808 object_not_void: object /= Void
809 index_large_enough: i >= 1
810 index_small_enough: i <= field_count (object)
811 integer_32_field: field_type (i, object) = Integer_32_type
812 do
813 internal_set_reference_field (i, object, value)
814 end
815
816 set_integer_64_field (i: INTEGER; object: ANY; value: INTEGER_64) is
817 require
818 object_not_void: object /= Void
819 index_large_enough: i >= 1
820 index_small_enough: i <= field_count (object)
821 integer_64_field: field_type (i, object) = Integer_64_type
822 do
823 internal_set_reference_field (i, object, value)
824 end
825
826 set_real_field (i: INTEGER; object: ANY; value: REAL) is
827 require
828 object_not_void: object /= Void
829 index_large_enough: i >= 1
830 index_small_enough: i <= field_count (object)
831 real_field: field_type (i, object) = Real_type
832 do
833 internal_set_reference_field (i, object, value)
834 end
835
836 set_pointer_field (i: INTEGER; object: ANY; value: POINTER) is
837 require
838 object_not_void: object /= Void
839 index_large_enough: i >= 1
840 index_small_enough: i <= field_count (object)
841 pointer_field: field_type (i, object) = Pointer_type
842 do
843 internal_set_reference_field (i, object, value)
844 end
845
846 feature -- Measurement
847
848 field_count (object: ANY): INTEGER is
849 -- Number of logical fields in `object'
850 require
851 object_not_void: object /= Void
852 do
853 Result := get_members (dynamic_type (object)).count
854 end
855
856 field_count_of_type (type_id: INTEGER): INTEGER is
857 -- Number of logical fields in dynamic type `type_id'.
858 require
859 type_id_nonnegative: type_id >= 0
860 do
861 Result := get_members (type_id).count
862 end
863
864 bit_size (i: INTEGER; object: ANY): INTEGER is
865 -- Size (in bit) of the `i'-th bit field of `object'
866 require
867 object_not_void: object /= Void
868 index_large_enough: i >= 1
869 index_small_enough: i <= field_count (object)
870 is_bit: field_type (i, object) = Bit_type
871 do
872 Result := 4
873 ensure
874 positive_result: Result > 0
875 end
876
877 physical_size (object: ANY): INTEGER is
878 -- Space occupied by `object' in bytes
879 require
880 object_not_void: object /= Void
881 do
882 Result := 4
883 end
884
885 feature -- Marking
886
887 mark (obj: ANY) is
888 -- Mark `obj'.
889 require
890 object_not_void: obj /= Void
891 do
892 Marked_objects.add (obj, obj)
893 ensure
894 marked: is_marked (obj)
895 end
896
897 unmark (obj: ANY) is
898 -- Unmark `obj'.
899 require
900 object_not_void: obj /= Void
901 object_marked: is_marked (obj)
902 do
903 Marked_objects.remove (obj)
904 ensure
905 not_marked: not is_marked (obj)
906 end
907
908 feature {NONE} -- Implementation
909
910 object_type: INTEGER is 17
911 -- System.Object type ID
912
913 new_known_type_id: CELL [INTEGER] is
914 -- ID for new stored type
915 once
916 create Result.put (max_predefined_type + 1)
917 end
918
919 field_of_type (i: INTEGER; object: ANY; type_id: INTEGER): SYSTEM_OBJECT is
920 -- Object attached to the `i'-th field of `object'
921 -- (directly or through a reference)
922 require
923 object_not_void: object /= Void
924 index_large_enough: i >= 1
925 index_small_enough: i <= field_count (object)
926 not_special: not is_special (object)
927 type_id_nonnegative: type_id >= 0
928 valid_type: dynamic_type (object) = type_id
929 local
930 m: like get_members
931 do
932 m := get_members (type_id)
933 if m /= Void and then m.valid_index (i) then
934 Result := m.i_th (i).get_value (object)
935 end
936 end
937
938 field_dynamic_type_of_type (i: INTEGER; type_id: INTEGER): INTEGER is
939 -- Type of `i'-th field of dynamic type `type_id'
940 -- Not used yet, but might be in future.
941 require
942 index_large_enough: i >= 1
943 index_small_enough: i <= field_count_of_type (type_id)
944 local
945 m: like get_members
946 do
947 m := get_members (type_id)
948 if m /= Void and then m.valid_index (i) then
949 Result := get_type_index (m.i_th (i).get_type)
950 end
951 end
952
953 get_type_index (t: SYSTEM_TYPE): INTEGER is
954 -- If type is a known type, return its index,
955 -- otherwise add it to the known types and return its index.
956 require
957 t_not_void: t /= Void
958 local
959 l_types: like known_types_id
960 l_id: like new_known_type_id
961 l_id_object: SYSTEM_OBJECT
962 do
963 l_types := known_types_id
964 l_id_object := l_types.item (t)
965 if l_id_object = Void then
966 l_id := new_known_type_id
967 Result := l_id.item
968 known_types.put (t, Result)
969 l_types.add (t, Result)
970 l_id.put (Result + 1)
971 else
972 Result ?= l_id_object
973 end
974 end
975
976 load_assemblies is
977 -- Analyzes current loaded assembly in current AppDomain. Assemblies
978 -- loaded after are loaded by hooking `load_eiffel_types_from_assembly'
979 -- to the `add_assembly_load' event.
980 local
981 l_assemblies: NATIVE_ARRAY [ASSEMBLY]
982 i, nb: INTEGER
983 l_handler: ASSEMBLY_LOAD_EVENT_HANDLER
984 once
985 l_assemblies := feature {APP_DOMAIN}.current_domain.get_assemblies
986 create l_handler.make (Current, $assembly_load_event)
987 feature {APP_DOMAIN}.current_domain.add_assembly_load (l_handler)
988 from
989 i := 0
990 nb := l_assemblies.count - 1
991 until
992 i > nb
993 loop
994 load_eiffel_types_from_assembly (l_assemblies.item (i))
995 i := i + 1
996 end
997 end
998
999 assembly_load_event (sender: SYSTEM_OBJECT; args: ASSEMBLY_LOAD_EVENT_ARGS) is
1000 -- Action executed when a new assembly is loaded.
1001 do
1002 if args /= Void then
1003 check
1004 has_loaded_assembly: args.loaded_assembly /= Void
1005 end
1006 load_eiffel_types_from_assembly (args.loaded_assembly)
1007 end
1008 end
1009
1010 load_eiffel_types_from_assembly (an_assembly: ASSEMBLY) is
1011 -- Load all Eiffel types from `an_assembly'.
1012 require
1013 an_assembly_not_void: an_assembly /= Void
1014 local
1015 l_types: NATIVE_ARRAY [SYSTEM_TYPE]
1016 l_name: EIFFEL_NAME_ATTRIBUTE
1017 l_cas: NATIVE_ARRAY [SYSTEM_OBJECT]
1018 i, nb: INTEGER
1019 retried: BOOLEAN
1020 do
1021 if not retried then
1022 l_types := an_assembly.get_types
1023 from
1024 i := 0
1025 nb := l_types.count - 1
1026 until
1027 i > nb
1028 loop
1029 l_cas := l_types.item (i).get_custom_attributes_type (eiffel_name_attribute_type, False)
1030 if l_cas /= Void and then l_cas.count > 0 then
1031 l_name ?= l_cas.item (0)
1032 check
1033 l_name_not_void: l_name /= Void
1034 end
1035 eiffel_type_mapping.force (l_types.item (i), l_name.name)
1036 end
1037 i := i + 1
1038 end
1039 end
1040 rescue
1041 -- It could fail in `an_assembly.get_types' and we don't want to
1042 -- prevent the assembly to load by failing here.
1043 retried := True
1044 retry
1045 end
1046
1047 eiffel_type_mapping: HASH_TABLE [SYSTEM_TYPE, STRING] is
1048 -- Mapping between Eiffel class names and .NET types.
1049 once
1050 create Result.make (50)
1051 end
1052
1053 known_types: HASH_TABLE [SYSTEM_TYPE, INTEGER] is
1054 -- All types that have already been identified.
1055 once
1056 -- FIXME: We do not support BIT
1057 create Result.make (50)
1058 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.IntPtr"), Pointer_type)
1059 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Char"), Character_type)
1060 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Boolean"), Boolean_type)
1061 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Single"), Real_type)
1062 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Double"), Double_type)
1063 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Byte"), natural_8_type)
1064 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.UInt16"), natural_16_type)
1065 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.UInt32"), natural_32_type)
1066 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.UInt64"), natural_64_type)
1067 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.SByte"), Integer_8_type)
1068 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Int16"), Integer_16_type)
1069 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Int32"), Integer_32_type)
1070 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Int64"), Integer_64_type)
1071 Result.put (feature {SYSTEM_TYPE}.get_type_string ("System.Object"), Object_type)
1072 end
1073
1074 known_types_id: HASHTABLE is
1075 -- Id of all types that have already been identified.
1076 -- Key: type
1077 -- Value: ID
1078 --| Reverse of `known_types'.
1079 once
1080 -- FIXME: We do not support BIT
1081 create Result.make_from_capacity (50)
1082 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.IntPtr"), Pointer_type)
1083 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Char"), Character_type)
1084 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Boolean"), Boolean_type)
1085 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Single"), Real_type)
1086 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Double"), Double_type)
1087 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Byte"), natural_8_type)
1088 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.UInt16"), natural_16_type)
1089 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.UInt32"), natural_32_type)
1090 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.UInt64"), natural_64_type)
1091 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.SByte"), Integer_8_type)
1092 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Int16"), Integer_16_type)
1093 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Int32"), Integer_32_type)
1094 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Int64"), Integer_64_type)
1095 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Object"), Object_type)
1096 end
1097
1098 abstract_types: HASHTABLE is
1099 -- List of all known basic types.
1100 -- Key: type
1101 -- Value: ID
1102 once
1103 create Result.make_from_capacity (10)
1104 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.IntPtr"), Pointer_type)
1105 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Char"), Character_type)
1106 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Boolean"), Boolean_type)
1107 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Single"), Real_type)
1108 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Double"), Double_type)
1109 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Byte"), natural_8_type)
1110 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.UInt16"), natural_16_type)
1111 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.UInt32"), natural_32_type)
1112 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.UInt64"), natural_64_type)
1113 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.SByte"), Integer_8_type)
1114 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Int16"), Integer_16_type)
1115 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Int32"), Integer_32_type)
1116 Result.add (feature {SYSTEM_TYPE}.get_type_string ("System.Int64"), Integer_64_type)
1117 end
1118
1119 get_members (type_id: INTEGER): ARRAYED_LIST [FIELD_INFO] is
1120 -- Retrieve all members of type `type_id'.
1121 -- We need permission to retrieve non-public members.
1122 -- Only fields and properties are returned.
1123 local
1124 fa: BINDING_FLAGS
1125 l_field_info: FIELD_INFO
1126 allm: NATIVE_ARRAY [MEMBER_INFO]
1127 c, i: INTEGER
1128 l_members: like known_members
1129 l_types: like known_types
1130 l_cv_f_name: STRING
1131 do
1132 l_members := Known_members
1133 l_members.search (type_id)
1134 if l_members.found then
1135 Result := l_members.found_item
1136 else
1137 l_types := known_types
1138 l_types.search (type_id)
1139 if l_types.found then
1140 fa := feature {BINDING_FLAGS}.instance |
1141 feature {BINDING_FLAGS}.public |
1142 feature {BINDING_FLAGS}.non_public
1143 allm := l_types.found_item.get_members_binding_flags (fa)
1144 c := allm.count
1145 create Result.make (10)
1146 from
1147
1148 until
1149 i = c
1150 loop
1151 l_field_info ?= allm.item (i)
1152 if l_field_info /= Void then
1153 l_cv_f_name := l_field_info.name
1154 if not l_cv_f_name.is_equal ("$$____type") then
1155 Result.extend (l_field_info)
1156 end
1157 end
1158 i := i + 1
1159 end
1160 end
1161 l_members.put (Result, type_id)
1162 end
1163 end
1164
1165 internal_set_reference_field (i: INTEGER; object: ANY; value: SYSTEM_OBJECT) is
1166 require
1167 object_not_void: object /= Void
1168 index_large_enough: i >= 1
1169 index_small_enough: i <= field_count (object)
1170 local
1171 m: like get_members
1172 do
1173 m := get_members (dynamic_type (object))
1174 if m /= Void and then m.valid_index (i) then
1175 m.i_th (i).set_value (object, value)
1176 end
1177 end
1178
1179 known_members: HASH_TABLE [ARRAYED_LIST [FIELD_INFO], INTEGER] is
1180 -- Buffer for `get_members' lookups
1181 once
1182 create Result.make (50)
1183 end
1184
1185 marked_objects: HASHTABLE is
1186 -- Contains all objects marked.
1187 once
1188 create Result.make_from_capacity (50)
1189 end
1190
1191 eiffel_name_attribute_type: SYSTEM_TYPE is
1192 -- Get actual type of EIFFEL_NAME_ATTRIBUTE while
1193 -- waiting for `typeof' operator.
1194 local
1195 l_name: EIFFEL_NAME_ATTRIBUTE
1196 once
1197 create l_name.make ("Test")
1198 Result := l_name.get_type
1199 end
1200
1201 indexing
1202
1203 library: "[
1204 EiffelBase: Library of reusable components for Eiffel.
1205 ]"
1206
1207 status: "[
1208 Copyright 1986-2001 Interactive Software Engineering (ISE).
1209 For ISE customers the original versions are an ISE product
1210 covered by the ISE Eiffel license and support agreements.
1211 ]"
1212
1213 license: "[
1214 EiffelBase may now be used by anyone as FREE SOFTWARE to
1215 develop any product, public-domain or commercial, without
1216 payment to ISE, under the terms of the ISE Free Eiffel Library
1217 License (IFELL) at http://eiffel.com/products/base/license.html.
1218 ]"
1219
1220 source: "[
1221 Interactive Software Engineering Inc.
1222 ISE Building
1223 360 Storke Road, Goleta, CA 93117 USA
1224 Telephone 805-685-1006, Fax 805-685-6869
1225 Electronic mail <info@eiffel.com>
1226 Customer support http://support.eiffel.com
1227 ]"
1228
1229 info: "[
1230 For latest info see award-winning pages: http://eiffel.com
1231 ]"
1232
1233 end -- class INTERNAL

  ViewVC Help
Powered by ViewVC 1.1.23