Version 1.16 of ai05s/ai05-0115-1.txt

Unformatted version of ai05s/ai05-0115-1.txt version 1.16
Other versions for file ai05s/ai05-0115-1.txt

!standard 3.9(12.2/2)          11-05-14 AI05-0115-1/11
!standard 4.3.2(5/2)
!standard 4.6(21/2)
!standard 4.6(24/2)
!standard 7.3.1(5/1)
!class binding interpretation 08-10-15
!status Amendment 2012 11-05-14
!status work item 08-10-15
!status received 08-07-25
!priority Medium
!difficulty Medium
!qualifier Omission
!subject Aggregates with components that are not visible
!summary
An aggregate is illegal if its type is a descendant of a partial view of relevant ancestor types.
The relevant view of the ancestor type of an extension aggregate must not have unknown discriminants if the ancestor part is specified with a subtype_mark.
Type conversion, type coverage, formal derived type matching, etc., is permitted any place where the chain of derivations connecting the two types is visible, even if one of the ancestors in the chain might not have visibility on all of the intermediate derivations.
For type conversion, we don't consider the root numeric types when looking for a common ancestor.
!question
Consider the following:
package Pak1 is type T1 is tagged private; private type T1 is tagged record C1 : Integer; end record; end Pak1;
with Pak1; package Pak2 is type T2 is new Pak1.T1 with record C2 : Integer; end record; end Pak2;
with Pak2; package Pak1.Pak3 is type T3 is new Pak2.T2 with record C3 : Integer; end record; procedure Foo; end Pak1.Pak3;
package body Pak1.Pak3 is
procedure Foo is R : T3; N : Integer; begin N := R.C1; -- (A: Error.) R := (C1 => 1, C2 => 2, C3 => 3); -- (B: Legal? No.) R := (C2 => 2, C3 => 3, others => 1); -- (C: Legal? No.) R := (others => 4); -- (D: Legal? No.) end Foo;
end Pak1.Pak3;
(A) is illegal by 7.3.1(4). Although the component F1 of the grandparent type has become visible in the body of Pak1.Pak3, 7.3.1(4) speaks about "additional characteristics of the parent type" becoming visible, and there isn't any place where the hidden component F1 of the type T2 becomes visible. AI95-0157 confirms this interpretation.
That means that (B) is illegal, because one of the component names is not visible. But what about (C) and (D), which define a value for the component without mentioning its name?
A related example is:
package T_Pack is type T (<>) is abstract tagged limited private; private type T (C: Character) is abstract tagged limited null record; end T_Pack;
with T_Pack;
package S_Pack is use T_Pack; type S is new T with null record; function Create return S; end S_Pack;
package body S_Pack is function Create return S is begin return S'(T with null record); -- Legal? (No.) end Create; end S_Pack;
Here the ancestor type has unknown discriminants, so that actual discriminant C is not visible.
!recommendation
(See Summary.)
!wording
Add after 3.9(12.2/2):
For the purposes of the dynamic semantics of functions Descendant_Tag and Is_Descendant_At_Same_Level, a tagged type T2 is a /descendant/ of a type T1 if it is the same as T1, or if its parent type or one of its progenitor types is a descendant of type T1 by this rule [Redundant:, even if at the point of the declaration of T2, one of the derivations in the chain is not visible].
AARM Discussion: In other contexts, "descendant" is dependent on visibility, and the particular view a derived type has of its parent type. See RM 7.3.1.
Modify 4.3.2(5/2):
If the ancestor_part is a subtype_mark, it shall denote a specific tagged subtype. If the ancestor_part is an expression, it shall not be dynamically tagged. The type of the extension_aggregate shall be [derived from] {a descendant of} the type of the ancestor_part {(the /ancestor/ type)}, through one or more record extensions (and no private extensions). {If the ancestor_part is a subtype_mark, the view of the ancestor type from which the type is descended (see 7.3.1) shall not have unknown discriminants.}
Modify 4.6(21/2):
If there is a type {(other than a root numeric type)} that is an ancestor of both the target type and the operand type, or both types are class-wide types, then at least one of the following rules shall apply:
Modify 4.6(24/2):
If there is no type {(other than a root numeric type)} that is the ancestor of both the target type and the operand type, and they are not both class-wide types, one of the following rules shall apply:
Add after 7.3.1(5/1):
A type is a /descendant/ of the full view of some ancestor of its parent type only if the current view it has of its parent is a descendant of the full view of that ancestor. More generally, at any given point, a type is descended from the same view of an ancestor as that from which the current view of its parent is descended. This view determines what characteristics are inherited from the ancestor, [Redundant: and, for example, whether the type is considered to be a descendant of a record type, or a descendant only through record extensions of some more distant ancestor].
[Redundant: It is possible for there to be places where a derived type is visibly a /descendant/ of an ancestor type, but not a descendant of even a partial view of the ancestor type, because the parent of the derived type is not visibly a descendant of the ancestor. In this case, the derived type inherits no characteristics from that ancestor, but nevertheless is within the derivation class of the ancestor for the purposes of type conversion, the "covers" relationship, and matching against a formal derived type. In this case the derived type is considered to be a /descendant/ of an incomplete view of the ancestor.]
[AARM Discussion: Here is an example of this situation:
package P is
type T is private; C : constant T;
private type T is new Integer; C : constant T := 42;
end P;
with P;
package Q is
type T2 is new P.T;
end Q;
with Q;
package P.Child is
type T3 is new Q.T2;
private Int : Integer := 52; V : T3 := T3(P.C); -- legal: conversion allowed W : T3 := T3(Int); -- legal: conversion allowed X : T3 := T3(42); -- error: T3 is not a numeric type Y : T3 := X + 1; -- error: no visible "+" operator Z : T3 := T3(Integer(X) + 1); -- legal: convert to Int first
end P.Child;
]
!discussion
Logically, an aggregate is a shorthand for setting each component individually. If setting a component explicitly is illegal because of a visibility issue, then the same rule ought to apply to the equivalent aggregate. Thus all of the example aggregates are illegal.
Note that a similar case can be constructed for extension aggregates: Make type T1 in the example derived from a root type, then consider aggregates like:
R := (Root with C1 => 1, C2 => 2, C3 => 3); -- (Illegal.) R := (Root with C2 => 2, C3 => 3, others => 1); -- (Illegal.) R := (Root with others => 4); -- (Illegal.)
We tried a number of different wording attempts, none of which were entirely satisfactory. Conceptually, all we really want to do is to add a rule that makes record (and extension) aggregates illegal if the type of the aggregate has any "hidden" components. However, we have no way of talking about hidden components. In general, such components may never even be inherited, even though they exist behind the scenes, and changing the rules for component inheritance would be too large a change to address this specific problem.
An attempt was made to define a new characteristic of type views that indicates when a view of a type has "known components". However, it seems heavy to have to introduce a new characteristic and technical term to address this narrow problem. There were also reservations expressed that the proposed wording did not capture locality very well (see !discussion of the previous version of this AI (AI05-0115-1/04)).
Here we take the approach of defining the view of an ancestor from which a given view of a type is a descendant. The basic principle is that you inherit characteristics from an ancestor only through your immediate parent type, and you can never end up with "more" characteristics than that of your parent type. However, we have preserved the ability to convert to any visible ancestor, even if the parent is unaware of the ancestor.
The reference manual was scanned to see whether to extend the notion of "descendant of a view" to the more general definition of "descendant." It was decided to preserve the most "generous" definition of descendant, while disallowing inheriting any characteristics if the full chain of derivation was not visible to the parent type. When no characteristics are inherited from an ancestor, we consider the derived type to be a descendant of an incomplete view of the ancestor. It was also decided that the definition of "descendant" for the purposes of the run-time semantics of functions like Ada.Tags.Descendant_Tags should not depend on "views" even though the static semantics does to some extent.
To be precise about where a change to the general definition of "descendant" would have had significant effects:
In 3.4.1(9-10) we define "derivation class," "ancestor," and "cover," in terms of type derivation and/or descendant. In all cases, an altered definition of "descendant" would have an impact on the question of whether a given type is in a particular derivation class, whether it is covered by the class-wide type of that class, whether the root of the derivation class is an ancestor, etc.
In 4.6(21-24) on type conversion, there are several uses of the terms "ancestor" and "descended from." With an altered definition of "descendant," these rules would preclude converting to an ancestor of which the parent is not aware. AI95-00157 addresses the question of whether you must use conversion to a grandparent type to gain access to a component that the grandchild type inherits from the grandparent, but which its immediate parent cannot see. Such a change would disallow even the conversion to an ancestor if the parent did not "know" about the ancestor.
In 8.6(21, 25, 25.1, 27.1) whether one type "covers" another affects both name resolution and legality. With an altered definition of "descendant," whether a given class-wide type covers a particular type would depend on the visibility of the chain of derivation to the parent type.
In 12.5.1(5.1/3), an actual type for a formal derived type is required to be a descendant of the specified ancestor type and of the specified progenitors. An altered definition of "descendant" would require that the chain of derivation be visible to the view of the parent of the actual type from which the current view of the actual type is derived. If at the point of the instantiation, more is visible than at the point where this view of the parent type was declared, no use of that information could be made in determining legality.
We worried that an altered definition of descendant might create incompatibilities, and there seemed no definitional concern with allowing conversions, matching, etc., to be as generous as possible. So long as it inherits characteristics only from ancestors from which its parent inherits characteristics, we felt there would be no problem. Effectively a type can be a descendant of what we might call the "incomplete" view of some ancestor. No characteristics come from it, other than the ability to convert (explicitly or implicitly due to being "covered") or to pass as an actual in a generic instantiation.
We altered the rules on type conversions slightly for the "common ancestor" case (paras 21-24), so that a root numeric type is not allowed to be the only common ancestor for these rules to apply. This seems to conform with existing practice.
See the !example section below for more detailed discussion of how this view-related definition of ancestor relates to the original question, namely the legality of various aggregates.
---
We added a separate rule about ancestors with unknown discriminants. It is really weird to have to logically look into the private part to justify these are illegal. We also want this to be rejected even if the full type does not have any discriminants. Finally, we also want to cover generic cases:
generic type T (<>) is tagged private; package Gen_Pack is type New_T is new T with record A : Integer; end record; function Create return New_T; end Gen_Pack;
package body Gen_Pack is function Create return New_T is begin return New_T' (T with A => 10); end Create; end Gen_Pack;
where the components in question are completely unknown when the generic body is compiled.
!example
The following example includes the interesting cases identified by discussion on this topic.
package Pkg1 is type T1 is tagged private; private type T1 is tagged record C1 : Integer; end record; end Pkg1;
package Pkg1.Pkg2 is -- Private case type T2 is new Pkg1.T1 with private; X1 : T2 := (others => 1); -- Illegal, because here, -- T2 is not a descendant of a record type. private type T2 is new Pkg1.T1 with record C2 : Integer; end record; X2 : T2 := (C1 | C2 => 1); -- Legal, because here T2 is a descendant of -- a record type, through a record extension. end Pkg1.Pkg2;
package Pkg1.Pkg3 is -- Record case type T3 is new Pkg1.T1 with record C2 : Integer; end record; X1 : T3 := (others => 1); -- Illegal, because here, -- T3 is not a descendant of a record type. private X2 : T3 := (C1 | C2 => 1); -- Legal, because here T3 is a descendant of -- a record type, through a record extension. end Pkg1.Pkg3;
with Pkg1.Pkg2, Pkg1.Pkg3; package body Pkg1 is type T4 is new Pkg2.T2 with record C1 : Integer; end record; X3 : T4 := (C1 => 1, C2 => 2); -- Illegal, because T4 is a descendant -- of a partial view (since that is the -- view from its parent T2) -- through a private extension. X4 : T4 := (others => 1); -- Illegal, for same reason
type T5 is new Pkg3.T3 with record C3 : Integer; end record; X5 : T5 := (C3 => 1, C2 => 2, C1 => 1); -- Illegal, because T5 is a descendant -- of a partial view (since that is the -- view from its parent type T3). X6 : T5 := (C2 => 2, others => 1); -- Illegal for same reason.
type T6 is new Pkg3.T3 with record C1 : Integer; end record; -- Legal because T3 never sees T1's component C1, so neither does T6. X7 : T6 := (C1 => 1, C2 => 2); -- Illegal since T6 is a descendant of a -- partial view (since that is the view -- from its parent T3). X8 : T6 := (C2 => 2, others => 1); -- Illegal for same reason.
end Pkg1;
Note that X5 through X8 are arguably legal by the Ada 2005 rules.
!corrigendum 03.09(12.2/2)
Insert after the paragraph:
The function Is_Descendant_At_Same_Level returns True if the Descendant tag identifies a type that is both a descendant of the type identified by Ancestor and at the same accessibility level. If not, it returns False.
the new paragraph:
For the purposes of the dynamic semantics of functions Descendant_Tag and Is_Descendant_At_Same_Level, a tagged type T2 is a descendant of a type T1 if it is the same as T1, or if its parent type or one of its progenitor types is a descendant of type T1 by this rule, even if at the point of the declaration of T2, one of the derivations in the chain is not visible.
!corrigendum 4.3.2(5/2)
Replace the paragraph:
If the ancestor_part is a subtype_mark, it shall denote a specific tagged subtype. If the ancestor_part is an expression, it shall not be dynamically tagged. The type of the extension_aggregate shall be derived from the type of the ancestor_part, through one or more record extensions (and no private extensions).
by:
If the ancestor_part is a subtype_mark, it shall denote a specific tagged subtype. If the ancestor_part is an expression, it shall not be dynamically tagged. The type of the extension_aggregate shall be a descendant of the type of the ancestor_part (the ancestor type), through one or more record extensions (and no private extensions). If the ancestor_part is a subtype_mark, the view of the ancestor type from which the type is descended (see 7.3.1) shall not have unknown discriminants.
!corrigendum 4.6(21/2)
Replace the paragraph:
If there is a type that is an ancestor of both the target type and the operand type, or both types are class-wide types, then at least one of the following rules shall apply:
by:
If there is a type (other than a root numeric type) that is an ancestor of both the target type and the operand type, or both types are class-wide types, then at least one of the following rules shall apply:
!corrigendum 4.6(24/2)
Replace the paragraph:
If there is no type that is the ancestor of both the target type and the operand type, and they are not both class-wide types, one of the following rules shall apply:
by:
If there is no type (other than a root numeric type) that is the ancestor of both the target type and the operand type, and they are not both class-wide types, one of the following rules shall apply:
!corrigendum 7.3.1(5/1)
Insert after the paragraph:
For example, an array type whose component type is limited private becomes nonlimited if the full view of the component type is nonlimited and visible at some later place immediately within the declarative region in which the array type is declared. In such a case, the predefined "=" operator is implicitly declared at that place, and assignment is allowed after that place.
the new paragraphs:
A type is a descendant of the full view of some ancestor of its parent type only if the current view it has of its parent is a descendant of the full view of that ancestor. More generally, at any given point, a type is descended from the same view of an ancestor as that from which the current view of its parent is descended. This view determines what characteristics are inherited from the ancestor, and, for example, whether the type is considered to be a descendant of a record type, or a descendant only through record extensions of some more distant ancestor.
It is possible for there to be places where a derived type is visibly a descendant of an ancestor type, but not a descendant of even a partial view of the ancestor type, because the parent of the derived type is not visibly a descendant of the ancestor. In this case, the derived type inherits no characteristics from that ancestor, but nevertheless is within the derivation class of the ancestor for the purposes of type conversion, the "covers" relationship, and matching against a formal derived type. In this case the derived type is considered to be a descendant of an incomplete view of the ancestor.
!ACATS Test
B-Tests for examples like these should be constructed.
!appendix

!topic Component visibility question
!reference 4.3.1(14), 7.3.1(4), AI95-157
!from Adam Beneschan 08-07-25
!discussion

I'm having trouble figuring out how the visibility and private-operation rules
apply in this case:

    package Pak1 is
        type T1 is tagged private;
    private
        type T1 is tagged record
            F1 : Integer;
        end record;
    end Pak1;

    with Pak1;
    package Pak2 is
        type T2 is new Pak1.T1 with record
            F2 : Integer;
        end record;
    end Pak2;

    with Pak2;
    package Pak1.Pak3 is
        type T3 is new Pak2.T2 with record
            F3 : Integer;
        end record;
        procedure Foo;
    end Pak1.Pak3;

    package body Pak1.Pak3 is

        procedure Foo is
            R : T3;
            N : Integer;
        begin
            N := R.F1;                            -- (A)
            R := (F1 => 1, F2 => 2, F3 => 3);     -- (B)
            R := (F2 => 2, F3 => 3, others => 1); -- (C)
            R := (others => 4);                   -- (D)
        end Foo;

    end Pak1.Pak3;

I'm pretty sure that the component selection in (A) is illegal, based on
the wording in 7.3.1(4).  Although the component F1 of the grandparent type
has become visible in the body of Pak1.Pak3, 7.3.1(4) speaks about "additional
characteristics of the parent type" becoming visible, and there isn't any place
where the hidden component F1 of the type T2 becomes visible.  I think this
case is covered by AI95-157 also.

(B) is a rather different case.  Normally, an aggregate would be illegal for
a derived type if the ultimate ancestor were a private type (rather than a
record type), or if any private extensions were involved (4.3.1(14)).  In this
case, though, there are no private extensions; and at the point where statement
(B) occurs, the type is derived from a record type, not a private type, since
the full view of T1 is available and T1 is a record type. Should 4.3.1(14)
somehow be interpreted so that, in this case, T3 is still considered a
descendant of a "private type" rather than a "record type" since there's an
intermediate parent type for which "additional characteristics" have not become
visible?

Even if the aggregate in (B) is not illegal by 4.3.1(14), it would still seem
to be illegal since one of the component names, F1, is not actually a visible
component of the type (for the same reason as in (A)).  Assuming that's the
case, then what about (C) and (D)?  Are they illegal or not?

I'm guessing that AI95-157 applies to (B), (C), and (D) also, and that any
record aggregate of type T3 is illegal regardless of what components are or
are not named using named notation.  [Extension aggregates are still OK.]
But it's not 100% clear to me that the principle applies, given that the
wording of 4.3.1(14) doesn't seem to use any of the terms that 7.3.1(4)
or AI95-157 discuss.  (Is the ability to specify an aggregate an "operation"
of a record type?  I don't think the RM answers that definitively.)

****************************************************************

From: Adam Beneschan
Sent: Friday, August 8, 2008  5:25 PM

Since I posted this, I found that this question affects a publicly available
open-source Ada suite, PolyORB.  If I'm right, then the Ada source for that
suite is illegal (but GNAT apparently does not catch it).  If possible, I'd
appreciate some opinion on whether this code is actually illegal, before I
make a bug report to the maintainers.

Here are the relevant constructs from the source:

    package PolyORB.SOAP_P.Message is
       type Object is tagged private;
    private
       type Object is tagged record
          Name_Space   : Unbounded_String;
          Wrapper_Name : Unbounded_String;
          P            : SOAP_P.Parameters.List;
       end record;
    end PolyORB.SOAP_P.Message;

    package PolyORB.SOAP_P.Message.Response is
       type Object is new Message.Object with null record;
    end PolyORB.SOAP_P.Message.Response;

    with PolyORB.SOAP_P.Message.Response.Error;
    package body PolyORB.SOAP_P.Message.XML is

       (... in a Load_Response function:)

       return new Message.Response.Object'       -- LEGAL???
          (Null_Unbounded_String,
           S.Wrapper_Name,
           S.Parameters);

    end PolyORB.SOAP_P.Message.XML;

If my interpretation is correct, then the components of the derived type
Message.Response.Object (and, indeed, the fact that it's a record) do not
become visible until a point in PolyORB.SOAP_P.Message.Response where the
private part of PolyORB.SOAP_P.Message is visible, i.e. the private part of
PolyORB.SOAP_P.Message.Response.  And, since the private part of
PolyORB.SOAP_P.Message.Response is not at all visible inside
PolyORB.SOAP_P.Message.XML, the inherited components of Message.Response.Object
are not visible either, and therefore the aggregate should not be legal.

Thoughts?

****************************************************************

From: Randy Brukardt
Sent: Friday, August 8, 2008  7:34 PM

Without considering the case very fully, it seems clear that the intent of
4.3.1(14) is that a record aggregate is not allowed for a record extension
if any of the ancestors is a partial view rather than a record of some sort.
And clearly this needs to be "frozen" once an extension is done which is
out of scope of the original type, just as for components. So I think that
an aggregate should be illegal (given the current rules; I would have
preferred that we find a way to allow aggregates for private types, but
since that failed we shouldn't be allowing funny holes).

But there clearly is no current reason to think that the Standard answers
this question at all. The only reason to think this way is that the model of
AI95-0157 should apply here, too, and that will require a new rule of some
sort. So it's probably impossible to say definitely that a compiler that
works some other way is wrong. Whether to send in a bug report is therefore
impossible to answer.

****************************************************************

A brief summary of a private e-mail discussion between Steve Baird,
Tucker Taft, and Randy Brukardt in October 2008 [discussing version /01
of this AI].

Steve:

I think the following should be legal. Would your wording cause it to
be rejected?

   package Parent is
     type T0 is tagged null record;
     type T1 is new T0 with private;
   private
     type T1 is new T0 with record
       F1 : Integer;
     end record;
   end Parent;

    package Parent.Child is
      type T2 is new T1 with null record;
    private
      X2 : T2 := (F1 => 37);
    end Parent.Child;

The point is that, at the point of derivation, T2 was derived from a
private extension.

Randy:

You are correct, so my proposed wording doesn't work.
Apparently, there isn't any idea that works (basing it on component visibility
breaks privacy, because it would allow null records, and basing it on potential
component visibility is just too goofy for words).

Tucker:

One interesting way to illustrate the problem would be for
Pak2.T2 to have its *own* "C1" component, which would be legal.
Clearly the C1 component from T1 should never be visible in T3, even in its own body.

Randy:

True. That would be a bad example here, though, because it would make the named
notation aggregate illegal.

I suppose one alternative would be to step back further and think about if we
want to eliminate the privacy instead -- that is (given the other issues that
Adam raised), perhaps we need to make the components visible in this case (and
then we don't need a legality rule). Similarly with the inherited operations.
But that would be incompatible.

In an example like the one Tucker mentions, the declaration of T3 would have to be
illegal as it would declare two components with the same name. That seems OK to
me (it would be a better incompatibility than some sort of boujalias effect), but
it clearly would break some code.

****************************************************************

And the discussion continues after another attempt at wording this AI.
Following is a summary of a private e-mail discussion between Steve Baird,
Tucker Taft, and Randy Brukardt in October 2008 [discussing version /02
of this AI].

Tucker:

This is actually the kind of wording I would presume we need, because it is
based on the "some place in the immediate scope" style of wording, which is
how the other rules are defined.

I suppose I find it a bit odd to say that some place...
it "is" a record or record extension.  I think what we mean is that it's full
definition is visible at some place ...

Randy:

Such a rewording doesn't quite work, because nothing says that the parent
has to be a private type. Well, I guess it does, given that full types are
defined for all types, but it would be misleading as most readers would
think it only applies to private types. Especially as the existing wording
never talks about full types, preferring to talk about records and record
extensions instead. It would be weird to change horses in midstream, so to
speak. One could argue that the existing wording would be better if it
talked about full types rather than "records and record extensions", but
that is a different deal.

Steve:

We want my example (above) to be accepted and this accomplishes that.
If you delete the word "private" from package Parent.Child, thereby moving the
declaration of X2 out of the private part of Parent.Child, we want that modified
version of the example to be rejected. It seems like your idea does not accomplish
that. The fact that there exists some place where all of the record components
are visible should not really matter very much if the aggregate in question
occurs somewhere other than that place.

Could you solve the problem of positional aggregates by somehow tying the legality
of a positional aggregate to the legality of an equivalent named-notation
aggregate?

Tucker:

This clearly seems to be a visibility issue, and it seems that the full definitions
of the record type and any extensions need to be visible at the point of the
aggregate. This is in addition to the full definition of the parent type of each
record extension being visible somewhere within the immediate scope of that
extension. I think the first part is probably adequately covered by the existing
wording, and the second part is additional. Your initial example violates the
second part, and if you move the aggregate above the "private" it violates the
first part (and the existing wording).

Randy:

Right. The new wording is in addition to the existing wording, and surely the
revised example violates the existing wording (because the aggregate has a private
extension in its derivation chain). I worried about that quite a bit, but I wasn't
able to find any case where one or the other didn't catch the problem.

Steve:

>   Moreover, for each of those record extensions R, there shall
>   exist some place in the immediate scope of the type R where
>   the parent type of R is a record or record extension.

This wording, at least as I interpreted it, seemed to suggest that the existence
or nonexistence of a region in which certain characteristics of a derived type
are visible might somehow affect the legality of certain aggregates outside of
this region.

Randy:

Yes, and that was purely intentional. Any case where that would matter is already
illegal by the existing rule (I *think*), so I opted for the simpler wording rather
than trying to complicate it with the position of the aggregate.

Steve:

Given that 7.3.1(3/3) only says that the characteristics "become
visible" and determining the region in which this visibility applies
is left as an exercise for the reader, I suppose Randy was only
following precedent.

Randy:

That's not what I was thinking. I really was expecting the rule to apply anywhere
to that particular type, it just doesn't matter when you are outside of the region
of visibility because the aggregate is already illegal in that case.

The question is whether you, our designated weird-case finder, can find a case that
is legal by the existing rule *and* legal by this rule, where the aggregate is
outside of the region of visibility of the parent type (but that there exists some
place where the parent type is visible in the immediate scope). In that case this
rule would be wrong. I don't know of any such case, and it seems impossible, as
being outside of the region of visibility of the parent would seem to automatically
trigger the existing rule.

Steve:

I don't think this wording addition handles the following case:

   package Pkg1 is
      type T1 is tagged private;
   private
      type T1 is tagged null record;
   end Pkg1;

   package Pkg1.Pkg2 is
      type T2 is new Pkg1.T1 with record F1 : Integer; end record;
   private
      X2 : T2 := (F1 => 1); -- legal
   end Pkg2;

   with Pkg1.Pkg2;
   package body Pkg1 is
      type T3 is new Pkg2.T2 with record F2 : Integer; end record;

      X3 : T3 := (F1 => 1, F2 => 2); -- should be illegal
   end Pkg1;

To really nail this down and handle the case that you mentioned about a
private tagged type that is implemented as a null record, you might need to
define a new characteristic, something like 'A type that is derived (directly
or indirectly) from a tagged private type or from a private extension "has
unknown components"'. A legality rule could then prohibit a record aggregate
of a type that has unknown components.

As Tuck point out, you can really force the issue by declaring multiple
components with the same name. It is intended that any type that has (or is
only a component declaration away from legally having) multiple components
with the same name must "have unknown components".

Randy:

Yes, you are right. So it looks like all of the visibility crap will have to
be dragged into this wording.

I don't think your "unknown components" solution works at all. It's exactly
equivalent to my one of my original attempts and those didn't work.

The problem is that it isn't clear where this property would be calculated.
If you calculate it at the point of the declaration of each type, then it is
exactly equivalent to the first wording that I proposed and which you pointed
out doesn't work.

If you say that it is calculated at the point of the aggregate, then it is
exactly equivalent to the existing wording, and we already know *that*
doesn't work. (In Adam's original example, there are no private types at the
point of the aggregate: everything has a full view visible.)

If you make the claim that it is calculated in some other way, well there
better be a lot more wording explaining what that way is! Visibility definitely
needs to be involved here, but I don't see precisely how. As you previously
have pointed out, it changes with the region that you are in.

> It is intended that any type that has (or is only a component declaration
> away from legally having) multiple components with the same name must
> "have unknown components".

OK, but how do you describe that? I've already tried (twice) without any
success. The above description is a goal, not a language rule. No one could
remotely figure out what this means in practice.

So I'd suggest proposing some wording that actually works (don't worry about
how complicated) and we'll go from there.

Tucker:

T2 is a record extension in this new example, so this aggregate should be
legal. Steve, why do you think it should be illegal? There is no way that
in this example T1 could have a component named "F1" or "F2" so what is the
danger?

Steve:

The set of components that T2 inherits from T1 is fixed at the point of T2's
derivation and is independent of T1's completion. If we modified the private
part of Pkg1 to add a Foo component to T1, T2 (as viewed from outside of the
intersection of the immediate scopes of T1 and T2) would still would not
have a Foo component. Thus, T3 (which is declared outside of the aforementioned
intersection) would not inherit a Foo component from T2.

Ignoring discriminated types for the moment, you never want to allow an aggregate
of a type whose set of components (as defined in the static semantics) does not
include all of the components of each of its ancestors.

Do you agree that this example should be illegal if T1's completion included
at least one component? I'm talking about desirability here and odd dynamic
semantics if this were allowed, not about how the present wording of the manual
handles this case.

If so, then are you saying that completing T1 as a null record should make a
difference?

For another argument, let's look at what would happen if T1 were completed as
   type T1 is record F2 : Float; end record;

T2 (as viewed from outside of Pkg2) has no F2 component.
Thus T3 has no inherited F2 component.
Thus 8.3(26/2)'s statement that "a type extension is illegal if somewhere within
its immediate scope it has two visible components with the same name" does not
apply.

Do you really want to allow this case?

Tucker:

I don't agree with your statement that the set of components of T2 is fixed at
the point of T2's derivation.  When the additional characteristics of T1 become
visible, then T2 acquires those characteristics as well, namely having any
components that T1 has. I believe 7.3.1(4) and 7.3(15) make this relatively clear:

Paragraph 7.3.1(4/1) says:

    The corresponding rule applies to a type defined by a
    derived_type_definition, if there is a place immediately
    within the declarative region in which the type is declared
    where additional characteristics of its parent type become
    visible.

Paragraph 7.3(15) says:

   ... the *characteristics* of the type are ...
   the classes that include the type, which components,
   entries, and protected subprograms are visible...

If we don't agree that T2 inherits the components of T1 at the point the full view
of T1 becomes visible, then we have bigger problems...

Perhaps what you mean by your statement is that the set of components inherited by
T3 *from* T2 is fixed, even though T2 goes on to inherit more components after
getting into the private part.

So I now understand how these issues are linked. Should a type inherit components
from its *grandparent* if its parent eventually inherits those components, even
though we can't "see" the place where that occurs?

It seems more flexible, and still not privacy breaking, to say that *yes*, a type T
can inherit characteristics from *any* ancestor so long as all intermediate ancestors
inherit those characteristics eventually. The type T inherits those characteristics
if and when they become visible immediately within the declarative region in which T
is declared. So you can never end up with "more" components than your parent will
eventually have, but you can end up with more components than are visible in your
parent to "you." I suppose we could go one step further and say that the components
of a type are visible even if we have no visibility on the place where they become
visible, so long as we "know" they will eventually become visible.

That seems friendliest, as it means you can refer to any components you know they have,
so long as they will eventually know they have it as well.

I wonder how disruptive this would be for your average Ada compiler?

Steve:

You are right, I was speaking imprecisely.
I said:
   The set of components that T2 inherits from T1 is fixed at the
   point of T2's derivation and is independent of T1's completion.
   If we modified the private part of Pkg1 to add a Foo component to T1,
   T2 (as viewed from outside of the intersection of the immediate
   scopes of T1 and T2) would still would not have a Foo component.

When I said "fixed at the the point of T2's derivation", I should have
repeated the parenthetical comment that is in the second sentence:
   (as viewed from outside of the intersection of the immediate
    scopes of T1 and T2)

I don't think this affects the validity of the point I was trying to make.

> I wonder how disruptive this would be for your average Ada
> compiler?

I agree, this might be a reasonable model but it definitely
is a change. Rational implements most of this stuff via
a scheme that was implemented by one Bob Duff.
I think that the change that you are proposing would require
a substantial redesign of this part of the compiler.

On the other hand, this could be justified if the present
rules are shown to be seriously broken.

If you modify my example as I described previously by giving T1
a component named F2, then 8.3(26/2)'s statement that "a type
extension is illegal if somewhere within its immediate scope it has
two visible components with the same name" does not
apply because T3 does not inherit a visible F2 component
from T2. Is this a problem? I'm trying to decide if there
are any issues with formal derived types, view conversions,
etc. It seems odd that given
    X : T3,
, X.F2 and T1 (X).F2 would denote different components.

Randy:

Well, it would be no problem for Janus/Ada, because we never got
multiple components with the same name to work (and thus have that
capability disabled). We'd just have to add some code to toggle the
visibility bit on the component. Not that that proves anything (and
that might be harder than it seems).

The model Tucker is proposing here is essentially the same as what I
was informally describing "dropping the hidden components rule".
Specifically, we would reverse the Ramification of AI95-00157.
AI95-00150 already covers the case of two components with the same name
becoming visible at the same time (which I was worried about), so it
simply (if such a thing is possible) would require making the
inheritance for components apply to all ancestors.

One wonders if something similar should be done for operations (which
is the question Adam asked Oct 3, and will have its own AI).

> If you modify my example as I described previously by giving T1 a
> component named F2 (Randy: F is for "Field"), then 8.3(26/2)'s
> statement that "a type extension is illegal if somewhere within its
> immediate scope it has two visible components with the same name" does
> not apply because T3 does not inherit a visible F2 component from T2.
> Is this a problem? I'm trying to decide if there are any issues with
> formal derived types, view conversions, etc. It seems odd that given
>     X : T3,
> , X.F2 and T1 (X).F2 would denote different components.

But that is not new. We in fact use such type conversions in Claw to
access root-level components. (We never overlap the names because of
the aformentioned Janus/Ada limitations, but a user could do that if
using some other compiler.)

In my extended example:

    package Pkg1 is
       type T1 is tagged private;
    private
       type T1 is tagged record C1 : Integer; end record;
    end Pkg1;

    package Pkg1.Pkg2 is -- Private case
       type T2 is new Pkg1.T1 with private;
       X1 : T2 := (others => 1); -- Illegal by the existing rule.
    private
       type T2 is new Pkg1.T1 with record C2 : Integer; end record;
       X2 : T2 := (C1 | C2 => 1); -- Legal (one hopes)
    end Pkg1.Pkg2;

    package Pkg1.Pkg3 is -- Record case
       type T3 is new Pkg1.T1 with record C2 : Integer; end record;
       X1 : T3 := (others => 1); -- Illegal by the existing rule.
    private
       X2 : T3 := (C1 | C2 => 1); -- Legal (one hopes)
    end Pkg1.Pkg3;

    with Pkg1.Pkg2, Pkg1.Pkg3;
    package body Pkg1 is
       type T4 is new Pkg2.T2 with record C1 : Integer; end record;
            -- T2 does not have a (visible) C1 component.
       X3 : T4 := (C1 => 1, C2 => 2); -- Illegal by the existing rule.
       X4 : T4 := (others => 1); -- Illegal by the existing rule.

       type T5 is new Pkg3.T3 with record C3 : Integer; end record;
            -- T3 does not have a (visible) C1 component. The fact that one is declared in
            -- in the private part is irrelevant.
       X5 : T5 := (C3 => 1, C2 => 2, C1 => 1); -- Should be illegal as C1 is missing.
       X6 : T5 := (C2 => 2, others => 1); -- Should be illegal as don't have
                                          -- visibility on C1.

       type T6 is new Pkg3.T3 with record C1 : Integer; end record;
            -- Legal with the current rules, as C1 never becomes visible for this type.
       X7 : T6 := (C1 => 1, C2 => 2); -- Should be illegal as one of the C1's
                                      -- is missing.
       X8 : T6 := (C2 => 2, others => 1); -- Should be illegal as don't have visibility
                                          -- on the original C1.

     end Pkg1;

This example shows what makes this so devilishly complex. It doesn't even
necessarily depend on the types; the component can be hidden even when the
type is not if it appears later in the declarative region of the type.

If we declared XA : T4; (no aggregate), then XA.C1 is the T4 C1, and T1(XA).C1 is
the T1 C1. Nothing new here (but I agree it is weird).

If we were to adopt a rule such as the one Tucker described, then T5 would
inherit a C1 component; X5 and X6 would be legal (all of the components are
visible). In addition, T4 and T6 would be illegal by 8.3(26/2), so we don't
have to worry about the name clash. In the case of X3 and X4, they would
remain illegal by the existing rule.

Effectively, we either make a big change in the inheritance of components
or we make a big, complex legality rule for aggregates (one that we can't
even describe how it works).

Steve:

It seems clear to me that changing the visibility rules for inherited components
is a substantially bigger change than adding a rule prohibiting aggregates
in certain cases.

I would think that we would only go with the former alternative if we really
can't come up with wording for the aggregate rule (or if the former
alternative somehow fixes some other problems as well).

Randy:

This is so hard to define because this is not a property of any type alone.
It is a property of all of the following:
  (1) The location the aggregate is declared;
  (2) The location where the parent type is declared (vis/priv;
                child/sibling/parent/unrelated);
  (3) Whether or not the parent type has an explicit partial view;
  (4) The location where the extension is declared (vis/priv;
                child/sibling/parent/unrelated);
  (5) Whether or not the extension has an explicit partial view.
  (6) The 2-5 repeated for every extension in the derivation chain.

Obviously, some of the combinations are ruled out by the existing rule,
but nowhere near enough.

Steve:

I'll give it a shot.

In 4.3.1 we add a static semantics section ahead of the existing legality
section which contains:

  A specific tagged type T is said to "have hidden components"
  if it is a tagged private type, a private extension, or a
  descendant of a type which has hidden components.
  Given a specific tagged type T which is a descendant of a type A,
  T is said to "extend A with hidden components" if any
  ancestor of T which is not also an ancestor of A has
  hidden components.

  AARM Note:
  These particular characteristics of the type T follow
  the general rules concerning characteristics of a
  type given in 7.3.1.

  Consider the following example:

    package Pkg1 is
      type T1 is tagged private
      -- T1 has hidden components here.
    private
      type T1 is tagged null record;
      -- T1 lacks hidden components here.
    end Pkg1;

    package Pkg1.Pkg2 is
      type T2 is new Pkg1.T1 with null record;
      -- T2 has hidden components here because
      -- T1 has hidden components (as seen from
      -- here).
    private
      -- T2 lacks hidden components here.
    end Pkg2;

    with Pkg1.Pkg2;
    package body Pkg1 is
       type T3 is new Pkg2.T2 with null record;
       -- T3 has hidden components here because T2
       -- has hidden components (as seen from here)
       -- even though T1 does not (as seen from here).
    end Pkg1;


In the Legality Rules section of 4.3.1, we replace 4.3.1(26)
  If the type of a record_aggregate is a record extension, then
  it shall be a descendant of a record type, through one or more
  record extensions (and no private extensions).
with
  The type of a record aggregate shall not have hidden components.

In the Legality Rules section of 4.3.2, we replace the second sentence of 4.3.2(5/2)
   The type of the extension_aggregate shall be derived from the type
   of the ancestor_part, through one or more record extensions (and
   no private extensions).
with
   The type of the extension_aggregate shall be derived from the type
   of the ancestor_part. The type of the extension aggregate shall
   not extend the type of the ancestor_part with hidden components.

1) Does this work?
2) Is this a case where it would be useful to explicitly talk about
   views of types as opposed to talking about types:
   'A view of a type is said to have "hidden components" if ... ' ?
3) Are any wording tweaks needed in order to cope with interface types?

Randy:

> 1) Does this work?

I don't think so. The wording of 7.3.1 talks about *additional*
characteristics becoming visible. You are trying to *delete* a
characteristic, which is weird (to say the least).

I tried briefly to turn this around to "known components" (which would
have the right polarity work with 7.3.1), but that doesn't seem to
compose properly.

> 2) Is this a case where it would be useful to explicitly talk about
>    views of types as opposed to talking about types:
>    'A view of a type is said to have "hidden components" if ... ' ?

Yes, because it very view dependent. And it would help make clear that
it depends on the views and on 7.3.1.

> 3) Are any wording tweaks needed in order to cope with interface
> types?

Interfaces can't have components, so it is harmless to have an aggregate
of one of them. So allowing them (where the old wording didn't) seems OK.
(This would be the case where a type is derived from an interface.)

Steve:

Consider, for example, the characteristic of
limitedness/limitation/limitosity (whatever we call it).

Doesn't that shoot down your objection about deleting characteristics?

Furthermore, I see no problem with reversing the polarity of the
characteristic if we decide that we want that.

Randy:

"limitedness" can't be a characteristic, as it is not inherited
(esp. in Ada 2005) -- it's declared in most cases. I don't think any
of the "characteristic" rules apply to it. "non-limitedness" could be
a characteristic (it gets added). I realize that the wording of 7.3.1
is vague enough that a "characteristic" could be pretty much could be
anything you want. For instance, in this particular case, there is no
wording at all about components being a characteristic. So who knows
what the rule really is? It's really been defined by the ACATS and the
various ramification AIs, not by wording in the standard.

> Furthermore, I see no problem with reversing the polarity of the
> characteristic if we decide that we want that.

I think that would be a better approach.

Tucker:

"the characteristics of a type" is defined in 7.3(15):

   ...the *characteristics* of the type are ... the classes that
   include the type, which components, entries, and protected
   subprograms are visible, what attributes and other predefined
   operations are allowed, and whether the first subtype is static.

Although the wording of 7.3(15) is a bit awkward, I think the above
is the way to interpret its definition of "characteristics."

Limitedness is not a "characteristic," since as we all know it is not
a "class" of types... ;-)  Clearly visibility of components *is* a
characteristic, as is the availability of the "operations" of the type.

Tucker:

This sure is tricky! The term "known components" does seem better than
"hidden components." It also works well with "known discriminants."

It does seem a little odd to work this hard to preserve one of the more
surprising aspects of Ada, namely that (metaphorically speaking...) you
can know a type has a component, and it knows it has the component, but
you can't talk about it together. I would rather spend energy coming up
with a nice rule that allowed us to talk about these known components
even in polite company.

Steve:

I would agree if we were starting from scratch, but that would be a much
bigger change and I don't see the justification for it.

Just FYI, the Rational compiler originally implemented the model that any
characteristic of a given type that was known at a given point was also
known about any types that depended on that type (this is in contrast
to the treatment of implicitly declared subprograms because those have
a well-defined point of declaration; characteristics do not).
The view of the parent/component type that was available at the point where
the derived/composite type was declared was ignored; what mattered was
the current view of the type.

This allowed something like

   package P is
      type T is limited private;

      package Inner is
        type A is array (Boolean) of T;
      end Inner;

    private
      type T is new Integer;

      X : Inner.A := (22, 33); -- Ada95, no aggs for limited types
    end P;

At the time that the "correct" Ada95 rules were implemented (by Bob),
it seemed pretty silly to be adding complexity to the implementation in
order to throw away useful information. Scenarios such as "I know that
T1 is an array type and that T2 is derived from T1, but I don't know
that T2 is an array type" always seemed like a mistake to me.

Still, I don't think we should revisit that decision at this point.

Tucker:

I'm not suggesting we go so far as to allow *more* operations on a
type than are possible at a point within the immediate scope of its
declaration. I am simply suggesting parity with that.

Steve:

This version incorporates the polarity change (i.e. "known components" instead
of "hidden components") and the explicit definition of these properties as
"characteristics".

I'm wondering whether there are still problems with types that are derived
from untagged views of tagged types, and aggregates of those derived types.

I included the phrase "... nor an immediate descendant of a descendant of A
which ..." instead of the simpler "... not an immediate descendant of a type
which ..." because of worries about interface types. If the progenitors of
a type T include both A and some interface type I, then I don't want someone
to argue that T is an immediate descendant of a type (i.e., I) which does
ot extend A with known components. Is this wording necessary?

Does this look like it would solve the problem?

======================

In 4.3.1 add a static semantics section ahead of the existing legality
section which contains:

  A specific tagged type T is said to "have known components"
  if it is neither a tagged private type, a private extension, nor a
  descendant of a type which has does not have known components.
  Given a specific tagged type T having an ancestor type A,
  T is said to "extend A with known components" if T is A or if
  T is neither a tagged private type, a private extension, nor
  an immediate descendant of a descendant of A which does not
  extend A with known components.

  AARM Note:
  Having known components and extending an ancestor type A with known
  components are characteristics of the type T (see 7.3 and 7.3.1).

  Consider the following example:

    package Pkg1 is
      type T1 is tagged private
      -- T1 does not have known components here.
    private
      type T1 is tagged null record;
      -- T1 has known components here.
    end Pkg1;

    package Pkg1.Pkg2 is
      type T2 is new Pkg1.T1 with null record;
      -- T2 does not have known components here because
      -- T1 does not have known components (as seen from
      -- here).
    private
      -- T2 has known components here.
    end Pkg2;

    with Pkg1.Pkg2;
    package body Pkg1 is
       type T3 is new Pkg2.T2 with null record;
       -- T3 does not have known components here because T2
       -- does not have known components (as seen from here)
       -- even though T1 does (as seen from here).
    end Pkg1;


In the Legality Rules section of 4.3.1, replace 4.3.1(26)
  If the type of a record_aggregate is a record extension, then
  it shall be a descendant of a record type, through one or more
  record extensions (and no private extensions).
with
  The type of a record aggregate shall have known components.

In the Legality Rules section of 4.3.2, replace the second sentence of 4.3.2(5/2)
  The type of the extension_aggregate shall be derived from the type
  of the ancestor_part, through one or more record extensions (and
  no private extensions).
with
  The type of the extension_aggregate shall be derived from the type
  of the ancestor_part. The type of the extension aggregate shall
  extend the type of the ancestor_part with known components.
.

In 7.3(15), extend the definition of "characteristic".
In the sentence
  Moreover, within the scope of the declaration of the full view, the
  characteristics of the type are determined by the full view; in particular,
  within its scope, the full view determines the classes that include the
  type, which components, entries, and protected subprograms are visible,
  what attributes and other predefined operations are allowed, and whether
  the first subtype is static.
replace the ending
   "and whether the first subtype is static"
with
   "whether first subtype is static, whether the type has known components,
    and (for any ancestor type A of the given type) whether the type
    extends A with known components" .

Tucker:

This seems like progress.  It is nice that the term simplifies the rule
about aggregates, once you get through with its definition.

Here are alternatives that seem equivalent, though I'm not sure:

    A specific tagged type T is defined to have "known components"
    if it is not a partial view, nor have an ancestor that
    is a partial view.

    Given a specific tagged type T having an ancestor type A,
    T is defined to "extend A with known components" if T is a record
    extension of A, or if T extends a type B with known components
    and B extends A with known components.

Randy:

>     A specific tagged type T is defined to have "known components"
>     if it is not a partial view, nor have an ancestor that
>     is a partial view.

"has an ancestor".

But I don't think this is right. The original Adam example has no ancestors
that are partial views from the point of the aggregate, yet it still should
be illegal. That's the original cause of this problem.

It needs to invoke the point of the derivation somehow. In that sense, the
Steve version is better. But probably we could try something in the middle:
    A specific tagged type T is defined to have "known components" if it is
    not a partial view, nor is it derived from a type that does not have
    known components at the point of the type derivation.

Umm, that still isn't quite right (because as Steve points out, the ancestor
can get the known components later, and that should be legal. The "point of
the type derivation" needs to be dropped.

    A specific tagged type T is defined to have "known components" if it is
    not a partial view, nor is it derived from a type that does not have
    known components (based on the view of the parent type that T has).

The important point here is that this property is recalculated for each
ancestor's derivation individually and propagated up the chain. It is *not*
calculated for "ancestors" in general, because you can different answers
depending on the order that you look at the ancestors (with sufficiently
messy child packages).

>     Given a specific tagged type T having an ancestor type A,
>     T is defined to "extend A with known components" if T is a record
>     extension of A, or if T extends a type B with known components
>     and B extends A with known components.

This one seems OK, except that it seems to allow arbitrary orders of
evaluation (Again, we can only do one step at a time, or we could get
the wrong answer). So I'd suggest something like:

     Given a specific tagged type T having an ancestor type A,
     T is defined to "extend A with known components" if T is a record
     extension of A, or if T extends a type B with known components
     and B is a record extension of A.

This forces bottom-up recursion, which should give the right answer.

Humm, this seems to also suffer from the location issue; in the later case,
we want to look B from the perspective of T. So this wording seems
backwards. Try it this way:

     Given a specific tagged type T having an ancestor type A,
     T is defined to "extend A with known components" if T is a record
     extension of A, or if T is a record extension of a type B, and
     (based on the view of B that T has) B extends A with known components.

Oh well, I'm not completely sure these make any sense, either. We need to try
them against the batch of examples that we previously did.

****************************************************************

!topic Extension aggregate ancestor with unknown discriminants
!reference RM 4.3.2
!from Adam Beneschan 09-03-09
!discussion

This arises from a case in GNAT bug 34507, which was also mentioned in a recent
comp.lang.ada conversation involving constructor functions. However, I believe
there may be a missing language rule; or perhaps just some clarifying language
is needed.

In this code (based on an example from the bug report):

    package T_Pack is
       type T (<>) is abstract tagged limited private;
    private
       type T (C: Character) is abstract tagged limited null record;
    end T_Pack;

    with T_Pack;

    package S_Pack is
       use T_Pack;
       type S is new T with null record;
       function Create return S;
    end S_Pack;

    package body S_Pack is
       function Create return S is
       begin
          return S'(T with ???);   -- CAN THIS POSSIBLY BE LEGAL?
       end Create;
    end S_Pack;

I don't see how it's possible for any extension aggregate to be written with T
as a subtype mark (where the full view of T is not visible).  T is
unconstrained, and therefore some constraint has to be provided with the value,
but this is impossible since the discriminant C is not visible.

Maybe the illegality follows from 4.3.2(6), since the inherited discriminant is
"needed" but cannot be named (possibly because of AI05-115), thus making any
possible extension aggregate of this sort illegal.  Even so, trying to figure
out whether it's legal gets into a murky area of whether a discriminant that is
not visible, or "unknown", is considered to be "inherited" for the purposes of
the Static Semantics section in 4.3.2(6).  Then there's this case:

    generic
        type T (<>) is tagged private;
    package Gen_Pack is
        type New_T is new T with record
            A : Integer;
        end record;
        function Create return New_T;
    end Gen_Pack;

    package body Gen_Pack is
        function Create return New_T is
        begin
            return New_T' (T with A => 10);
        end Create;
    end Gen_Pack;

I don't see how this could be allowed, since Gen_Pack could be instantiated with
an unconstrained discriminated type.  (GNAT allows the above generic to be
declared, but gives an error on the aggregate if you instantiate with an
unconstrained discriminated record type; looks like a contract model violation
to me.)

My suggestion: Change the first sentence of 4.3.2(5) to:

If the ancestor_part is a subtype_mark, it shall denote a specific tagged
subtype, and it shall not denote a type with unknown discriminants.

Or something to that effect.

****************************************************************

From: Gary Dismukes
Sent: Monday, October 25, 2010  7:02 PM

I was assigned this AI, probably partly as penance for not attending the last
ARG meeting, and tasked with coming up with a "fresh approach" to the problem,
which was discussed at excruciating length by Randy, Tucker, and Steve back in
late 2008:

> Gary gets AI05-0115-1. This is large part because Tucker, Steve, and I
> spent a lot of time attempting to draft wording that solves the
> problem (of aggregate components that aren't visible) and we never could get it right.
> We need someone with a fresh approach to make an attempt at it (but
> reading the old mail to see why we were having such trouble would be instructive).

After wrestling with understanding the details of the earlier lengthy e-mail
discussions (which are incomplete in certain respects, as Randy distilled the
lengthy e-mail discussions and didn't include some cases of wording attempts),
one thing that became clear to me is that this AI's definitely a toughie. I
won't claim to have managed to have come up with a better approach, but I gave
it my best shot, and have proposed tentative wording as described below under
alternative 3.

I've given a summary below of three main alternatives considered for addressing
this AI.  There actually were probably more than that considered during the 2008
discussions, including various aborted attempts at wording for different
alternatives.  My proposed "fresh approach" proposal is given as the third
alternative.  I believe we'll have to make a decision between going with
Alternative 2, which is the current approach described in the AI and the
proposed Alternative 3.  If it turns out that Alt. 3 is not viable, which is
entirely possible, since most other attempts to solve this based on localized
wording have turned out to have problems of one kind or another, then in the
absence of any sudden brainstorm from others for a better way, I think we'll
just have to go with Alt. 2, despite existing misgivings about it (Randy, at
least, was apparently not happy with the wording).

I've made a rough update to the AI to reflect the newly proposed wording, plus
updated the !discussion section to briefly discuss some of the considered
alternatives, and included it at the end of this message. I considered just
adding the new wording alongside the older proposal (clearly marked), but Randy
prefers an update for the new proposal, as older version can be retrieved easily
enough from CVS for comparison purposes.

(Side Note: I'm not proposing any changes to the wording proposed in the
previous version that addresses the cases involving types with unknown
discriminants, since that part seems to be handled fine by the proposed wording
in the AI.)


Alternative 1  (approach based on component visiblity)
-------------

Conceptually, all we really want to do is to add a rule that makes record (and
extension) aggregates illegal if the type of the aggregate has any "hidden"
components.  I spent/wasted a moderate amount of time pursuing this line, though
it was evidently also pursued in earlier discussions, so I should have known
better (but unfortunately that part of the discussion didn't make it into the AI
appendix, apart from a statement that using component visibility couldn't work).

What I wanted to do was simply augment the current rule in section 4.3.1:

  14   If the type of a record_aggregate is a record extension, then it shall
  be a descendant of a record type, through one or more record extensions (and
  no private extensions).

with an additional rule along the lines of:

  A record_aggregate is illegal if the type of the aggregate inherits
  components that are not visible.

The idea here was that the existing paragraph would continue to cover "outside
view" cases where the aggregate sees partial views of its ancestors, and the
additional rule would serve as an additional filter to catch "inside view" cases
such as those given as examples in the AI.

However, this runs into the major difficulty that we have no way of talking
about certain hidden components, because they don't get addressed at all by the
current inheritance rules.  In general, such components may never even be
inherited, even though they exist behind the scenes. I think there's a potential
to make an approach based on component visibility work, but it would require
changing the definitions of inheritance and declaration for components in
section 3.4, and for that reason alone I think that making such changes wouldn't
be acceptable for solving this specific problem (though I tend to believe it
could be done without affecting existing legality and semantics, but I could
also be completely wrong about that...).  So I somewhat reluctantly gave up on
this line of thought.


Alternative 2  (approach based on new "has known components" characteristic)
-------------

This is the approach adopted (apparently with some trepidation) in the current
version of the AI, which defines a new type characteristic that indicates
whether a type "has known components", and uses that in defining the legality of
aggregates.  In the AI, the editor (aka Randy) expresses reservations about
whether the proposed wording "captures the locality very well".  I'm not sure
whether I fully see the problem, but it's certainly the case that this approach
adds a fair bit of verbiage (though my proposal in Alt. 3. suffers from that as
well).  Personally, I dislike the idea of adding a new characteristic (and
tehnical temr) of this kind, whose only purpose is to address this very narrow
problem, but I can live with this approach if nothing else seems to work better.


Alternative 3 (attempt to exclude problem cases based on type visibility)
-------------

The approach I've attempted is to augment the current 4.3.1 and 4.3.2 rules
directly to outlaw the problematic aggregate cases, by managing to express the
condition of an aggregate type having an ancestor type that derives from a
partial view, when that ancestor might inherit components from its parent type's
full view that are not visible at the point of the aggregate.  (I say "might",
because there's the case where the full view of the ancestor's parent is a null
extension.)  The proposed wording tries to do this by talking directly about the
point of the ancestor type's declaration as well as the context where the
aggregate appears vis-a-vis the scopes of the ancestor and parent type's full
view.  Intuitively, the idea is that when there are ancestors that derive from
partial views, the aggregate will only be allowed if it occurs in a place where
such an ancestor type would actually be able to inherit components (if any) of
the corresponding full views.

That condition would seem to capture the cases that slip through the rule of
4.3.1(14/2), at least it seems to work properly on the kind of cases described
in the AI, as far as I can tell.  Whether that condition can be adequately
expressed in proper RM-ese is another question, but following is what I came up
with.

Here's the proposed wording, to be added to the end of 4.3.1(14/2), that
attempts to capture this condition:

  Furthermore, the type of the record_aggregate shall not have an ancestor
  record extension that is derived from a partial view at the point of the
  record extension, unless the record_aggregate occurs within the immediate
  scope of the record extension, as well as within the scope of the partial
  view's full type.

This is admittedly a mouthful, and there may well be some problems with this
wording, and it can probably be simplified, but I wanted to make sure that I
captured the salient details of the desired condition before trying to improve
it.  (I freely admit this is neither pretty nor fresh.;-)

Note that the use of 'immediate scope' for the record extension and 'scope' for
the partial view's full type is deliberate, and intended to capture the right
visiblity context for the aggregate.

(BTW, maybe it's sufficient to say "... that is derived from a partial view"
without adding "at the point of the record extension", but for now I wanted to
make clear that this is talking about that specific place in the program text.
Perhaps there's a better way to phrase it, if it's legitimate to state this kind
of condition at all.)

Similarly, a rule such as the following needs to be added to 4.3.2(5/2), to
cover extension aggregates:

[Following was version /05 of the AI - Editor.]

****************************************************************

From: Tucker Taft
Sent: Friday, November 19, 2011  3:46 PM

Here is some possible wording to add to 7.3.1, probably after paragraph 5, as an
alternative way to address AI05-0115.  As a reminder, here are paragraphs 3, 4,
and 5 of 7.3.1:

     For a composite type, the characteristics (see 7.3) of the type are
     determined in part by the characteristics of its component types. At
     the place where the composite type is declared, the only
     characteristics of component types used are those characteristics
     visible at that place. If later immediately within the declarative
     region in which the composite type is declared additional characteristics become
     visible for a component type, then any corresponding characteristics
     become visible for the composite type. Any additional predefined
     operators are implicitly declared at that place. If there is no such
     place, then additional predefined operators are not declared at all,
     but they still exist.

     The corresponding rule applies to a type defined by a
     derived_type_definition, if there is a place immediately within the
     declarative region in which the type is declared  where additional
     characteristics of its parent type become visible.

     [Redundant: For example, an array type whose component type is limited private
     becomes nonlimited if the full view of the component type is
     nonlimited and visible at some later place immediately within the
     declarative region in which the array type is declared. within the
     immediate scope of the array type. In such a case, the predefined
     "=" operator is implicitly declared at that place, and assignment is
     allowed after that place.]

Here is a possible additional paragraph 7.3.1(5.1)

      {At a given point, the current view of a type is a /descendant/ of
      the view of an ancestor from which it currently inherits its
      characteristics.  In particular, a type is a descendant of the full
      view of some ancestor of its parent type only if the current view
      it has of its parent is a descendant of the full view of that
      ancestor.}

****************************************************************

From: Gary Dismukes
Sent: Monday, February 14, 2011  6:08 PM

A while back, Tucker proposed an alternative approach for addressing AI05-115:

> Here is some possible wording to add to 7.3.1, probably after
> paragraph 5, as an alternative way to address AI05-0115.  As a
> reminder, here are paragraphs 3, 4, and 5 of 7.3.1:
>
> ...
>
> Here is a possible additional paragraph 7.3.1(5.1)
>
>       {At a given point, the current view of a type is a /descendant/ of
>       the view of an ancestor from which it currently inherits its
>       characteristics.  In particular, a type is a descendant of the full
>       view of some ancestor of its parent type only if the current view
>       it has of its parent is a descendant of the full view of that
>       ancestor.}

It took me a while to get comfortable with this phrasing, but I think that this
basically works, and is preferable to any other approaches that have been
proposed.

I just have a few small issues/questions regarding the wording:

1. I wonder if it would be better to put this into 3.4.1, following the
   paragraph (10/2) that defines descendant and ancestor?  I think I prefer that
   to putting it in 7.3.1.

2. Normally inheritance is defined in terms of what you get from your direct
   parent, not from some other ancestor, so I'm not sure that the notion of
   inheriting characteristics from an ancestor is formally defined, though
   informally I think it's clear what's meant.  Maybe it's clear enough as is,
   but one possibility is to add ", directly or indirectly" at the end of the
   first sentence.  But maybe that's being overly picky.

3. I'm not sure that the current extension aggregate wording of 4.3.2(5/2) is
   adequate for working with this definition of descendant.  4.3.1(14) seems to
   work fine, but the extension aggregate rule doesn't mention the word
   descendant, it only talks about deriving from the type of the ancestor part.
   Should we adjust the wording so that it explicitly mentions descendants, or
   is it OK as is?

4. The last sentence should be marked Redundant.

****************************************************************

From: Randy Brukardt
Sent: Monday, February 14, 2011  6:57 PM

> It took me a while to get comfortable with this phrasing, but I think
> that this basically works, and is preferable to any other approaches
> that have been proposed.

I'm not so sure about that. We're trying to fix a problem with record and
extension aggregates (only); this is changing the rules for inheritance of
everything by changing the definition of a widely used term (descendant). This
sounds like a recipe for disaster. I cannot even understand how this corresponds
to existing use of the term "descendant", which is purely a derivation
relationship.

To take one example, this wording would appear to make the result of
Ada.Tags.Descendant_Tag dependent on the view of the type in question at the
time of the call. That way seems to lie madness.

Similarly, I don't think we want to be changing the way characteristics are
inherited in cases other than the one in question. It is just too risky; it is
likely to cause new runtime dependencies that would add overhead for no good
reason.

So I can understand defining a new relationship that is view based, but I'm
pretty certain we do not want to use the existing term "descendant" (at least by
itself). Maybe something like "characteristics ancestor" or the like.

> I just have a few small issues/questions regarding the wording:
>
> 1. I wonder if it would be better to put this into 3.4.1, following
> the paragraph (10/2) that defines descendant and ancestor?  I think I
> prefer that to putting it in 7.3.1.

As noted above, changing the meaning of "descendant" generally leads directly to
madness. I think Tuck has the rule in the right place, but we need a different
term.

> 2. Normally inheritance is defined in terms of what you get from your
> direct parent, not from some other ancestor, so I'm not sure that the
> notion of inheriting characteristics from an ancestor is formally
> defined, though informally I think it's clear what's meant.  Maybe
> it's clear enough as is, but one possibility is to add ", directly or
> indirectly" at the end of the first sentence.  But maybe that's being
> overly picky.

Not really. I think your additional wording is clarifying.

> 3. I'm not sure that the current extension aggregate wording of
> 4.3.2(5/2) is adequate for working with this definition of descendant.
> 4.3.1(14) seems to work fine, but the extension aggregate rule doesn't
> mention the word descendant, it only talks about deriving from the
> type of the ancestor part.
> Should we adjust the wording so that it explicitly mentions
> descendants, or is it OK as is?

Well, since using the term "descendants" is a non-starter in my book, the rules
in question will definitely need changing to invoke the new term, whatever it
is.

> 4. The last sentence should be marked Redundant.

Yup; definitely not important if it doesn't get marked.

****************************************************************

From: Tucker Taft
Sent: Monday, February 14, 2011  7:53 PM

> I'm not so sure about that. We're trying to fix a problem with record
> and extension aggregates (only); this is changing the rules for
> inheritance of everything by changing the definition of a widely used term (descendant).
> This sounds like a recipe for disaster. I cannot even understand how
> this corresponds to existing use of the term "descendant", which is
> purely a derivation relationship.

I think you may be overstating this.  We already have statements like the
following (RM 7.3(7.3)):

   the partial view shall be a descendant of an interface type (see 3.9.4)
   if and only if the full type is a descendant of the interface type.

Clearly we are acknowledging that a full view and a partial view might be
descendants of different sets of types.  With private extensions, the partial
view has a specified ancestor, while the full view might have additional
ancestors.  So the point of this new wording is to specify the "descendant"
relationship between views of types.  In general "descendant" is part of static
semantics. The "Descendant_Tag" operation is perhaps the anomaly here, in that
it is translating a static semantic relationship into a dynamic semantic value.
To do so we will clearly have to identify what views we are talking about, since
we don't want the value to in fact depend on where the operation is called.

> To take one example, this wording would appear to make the result of
> Ada.Tags.Descendant_Tag dependent on the view of the type in question
> at the time of the call. That way seems to lie madness.
>
> Similarly, I don't think we want to be changing the way
> characteristics are inherited in cases other than the one in question.
> It is just too risky; it is likely to cause new runtime dependencies
> that would add overhead for no good reason.

I think we are merely formalizing the relationship that already is presumed in
rules having to do with all kinds of characteristics. Do you have an example of
how this new wording conflicts with existing uses of the term "descendant"?  The
point was to formalize the definition of descendant, not introduce a new term
and leave descendant vaguely defined.

> So I can understand defining a new relationship that is view based,
> but I'm pretty certain we do not want to use the existing term
> "descendant" (at least by itself). Maybe something like
> "characteristics ancestor" or the like.
>
>> I just have a few small issues/questions regarding the wording:
>>
>> 1. I wonder if it would be better to put this into 3.4.1, following
>> the paragraph (10/2) that defines descendant and ancestor?  I think I
>> prefer that to putting it in 7.3.1.
>
> As noted above, changing the meaning of "descendant" generally leads
> directly to madness. I think Tuck has the rule in the right place, but
> we need a different term.
>
>> 2. Normally inheritance is defined in terms of what you get from your
>> direct parent, not from some other ancestor, so I'm not sure that the
>> notion of inheriting characteristics from an ancestor is formally
>> defined, though informally I think it's clear what's meant.  Maybe
>> it's clear enough as is, but one possibility is to add ", directly or
>> indirectly" at the end of the first sentence.  But maybe that's being
>> overly picky.
>
> Not really. I think your additional wording is clarifying.

I agree.

>
>> 3. I'm not sure that the current extension aggregate wording of
>> 4.3.2(5/2) is adequate for working with this definition of
>> descendant.  4.3.1(14) seems to work fine, but the extension
>> aggregate rule doesn't mention the word descendant, it only talks
>> about deriving from the type of the ancestor part.
>> Should we adjust the wording so that it explicitly mentions
>> descendants, or is it OK as is?
>
> Well, since using the term "descendants" is a non-starter in my book,
> the rules in question will definitely need changing to invoke the new
> term, whatever it is.

Descendant and ancestor are defined in terms of one another, which is another
advantage of clarifying the definition of "descendant" rather than some new
term.

>> 4. The last sentence should be marked Redundant.
>
> Yup; definitely not important if it doesn't get marked.

I'm confused by this.  I don't believe the second sentence is implied by the
first, but rather is further refining what it says.

****************************************************************

From: Randy Brukardt
Sent: Monday, February 14, 2011  8:42 PM

> I think you may be overstating this.  We already have statements like
> the following (RM 7.3(7.3)):
>
>    the partial view shall be a descendant of an interface type (see 3.9.4)
>    if and only if the full type is a descendant of the interface type.
>
> Clearly we are acknowledging that a full view and a partial view might
> be descendants of different sets of types.

I don't see this, exactly. Now that you point it out, this rule also seems to be assuming something that is not borne out by the standard.

Even so, my understanding of this rule is that it only depends on the derivation relationship of the parent and progenitors. In particular, I never expected it to have any relationship to visibility. By bringing visibility into the equation, at the very le
ast you are forcing compiler writers to prove that visibility cannot matter. (I think that is true in this case because this rule itself makes all interfaces visible; but the effort to prove that is significant.)

> With private extensions, the partial view has a specified ancestor,
> while the full view might have additional ancestors.  So the point of
> this new wording is to specify the "descendant" relationship between
> views of types.  In general "descendant" is part of static semantics.

This is true, and I see your point. (This whole business of different ancestors is madness, but it is commonly used, so we're stuck with it.) But then we have a serious problem, because this is not true in existing rules or implementations.

> The "Descendant_Tag" operation is perhaps the anomaly here, in that it
> is translating a static semantic relationship into a dynamic semantic
> value.  To do so we will clearly have to identify what views we are
> talking about, since we don't want the value to in fact depend on
> where the operation is called.

Right, but the problem here is that this is the *first* rule that came up when I searched for "descendant". This wasn't daisy picking! If we're going to make a change as significant as this, someone is going to have to read all 55 clauses that the search e
ngine shows contains this term. And that is a massive job.

...
> > To take one example, this wording would appear to make the result of
> > Ada.Tags.Descendant_Tag dependent on the view of the type in
> > question at the time of the call. That way seems to lie madness.
> >
> > Similarly, I don't think we want to be changing the way
> > characteristics are inherited in cases other than the one in question.
> > It is just too risky; it is likely to cause new runtime dependencies
> > that would add overhead for no good reason.
>
> I think we are merely formalizing the relationship that already is
> presumed in rules having to do with all kinds of characteristics.

The rules for characteristics are all over the map, and are defined individually
(and for the most part, without much sanity IMHO). You are claiming that anyone
understands how those work? Good luck.

> Do you have an example of how this new wording conflicts with existing
> uses of the term "descendant"?  The point was to formalize the
> definition of descendant, not introduce a new term and leave
> descendant vaguely defined.

I pointed out one with my first probe into the standard. (The only clause before
it in the search engine results is the one that defines the term.) I'm not going
to spend two hours reading the other 53 clauses to see if any are affected;
that's the responsibility of the proposer!

If you want to go this route, I think you owe it to everyone to verify that it
doesn't cause any problems beyond the one I stumbled into immediately.

BTW, I agree with Gary that if you are going to make such a massive change to
the language, it had better go in 3.4.1, so that it is clear that the "obvious"
definition is not accurate.

...
> >> 3. I'm not sure that the current extension aggregate wording of
> >> 4.3.2(5/2) is adequate for working with this definition of
> >> descendant.  4.3.1(14) seems to work fine, but the extension
> >> aggregate rule doesn't mention the word descendant, it only talks
> >> about deriving from the type of the ancestor part.
> >> Should we adjust the wording so that it explicitly mentions
> >> descendants, or is it OK as is?
> >
> > Well, since using the term "descendants" is a non-starter in my
> > book, the rules in question will definitely need changing to invoke
> > the new term, whatever it is.
>
> Descendant and ancestor are defined in terms of one another, which is
> another advantage of clarifying the definition of "descendant" rather
> than some new term.

Gary's point is that 4.3.2(5/2) talks about "derived from" rather than
descendant or ancestor. It has to be rewritten in any case; I don't see how
"derived from" can be view dependent.

> >> 4. The last sentence should be marked Redundant.
> >
> > Yup; definitely not important if it doesn't get marked.
>
> I'm confused by this.  I don't believe the second sentence is implied
> by the first, but rather is further refining what it says.

The sentence starts "In particular", which says that it is giving an example of
the effects of the first sentence. (Call it a "refinement", it's the same
thing.) Moreover, the type from which "it currently inherits its
characteristics" seems well-defined (although somewhat informal). If you *don't*
think the first sentence is well-defined enough to stand alone, then I don't
think you should give it at all. Just give the second sentence and be done with
it.

****************************************************************

From: Tucker Taft
Sent: Monday, February 14, 2011  9:11 PM

>> Descendant and ancestor are defined in terms of one another, which is
>> another advantage of clarifying the definition of "descendant" rather
>> than some new term.
>
> Gary's point is that 4.3.2(5/2) talks about "derived from" rather than
> descendant or ancestor. It has to be rewritten in any case; I don't
> see how "derived from" can be view dependent.

"Derived from" is view dependent, if you think about partial views or formal
derived types.  For example, in 7.3(8) it says:

   ... The full view of a private extension shall be derived (directly or
   indirectly) from the ancestor type.

Clearly "derived from" is a view-specific relationship in this sentence.

>
>>>> 4. The last sentence should be marked Redundant.
>>>
>>> Yup; definitely not important if it doesn't get marked.
>>
>> I'm confused by this.  I don't believe the second sentence is implied
>> by the first, but rather is further refining what it says.
>
> The sentence starts "In particular", which says that it is giving an
> example of the effects of the first sentence. (Call it a "refinement",
> it's the same
> thing.) Moreover, the type from which "it currently inherits its
> characteristics" seems well-defined (although somewhat informal). If
> you
> *don't* think the first sentence is well-defined enough to stand
> alone, then I don't think you should give it at all. Just give the
> second sentence and be done with it.

These two sentences are serving two different purposes.  The first sentence
links "descendant" with "inherited characteristics."  The second specifies the
rule that a type is a descendant of the full view of its ancestor only where it
has a view of its parent that is a descendant of the ancestor's full view.  Both
are needed and neither is redundant.

****************************************************************

From: Randy Brukardt
Sent: Monday, February 14, 2011  9:18 PM

...
> > Do you have an example of how this new wording conflicts with
> > existing uses of the term "descendant"?  The point was to formalize
> > the definition of descendant, not introduce a new term and leave
> > descendant vaguely defined.
>
> I pointed out one with my first probe into the standard. (The only
> clause before it in the search engine results is the one that defines
> the term.) I'm not going to spend two hours reading the other 53
> clauses to see if any are affected; that's the responsibility of the
> proposer!
>
> If you want to go this route, I think you owe it to everyone to verify
> that it doesn't cause any problems beyond the one I stumbled into
> immediately.

I think it would be very valuable to everyone (presuming that we go this way),
that every use of "descendant" and "ancestor" is examined for whether visibility
makes a difference, and that result is recorded in the AI (and better still, in
the AARM) for future readers. Otherwise, we are at risk of introducing nasty
problems. (As Bob likes to say, we don't have regression tests for the
Standard.)

I can start this by saying that the uses in 3.9 (Descendant_Tag) should not
depend on visibility, but have the potential to do so (so there is a problem).
The uses in 4.9 (descendant of a formal type) don't appear to depend on
visibility (can't imagine how a formal type could be private). The uses in 3.4.1
are the definition of the term.

Based on the amount of time I spent figuring those three out, I'm not going to
look at the other 52 clauses that contain the term! I've got a lot of other work
to do to get ready for the meeting...

****************************************************************

From: Randy Brukardt
Sent: Tuesday, February 15, 2011  2:10 AM

...
> > Gary's point is that 4.3.2(5/2) talks about "derived from" rather
> > than descendant or ancestor. It has to be rewritten in any case; I
> > don't see how "derived from" can be view dependent.
>
> "Derived from" is view dependent, if you think about partial views or
> formal derived types.  For example, in 7.3(8) it says:
>
>    ... The full view of a private extension shall be derived (directly
> or
>    indirectly) from the ancestor type.
>
> Clearly "derived from" is a view-specific relationship in this
> sentence.

Huh? It's only view-specific in the sense that everything is view-specific:
if the entity in question doesn't exist yet, you might depend on the view.
Otherwise, it's a purely syntactic relationship.

I really don't understand why you keep giving examples that give the same answer
whether or not you consider any views, and then claim that there is some
relevance of views. Of course, the near complete absence of mentioning views in
the standard makes it impossible to even guess what the intent *really* was;
perhaps I just don't understand some magic somewhere.

> >>>> 4. The last sentence should be marked Redundant.
> >>>
> >>> Yup; definitely not important if it doesn't get marked.
> >>
> >> I'm confused by this.  I don't believe the second sentence is
> >> implied by the first, but rather is further refining what it says.
> >
> > The sentence starts "In particular", which says that it is giving an
> > example of the effects of the first sentence. (Call it a
> > "refinement", it's the same
> > thing.) Moreover, the type from which "it currently inherits its
> > characteristics" seems well-defined (although somewhat informal). If
> > you
> > *don't* think the first sentence is well-defined enough to stand
> > alone, then I don't think you should give it at all. Just give the
> > second sentence and be done with it.
>
> These two sentences are serving two different purposes.  The first
> sentence links "descendant" with "inherited characteristics."  The
> second specifies the rule that a type is a descendant of the full view
> of its ancestor only where it has a view of its parent that is a
> descendant of the ancestor's full view.  Both are needed and neither
> is redundant.

OK, but then I don't understand "In particular" here, if there isn't any
relationship. Moreover, I don't understand why we care about "inherited
characteristics" at all. We're surely not going to change any rules regarding
them (if you want to do that, you have to find and delete all of the old rules,
because we can't have two sets of rules with [almost] the same effect). The
rules in 4.3.1 and 4.3.2 that we are trying to fix say nothing whatsoever about
"characteristics". If it ain't broke, don't fix it!

I can believe that the descendant relationship has some problem (although really
I'm skeptical that the problem actually lies there), but let's not start
changing stuff for no reason at all. If you want to go beyond the targeted
fixes, you really need good reasons, and I haven't heard any to this point.

P.S. But I may have just lost my mind.

****************************************************************

From: Randy Brukardt
Sent: Tuesday, February 15, 2011  2:18 AM

...
> > Gary's point is that 4.3.2(5/2) talks about "derived from" rather
> > than descendant or ancestor. It has to be rewritten in any case; I
> > don't see how "derived from" can be view dependent.
>
> "Derived from" is view dependent, if you think about partial views or
> formal derived types.  For example, in 7.3(8) it says:
>
>    ... The full view of a private extension shall be derived (directly or
>    indirectly) from the ancestor type.
>
> Clearly "derived from" is a view-specific relationship in this
> sentence.

Even if I grant that "derived from" is view dependent somehow, that's
irrelevant. The whole reason that this bug comes up is because we don't know
what it means in *this* case. You are proposing to change the definition of
"descendant", which would fix the 4.3.1 rules. But that can't change the 4.3.2
rules that depend on "derived from", since "descendant" is defined in terms of
"derived from", not vice-versa.

The claim that we don't need to change this wording is essentially the same as
saying that there is no bug currently -- and that is clearly not true.

****************************************************************

From: Gary Dismukes
Sent: Tuesday, February 15, 2011  4:56 PM

> > These two sentences are serving two different purposes.  The first
> > sentence links "descendant" with "inherited characteristics."  The
> > second specifies the rule that a type is a descendant of the full
> > view of its ancestor only where it has a view of its parent that is
> > a descendant of the ancestor's full view.  Both are needed and
> > neither is redundant.
>
> OK, but then I don't understand "In particular" here, if there isn't
> any relationship. Moreover, I don't understand why we care about
> "inherited characteristics" at all. We're surely not going to change
> any rules regarding them (if you want to do that, you have to find and
> delete all of the old rules, because we can't have two sets of rules
> with [almost] the same effect). The rules in 4.3.1 and 4.3.2 that we
> are trying to fix say nothing whatsoever about "characteristics". If it ain't broke, don't fix it!

I certainly found the use of "In particular" leading me to believe that it's a
specific consequence of rule stated in the preceding sentence. I thought I had
convinced myself that it is a consequence, but evidently I'm confused about
that.  So if we keep any rule like this (and now I'm starting to have my doubts
about doing that), it needs some revision since it's misleading as is.

After thinking about this further today, I'm now finding myself puzzled as to
how this even addresses the problem.  I'm not managing to see how this
definition fixes the problem of making the aggregates illegal, without at least
making some kind of changes to the aggregate paragraphs, though exactly what
sort of changes are needed I'm not sure.  (However, this may just be due to the
fact that I had really bad insomnia last night and only got 2-3 hours of sleep,
so I'm not exactly in the clearest state of mind today.)

> I can believe that the descendant relationship has some problem
> (although really I'm skeptical that the problem actually lies there),
> but let's not start changing stuff for no reason at all. If you want
> to go beyond the targeted fixes, you really need good reasons, and I
> haven't heard any to this point.

Since we're both having misgivings about this approach of changing (or
augmenting, or whatever) the definition of descendant, I'm not sure we should go
further with this approach, at least for writing it up. I had some vain hope of
trying to revise the AI to reflect Tucker's suggestion, but I'm afraid that I
don't grok it well enough to do that at this point (not to mention being out of
time...).  Maybe we should just go back to the proposal based on a new "has
known components" characteristic.  On the other hand, perhaps if Tucker can
clear up why this approach makes sense, maybe it's still viable.  Will we be
able to discuss this further at the meeting without having an AI version based
on this wording?

> P.S. But I may have just lost my mind.

Ditto.

****************************************************************

From: Randy Brukardt
Sent: Tuesday, February 15, 2011  5:12 PM

> Since we're both having misgivings about this approach of changing (or
> augmenting, or whatever) the definition of descendant, I'm not sure we
> should go further with this approach, at least for writing it up.
> I had some vain hope of trying to revise the AI to reflect Tucker's
> suggestion, but I'm afraid that I don't grok it well enough to do that
> at this point (not to mention being out of time...).  Maybe we should
> just go back to the proposal based on a new "has known components"
> characteristic.  On the other hand, perhaps if Tucker can clear up why
> this approach makes sense, maybe it's still viable.  Will we be able
> to discuss this further at the meeting without having an AI version
> based on this wording?

We surely can discuss it. I sort of understand what Tucker is trying to do, but
I fear the consequences of changing something widely used. But I agree that it
probably isn't worth a full write-up right now.

> > P.S. But I may have just lost my mind.
>
> Ditto.

;-)

****************************************************************

From: Steve Baird
Sent: Monday, February 21, 2011  1:45 AM

procedure Formal_Derived is
    type T1 is tagged null record;
    type T2 is new T1 with null record;

    package Pkg is
       type T3 is new T1 with private;
    private
       type T3 is new T2 with null record;
    end Pkg;

    generic
       type T is new T2 with private;
    package G is
    end G;

    type T4 is new Pkg.T3 with null record;

    package body Pkg is
       package I is new G (T => T4); -- legal
    end Pkg;
begin
    null;
end Formal_Derived;

****************************************************************

From: Steve Baird
Sent: Monday, February 21, 2011  1:52 AM

>       package I is new G (T => T4); -- legal

Correction to the comment in the previous example.

         package I is new G (T => T4); -- legal? (no)

The point of this example is that it should be rejected.

****************************************************************

From: Tucker Taft
Sent: Wednesday, March 16, 2011  9:01 PM

Here is a rewrite of AI-115 about aggregates with invisible components, based on
refining the definition of "descendant" to make it more clear that "views" of
types are relevant, and a type is descended from the same view of its ancestor
as is its parent.  A type can never take advantage of knowing more about an
ancestor than its parent knows.

[This is version /06 of this AI.]

****************************************************************

From: Randy Brukardt
Sent: Wednesday, March 16, 2011  9:38 PM

I didn't see any evidence in this AI that you did the part about "checking if it
{changing the definition of descendant} breaks (or fixes) anything".

I know that I had found at least one case of using "descendant" to have a
runtime meaning (in 3.9), and probably that one and any others like it will need
some sort of fix. (They better not be dependent on visibility!)

****************************************************************

From: Tucker Taft
Sent: Wednesday, March 16, 2011  10:01 PM

I'll do that in time for the June meeting.

****************************************************************

From: Randy Brukardt
Sent: Wednesday, March 16, 2011  10:29 PM

Gaack - that'll be a little late, given that we should have completed an
additional round of RM review by then and already be starting the National Body
Review phase. We can still make changes then, but I'd rather that they are ones
we don't already know about...

****************************************************************

From: Tucker Taft
Sent: Thursday, March 17, 2011  9:07 AM

I did a preliminary review and didn't find any problems, other than your
run-time issue in Ada.Tags.  I just didn't have time to do a formal writeup of
each occurrence.

****************************************************************

From: Edmond Schonberg
Sent: Sunday, March 20, 2011   9:00 AM

In testing the implementation of this new rule, I came across some ACATS support
routines that seem illegal:  F65A00 and its child units.  The skeleton is as
follows:

package P is
   type T is tagged private;
private
   type T is tagged null record;
end P;

package P.Child1 is
   type T1 is new T with record
      V1 : Integer;
   end record;
end P.Child1;

with P.Child1;
package P.Child2 is
   type T2 is new Child1.T1 with record
      V2 : Integer;
   end record;

   function Create (X : Integer)  return T2; end P.Child2;

package body P.Child2 is
   function Create (X : Integer) return T2 is
   begin
      return T2' (X, X);   --  Legal?
   end;
end;

The aggregate appears in a child body. It's type is derived from a type declared
in a sibling unit, and that one is derived from a private view in the common
parent. There is no point at which the full view of P.Child1.T1 becomes visible
in P.Child2, so this is now illegal, right?

****************************************************************

From: Tucker Taft
Sent: Sunday, March 20, 2011   9:17 AM

Yes, I agree with your reading of the rule.

****************************************************************

From: Edmond Schonberg
Sent: Sunday, March 20, 2011   9:32 AM

Thanks for confirmation. Apart from this I found a single instance in our test
suite of an aggregate that becomes illegal with this new rule,  and this is in
an internally generated example, so this is not a particularly incompatible
change.

****************************************************************

From: Randy Brukardt
Sent: Monday, March 21, 2011   9:49 PM

...
> package body P.Child2 is
>    function Create (X : Integer) return T2 is
>    begin
>       return T2' (X, X);   --  Legal?
>    end;
> end;

I believe the fix would be to make this an extension (which should be OK as this
isn't a test on aggregates).

       return T2' (T with X, X);   --  OK

Please make sure that you report this to the ACAA Technical Agent so I can put
it on the pile of ACATS tests needing fixes for Ada 2012.

****************************************************************

From: Tucker Taft
Sent: Thursday, March 31, 2011  10:50 PM

[Attached to version /07 of the AI.]

I have added to the discussion here the results of scanning the standard for
uses of "descendant," "descended from," "ancestor," "covers," etc.

The implications are that there are various places where the "ancestry" of a
type affects legality and overload resolution.  I believe we want to stick with
the basic rule that essentially all "characteristics" are inherited "through"
the immediate parent, and if a derived type happens to know more than its parent
type about its ancestry, it can't use that information, for example, to refer to
a component that its parent couldn't see.

However, when it comes to things like type conversion, generic instantiation as
an actual for a formal derived type, "coverage" by a class-wide type, etc., I
could imagine having a more flexible rule.  That is, if a type knows it is
derived indirectly from some type, even though its parent type does *not* know
that fact, it can at a minimum be convertible to that "secret" ancestor.

I didn't write the wording that way, but we might want to consider it.  One way
I imagined doing that was saying that in cases like that, the child type is
essentially a descendant of an "incomplete" view of the ancestor. It inherits no
characteristics from that ancestor, other than the right to be converted to it,
or to match it for the purposes of formal derived types, or things like that
('Class coverage, etc.). I have some suspicion that this approach would be more
compatible with what most compilers do today, and it doesn't seem to cause any
trouble.  This is in contrast to inheriting characteristics from such a secret
ancestor, as you could get into real trouble if you could see a component of a
secret ancestor that had the same name as a component of your parent type
(unbeknownst to the parent type).

****************************************************************

From: Randy Brukardt
Sent: Friday, April  1, 2011  12:35 AM

> I have added to the discussion here the results of scanning the
> standard for uses of "descendant,"
> "descended from," "ancestor," "covers," etc.

Thanks for doing this analysis. It went far beyond what I was contemplating
(although it appears to have been necessary).

> The implications are that there are various places where the
> "ancestry" of a type affects legality and overload resolution.  I
> believe we want to stick with the basic rule that essentially all
> "characteristics" are inherited "through" the immediate parent, and if
> a derived type happens to know more than its parent type about its
> ancestry, it can't use that information, for example, to refer to a
> component that its parent couldn't see.
>
> However, when it comes to things like type conversion, generic
> instantiation as an actual for a formal derived type, "coverage" by a
> class-wide type, etc., I could imagine having a more flexible rule.
> That is, if a type knows it is derived indirectly from some type, even
> though its parent type does
> *not* know that fact, it can at a minimum be convertible to that
> "secret" ancestor.

I think this shows that I was right that there are far-reaching effects.

> I didn't write the wording that way, but we might want to consider it.
> One way I imagined doing that was saying that in cases like that, the
> child type is essentially a descendant of an "incomplete" view of the
> ancestor.
> It inherits no characteristics from that ancestor, other than the
> right to be converted to it, or to match it for the purposes of formal
> derived types, or things like that ('Class coverage, etc.).
> I have some suspicion that this approach would be more compatible with
> what most compilers do today, and it doesn't seem to cause any
> trouble.  This is in contrast to inheriting characteristics from such
> a secret ancestor, as you could get into real trouble if you could see
> a component of a secret ancestor that had the same name as a component
> of your parent type (unbeknownst to the parent type).

My immediate, unverified thought is that the rules you currently have could do
some real harm to the implementation of Claw and its tools (although I couldn't
know for sure without having a compiler that strictly implemented the rules).
Conversions to Root_Window_Type'Class are quite common, and if there is a type
for which that ancestry isn't "visible", we'd have trouble. Similarly for
Root_Dialog_Type'Class. I realize that there would always be a chain of
conversions that would be legal, but that would be ugly.

Let me write a quick example of what you are talking about to see if I
understand properly.

   package P1 is
      type Root is abstract tagged ...;
      procedure Draw (W : Root'Class);
   end P1;

   package P1.P2 is
      type Subroot is abstract private;
      procedure Paint (W : Subroot'Class);
   private
      type Subroot is new Root with ...;
   end P1.P2;

   package P1.P2.P3 is
      type A_Win is new Root with private;
   private
      type A_Win is new Subroot with ...
   end P1.P2.P3;

   with P1.P2.P3;
   package P1.P2.P4 is
      type B_Win is new A_Win with ...;
      procedure Test (W : B_Win);
   end P1.P2.P4;

   with P1.P2.P4;
   procedure Unrelated is
      W : P1.P2.P4.B_Win;
   begin
      P1.Draw (W); -- Legal (?)
      P1.P2.Paint (W); -- Illegal (?)
   end Unrelated;

   package body P1.P2.P4 is
      procedure Test (W : B_Win) is
      begin
          P1.Draw (W); -- Legal.
          P1.Draw (A_Win(W)); -- Legal.
          P1.P2.Draw (W); -- Illegal.
          P1.P2.Draw (A_Win(W)); -- Legal.
      end Test;
   end P1.P2.P4;

Humm, I don't seem to have managed to create the situation you are worried
about. Could you show an example??

****************************************************************

From: Jean-Pierre Rosen
Sent: Friday, April  1, 2011  2:28 AM

> However, when it comes to things like type conversion, generic
> instantiation as an actual for a formal derived type, "coverage" by a
> class-wide type, etc., I could imagine having a more flexible rule.
> That is, if a type knows it is derived indirectly from some type, even
> though its parent type does *not* know that fact, it can at a minimum
> be convertible to that "secret" ancestor.

But then, you could access the secret components after converting to the
secret ancestor (just a note, I don't know whether it's good or bad)

> I didn't write the wording that way, but we might want to consider it.
> One way I imagined doing that was saying that in cases like that, the
> child type is essentially a descendant of an "incomplete" view of the
> ancestor.
> It inherits no characteristics from that ancestor, other than the
> right to be converted to it, or to match it for the purposes of formal
> derived types, or things like that ('Class coverage, etc.).
> I have some suspicion that this approach would be more compatible with
> what most compilers do today, and it doesn't seem to cause any
> trouble. This is in contrast to inheriting characteristics from such a
> secret ancestor, as you could get into real trouble if you could see a
> component of a secret ancestor that had the same name as a component
> of your parent type (unbeknownst to the parent type).

And after conversion, there is no ambiguity since new homonym components
have been stripped off. Might be a good thing after all.

****************************************************************

From: Tucker Taft
Sent: Friday, April  1, 2011  10:49 AM

> Humm, I don't seem to have managed to create the situation you are
> worried about. Could you show an example??

Something like this:

     with P1.P2;
     package P5 is
         type SubSub is new SubRoot with ...
     end P5;

     package P1.P2.P6 is
         type Sub3 is new SubSub with ...

     private
         X : Root'Class := Sub3'(...);  -- Legal?
            -- We can "see" that SubRoot is derived from Root
            -- but our Parent SubSub cannot.
     end P1.P2.P6;

I don't know that I am "worried" about this in the abstract, but I am concerned
if there is a chunk of existing code that will break due to such a "refinement"
of the definition.

Ed reported that he didn't see any significant problems in the AdaCore regression
test suite, but that may have only been with the instantiation situation where
an actual type was a "secret" descendant of the formal derived type ancestor.

In any case I think we definitely want to say that as far as inheriting subprograms,
components, ability to write aggregates, etc., we stick with the "refined" model.
The only open question in my mind is this issue of conversion/matching, as it
seems like a useful work-around for a programmer in certain situations where the
inheritance chain is "interrupted."

****************************************************************

From: Randy Brukardt
Sent: Friday, April  1, 2011  11:28 PM

>          X : Root'Class := Sub3'(...);  -- Legal?
>             -- We can "see" that SubRoot is derived from Root
>             -- but our Parent SubSub cannot.
>      end P1.P2.P6;

I see. I don't think we ever do this in Claw, so now I'm less worried.

> I don't know that I am "worried" about this in the abstract, but I am
> concerned if there is a chunk of existing code that will break due to
> such a "refinement" of the definition.

Right.

> Ed reported that he didn't see any significant problems in the AdaCore
> regression test suite, but that may have only been with the
> instantiation situation where an actual type was a "secret" descendant
> of the formal derived type ancestor.
>
> In any case I think we definitely want to say that as far as
> inheriting subprograms, components, ability to write aggregates, etc.,
> we stick with the "refined" model.  The only open question in my mind
> is this issue of conversion/matching, as it seems like a useful
> work-around for a programmer in certain situations where the
> inheritance chain is "interrupted."

Right. It seems nasty to say that you can't convert to a type that you can see.

But I suppose you can work around it in multiple steps:

          X : Root'Class :=
             Root'Class(SubRoot'Class(Sub3'(...)));

I know I did this occasionally in the Claw builder code, but I think it was
caused by more straightforward "invisibilities".

****************************************************************

From: Tucker Taft
Sent: Tuesday, April 19, 2011  3:44 PM

Here is a significant update to AI-0115 on the notion of being a descendant of a
particular "view" of an ancestor.  We decided to be very generous when it comes
to conversion, formal derived type matching, etc., while being very restrictive
as far as inheriting characteristics from an ancestor.  You only inherit
characteristics via the immediate parent -- no generation skipping. But you have
the right to convert to any ancestor you know about.

[This is version /08 of the AI - Editor.]

****************************************************************

From: Ed Schonberg
Sent: Tuesday, April 19, 2011  4:19 PM

The final AARM example needs assorted use clauses or expanded names to be legal:

package P is
        type T is private;
     private
        type T is new Integer;
     end P;

     with P;
     package Q is
         type T2 is new T;  <==  P.T
     end Q;
      <==  with Q;
     package P.Child is
         type T3 is new T2;   <=== Q.T2
     private
         X : T3 := T3(42);  -- legal: conversion allowed
         Y : T3 := X + 1;   -- error: no visible "+" operator
     end P.Child;

However, this is a change to the previous version of the AI.  I don't think that
conversion was legal in the most recent version.

****************************************************************

From: Tucker Taft
Sent: Tuesday, April 19, 2011  5:38 PM

> The final AARM example needs assorted use clauses or expanded names to be
> legal:

Oops, sorry about that.  I'll make the fixes.

...
> However, this is a change to the previous version of the AI.
> I don't think that conversion was legal in the most recent version.

Right.  That is why I called this a "significant" update.
It incorporates the decision to be "generous" with conversions, while being
"stingy" with inheriting other characteristics.

****************************************************************

From: Ed Schonberg
Sent: Tuesday, April 19, 2011  6:07 PM

This is a rather curious twist in this AI.  The original intent was to narrow
visibility and prevent inference of properties from ancestors that may be partly
hidden. Now this change goes in the opposite direction, and as far as I can tell
is incompatible with all previous versions of the language. Is this really
necessary?

****************************************************************

From: Randy Brukardt
Sent: Tuesday, April 19, 2011  6:41 PM

It can't be incompatible (I hope), since it is at most allowing something that
previously was (arguably) not allowed. OTOH, Tucker's previous rule appeared to
me to be incompatible, as it was making illegal conversions that previously were
(again, arguably) allowed.

The problem is that the old rules about the descendant relationship did not
clearly take visibility into account, and as such it is not at all clear to me
what the old rules were in examples like this. Based on that, I think it is
safer to allow a bit more than used to be allowed than to allow *less* and break
existing code for no reason at all. And I thought that is what we decided during
the most recent phone call.

****************************************************************

From: Tucker Taft
Sent: Tuesday, April 19, 2011  7:19 PM

We definitely talked about this on our recent phone call.  Here is a selection
from the minutes:

  AI05-0115-1/07 Aggregates with components that are not visible

   Tucker notes that we don't want to inherit
   characteristics from a parent. But it is
   not a clear that this is a good thing for
   type conversion. Steve asks if there would
   be cases where you can convert A to B and
   B to C, but not A to C.

   Tucker will try to come up with wording that
   has that effect.

   Approve intent: 6-0-2.

  Summary:
     AI05-0115-1 Redo wording to allow conversions
     (explicit or implicit) so long as enough information
     is visible, characteristics are based on the parent's view.

I am trying to preserve compatibility.
Unfortunately, the rules in this area
are not explicitly spelled out anywhere.
My earlier proposal seemed to go too far in one direction.  I can believe this
one is going to far in the other direction.

I am happy to have suggestions for wording which we believe corresponds to the
"current" rules.

****************************************************************

From: Tucker Taft
Sent: Tuesday, April 19, 2011  8:32 PM

OK, Here is a version with a slightly different example. [This is version
/09 of the AI - Editor.]
I think the first example was wrong, because it was depending on the type T3
being considered a numeric type, since it was really converting from univ-int to
T3. And that is a characteristic which is *not* inherited by T3.  In the new
example, it is converting from an object of type P.T, which should be allowed.

-------
      package P is
         type T is private;
      private
         type T is new Integer;
         C : constant T := 42;
      end P;

      with P;
      package Q is
          type T2 is new P.T;
      end Q;

      with Q;
      package P.Child is
          type T3 is new Q.T2;
      private
          X : T3 := T3(P.C);  -- legal: conversion allowed
          Y : T3 := X + 1;   -- error: no visible "+" operator
      end P.Child;

****************************************************************

From: Ed Schonberg
Sent: Tuesday, April 19, 2011  8:38 PM

OK, this is unobjectionable.  It's the sudden "numericness" of T3 that had
bothered me in the previous example.

****************************************************************

From: Jean-Pierre Rosen
Sent: Tuesday, April 19, 2011  11:54 PM

> X : T3 := T3(P.C); -- legal: conversion allowed Y : T3 := X + 1; --
> error: no visible "+" operator end P.Child;

To be perfectly clear, I suggest adding (with a use clause on P):
Z: T3 := T3 (T(X) + 1); -- legal

****************************************************************

From: Tucker Taft
Sent: Wednesday, April 20, 2011  8:18 AM

Actually, the second example I sent out did not prove anything.  Of course you
can convert to type T, since the derivation from T to T3 is out in the open.
The real question was whether you could convert all the way to Integer, which is
not a "known" ancestor as far as T2 is concerned.


  package P is
     type T is private;
     C : constant T;
  private
     type T is new Integer;
     C : constant T := 42;
  end P;

  with P;
  package Q is
      type T2 is new P.T;
  end Q;

  with Q;
  package P.Child is
      type T3 is new Q.T2;
  private
      Int : Integer := 52;
      V : T3 := T3(P.C);  -- legal: conversion allowed
      W : T3 := T3(Int);  -- legal: conversion allowed
      X : T3 := T3(42);  -- error: T3 is not a numeric type
      Y : T3 := X + 1;   -- error: no visible "+" operator
      Z : T3 := T3(Integer(X) + 1);   -- legal: convert to Int first
  end P.Child;

****************************************************************

From: Tucker Taft
Sent: Wednesday, April 20, 2011  1:50 PM

OK, here we go again.  This has the newer example. [This is version /10 of
the AI - Editor.]

This also makes some slight adjustments to the rules on type conversion based on
having a common ancestor.  The adjustment requires that the common ancestor be
something other than a root numeric type.  Being allowed to use numeric literals
seems like a characteristic that should be inherited like other characteristics.
We don't want the fact that universal-integer shares a common ancestor
(root-integer) with all descendants of Integer to allow integer literals to be
used with types that are "secretly" derived from Integer, like the example given
in the AI.

****************************************************************

Questions? Ask the ACAA Technical Agent