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] |
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] |