This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Improvements in handling of aggragates


Tested on i686-linux, committed on trunk

A tagged derived type may constrain  (rather than rename) discriminants
of a parent type..These discriminants are not visible comp[onents of the
type, but can become visible in a view conversion to the ancestor. They
must be be added explicitly because gtghey do not appear in the aggregate
itself. This retrieval was already done for extension aggregates, but not
for regular ones.
Compiled with gnatmake -q -z pak2
--
The following must produce the output:
--
 From function return:
 X.Kind = GREEN
 From aliased initialized object:
 X.Kind = GREEN
--
package Pak1 is
   type Color is (Red, Green, Blue);
   type Root_Data (Kind : Color) is abstract tagged null record;
   type Ptr is access all Root_Data'Class;
end Pak1;
with Pak1;
package Pak2 is
   type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
   type Derived_Data (Whence : Day) is new Pak1.Root_Data (Pak1.Green)
   with record
      X : Integer;
   end record;
   function F (Whence : Day) return Pak1.Ptr;
end Pak2;
with Ada.Text_IO; use Ada.Text_IO;
package body Pak2 is
   function F (Whence : Day) return Pak1.Ptr is
   begin
      return new Derived_Data'(Whence => Whence, X => 123);
   end F;
   X : Pak1.Ptr;
begin
   Put_Line ("From function return:");
   X := F (Wed);
   if X.Kind'Valid then
      Put_Line ("X.Kind = " & X.Kind'Img);
   else
      Put_Line ("X.Kind has invalid representation");
   end if;
   Put_Line ("From aliased initialized object:");
   X := Y'Access;
   if X.Kind'Valid then
      Put_Line ("X.Kind = " & X.Kind'Img);
   else
      Put_Line ("X.Kind has invalid representation");
   end if;
end Pak2;

2006-02-13  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Build_Array_Aggr_Code): Rename variable
	"Others_Mbox_Present" to "Others_Box_Present" because the mbox concept
	does not exist in the Ada RM.
	(Compatible_Int_Bounds): Determine whether two integer range bounds
	are of equal length and have the same start and end values.
	(Is_Int_Range_Bounds): Determine whether a node is an integer range.
	(Build_Record_Aggr_Code): Perform proper sliding of a nested array
	aggregate when it is part of an object declaration.
	(Build_Record_Aggr_Code)  If the aggregate ttype is a derived type that
	constrains discriminants of its parent, add explicitly the discriminant
	constraints of the ancestor by retrieving them from the
	stored_constraint of the parent.

Attachment: difs.38
Description: Text document


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]