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

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

!standard 4.3.1(13)          09-06-02 AI05-0115-1/04
!standard 4.3.1(14)
!standard 4.3.2(5/2)
!class binding interpretation 08-10-15
!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 it has components that are not visible.
The ancestor type of an extension aggregate must not have unknown discriminants.
!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 4.3.1(13):
Static Semantics
A view of a specific tagged type T is said to "have known components" if it is not a partial view, nor a descendant of a type which does not have known components. Given a specific tagged type T having an ancestor type A, a view of T is said to "extend A with known components" if T is A, or if T is a record extension of A, or if T is a record extension of type B, and B extends A with known components.
[Editor's note: See the last mail from Randy. This wording doesn't capture the locality very well, in that it is the view WRT to the type derivation that matters. Should we work this hard to preserve an annoying Ada feature?? See also AI05-0125-1.]
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). That means that these properties can be added as more information becomes available about an ancestor type, and thus whether or not a type has known components depends on its view.
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;
Replace 4.3.1(14):
The type of a record aggregate shall have known components.
Replace 4.3.2(5/2):
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. 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. The type of the extension aggregate shall extend the type of the ancestor_part with known components.
Modify 7.3(15):. 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{, whether the type has known components, and (for any ancestor type A of the given type) whether the type extends A with known components}.
!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.
We tried a number of different wording attempts, but it became clear that any attempt to create wording that didn't leverage the existing characteristics rules was doomed to failure. Thus we defined some new characteristics that make it clear whether an aggregate is legal.
Note that a similar case can be constructed for extension aggregates: Make type T1 in the example derived from a root type, then 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.)
An alternative way to solve this problem would be to allow the components to be visible in cases like those given in the question. Essetially, characteristics could be inherited from any ancestor, not just the parent. In that case, no legality rule change would be needed here. But conflicting components would have to be illegal when a type is declared, so there is some incompatibility. And it would likely be a fairly large change to compilers (even if it would be more usable).
---
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; -- Does not have known components (partial view). private type T1 is tagged record C1 : Integer; end record; -- Does have known components end Pkg1;
package Pkg1.Pkg2 is -- Private case type T2 is new Pkg1.T1 with private; -- Does not have known components (partial view and parent type). X1 : T2 := (others => 1); -- Illegal. private type T2 is new Pkg1.T1 with record C2 : Integer; end record; -- Does have known components (derived from type that has them). X2 : T2 := (C1 | C2 => 1); -- Legal. end Pkg1.Pkg2;
package Pkg1.Pkg3 is -- Record case type T3 is new Pkg1.T1 with record C2 : Integer; end record; -- Does not have known components (parent type) X1 : T3 := (others => 1); -- Illegal. private -- T3 gets known components here (an additional characteristic). X2 : T3 := (C1 | C2 => 1); -- Legal. 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. -- T4 does not have known components (parent type). X3 : T4 := (C1 => 1, C2 => 2); -- Illegal. X4 : T4 := (others => 1); -- Illegal.
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. -- T5 does not have known components (parent type). X5 : T5 := (C3 => 1, C2 => 2, C1 => 1); -- Illegal. X6 : T5 := (C2 => 2, others => 1); -- Illegal.
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. T6 does not have known components (parent type) X7 : T6 := (C1 => 1, C2 => 2); -- Illegal. X8 : T6 := (C2 => 2, others => 1); -- Illegal.
end Pkg1;
Note that X5 through X8 are not illegal by the Ada 2005 rules.
--!corrigendum 4.3.1(13)
!corrigendum 4.3.1(14)
Replace the paragraph:
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).
by:
The type of a record aggregate shall have known components.
!corrigendum 4.3.2(5/2)
Replace the paragraph:
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. 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 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.
--!corrigendum 7.3(15)
!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.

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


Questions? Ask the ACAA Technical Agent