src/gdb ChangeLog ada-lang.c ada-lang.h ada-va ...

[guitton at sourceware dot org]

CVSROOT:	/cvs/src
Module name:	src
Changes by:	guitton@sourceware.org	2012-11-29 16:28:10

Modified files:
	gdb            : ChangeLog ada-lang.c ada-lang.h ada-valprint.c 
	gdb/testsuite  : ChangeLog 
	gdb/testsuite/gdb.ada: ptype_tagged_param.exp 

Log message:
	Full view of interface-wide types
	
	For displaying the full view of a class-wide object, GDB relies on
	the assumption that this view will have the same address as the
	address of the object. In the case of simple inheritance, this
	assumption is correct; the proper type is deduced by decoding
	the tag of the object and converting the result to this full-view
	type.
	
	Consider for example an abstract class Shape, a child Circle
	which implements an interface Drawable, and the corresponding
	following objects:
	
	My_Circle   : Circle := ((1, 2), 3);
	My_Shape    : Shape'Class := Shape'Class (My_Circle);
	My_Drawable : Drawable'Class := Drawable'Class (My_Circle);
	
	To display My_Shape, the debugger first extracts the tag (an internal
	field, usually the first one of the record):
	
	(gdb) p my_shape'address
	$2 = (system.address) 0x8063e28
	(gdb) x/x my_shape'address
	0x8063e28 <classes__my_shape>: 0x08059ec4
	
	Then the type specific data and the expanded name of the tag is read
	from there:
	
	(gdb) p my_shape'tag
	$3 = (access ada.tags.dispatch_table) 0x8059ec4 (classes.circle)
	
	To get the full view, the debugger converts to the corresponding type:
	
	(gdb) p {classes.circle}0x8063e28
	$4 = (center => (x => 1, y => 2), radius => 3)
	
	Now, in the case of multiple inheritance, the assumption does not hold
	anymore. The address that we have usually points to some
	place lower. The offset to the original address is saved in the field
	Offset_To_Top of the metadata that are above the tag, at address
	obj'tag - 8. In the case of my_shape, this offset is 0:
	
	(gdb) x/x my_shape'tag - 8
	0x8059ebc <classes__circleT+12>:        0x00000000
	
	...but in the case of an interface-wide object, it is not null:
	
	(gdb) x/x my_drawable'tag - 8
	0x8063b28 <classes__classes__circle_classes__drawable1T56s+12>: 0x00000004
	(gdb) p {classes.circle}(my_drawable'address - 4)
	$7 = (center => (x => 1, y => 2), radius => 3)
	
	The following change handles this relocation in the most common cases.
	Remaining cases that are still to be investigated are signaled by
	comments.
	
	gdb/ChangeLog:
	
	* ada-lang.h (ada_tag_value_at_base_address): New function
	declaration.
	* ada-lang.c (is_ada95_tag, ada_tag_value_at_base_address):
	New functions.
	(ada_to_fixed_type_1, ada_evaluate_subexp): Let ada_tag_base_address
	relocate the class-wide value if need be.
	(ada_value_struct_elt, ada_value_ind, ada_coerce_ref):
	Let ada_tag_value_at_base_address relocate the class-wide access/ref
	before dereferencing it.
	* ada-valprint.c (ada_val_print_1): Relocate to base address
	before displaying the content of an interface-wide ref.
	
	gdb/testsuite/ChangeLog:
	
	* gdb.ada/ptype_tagged_param.exp: Adjust expected output in
	ptype test.

Patches:
http://sourceware.org/cgi-bin/cvsweb.cgi/src/gdb/ChangeLog.diff?cvsroot=src&r1=1.14868&r2=1.14869
http://sourceware.org/cgi-bin/cvsweb.cgi/src/gdb/ada-lang.c.diff?cvsroot=src&r1=1.382&r2=1.383
http://sourceware.org/cgi-bin/cvsweb.cgi/src/gdb/ada-lang.h.diff?cvsroot=src&r1=1.81&r2=1.82
http://sourceware.org/cgi-bin/cvsweb.cgi/src/gdb/ada-valprint.c.diff?cvsroot=src&r1=1.92&r2=1.93
http://sourceware.org/cgi-bin/cvsweb.cgi/src/gdb/testsuite/ChangeLog.diff?cvsroot=src&r1=1.3467&r2=1.3468
http://sourceware.org/cgi-bin/cvsweb.cgi/src/gdb/testsuite/gdb.ada/ptype_tagged_param.exp.diff?cvsroot=src&r1=1.6&r2=1.7