Version 1.6 of ais/ai-00239.txt

Unformatted version of ais/ai-00239.txt version 1.6
Other versions for file ais/ai-00239.txt

!standard 3.9.2 (18) 04-11-08 AI95-00239/04
!class binding interpretation 00-07-20
!status Amendment 200Y 04-07-02
!status ARG Approved 8-0-1 04-06-17
!status work item 00-07-20
!status received 00-07-20
!qualifier Error
!priority High
!difficulty Medium
!subject Controlling inherited default expressions

!summary

For the purposes of dispatching, inherited controlling default expressions are treated as if they have the derived type.

!question

Consider the following example:

package Pkg1 is

type T1 is tagged null record;

function Fa return T1;

procedure Pa (P : in T1 := Pkg1.Fa);

end Pkg1;

with Pkg1; package Pkg2 is

type T2 is new Pkg1.T1 with null record;

-- Inherits: -- procedure Pa (P : in T2 := Pkg1.Fa);

function Fa return T2;

end Pkg2;

procedure Main is begin Pkg2.Pa; -- Call using a default parameter of Fa. end Main;

Which Fa is called as the default expression of Pkg2.Pa? (Pkg2.Fa)

!recommendation

(See summary.)

!wording

Replace 3.9.2(18) by:

If the call has a controlling result and is itself a (possibly parenthesized or qualified) controlling operand of an enclosing call on a dispatching operation of a descendant of type T, then its controlling tag value is determined by the controlling tag value of this enclosing call;

!discussion

In inherited specification of Pkg2.Pa, the default expression is inherited unchanged, by 3.4(22). The possibility of type mismatch is mentioned and expected.

3.9.2(14-19) say:

For the execution of a call on a dispatching operation of a type T, the controlling tag value determines which subprogram body is executed. The controlling tag value is defined as follows:

If one or more controlling operands are statically tagged, then the controlling tag value is statically determined to be the tag of T.

If one or more controlling operands are dynamically tagged, then the controlling tag value is not statically determined, but is rather determined by the tags of the controlling operands. If there is more than one dynamically tagged controlling operand, a check is made that they all have the same tag. If this check fails, Constraint_Error is raised unless the call is a function_ call whose name denotes the declaration of an equality operator (predefined or user defined) that returns Boolean, in which case the result of the call is defined to indicate inequality, and no subprogram_body is executed. This check is performed prior to evaluating any tag-indeterminate controlling operands.

If all of the controlling operands are tag-indeterminate, then:

If the call has a controlling result and is itself a (possibly parenthesized or qualified) controlling operand of an enclosing call on a dispatching operation of type T, then its controlling tag value is determined by the controlling tag value of this enclosing call;

Otherwise, the controlling tag value is statically determined to be the tag of type T.

Certainly 3.9.2(15) and 3.9.2(16) do not apply to the default expression Pkg1.Fa. 3.9.2(18) does not apply, either, as Pkg1.Fa is a dispatching operation of type T1, while the enclosing call is a dispatching operation on type T2. Thus, the tag of Pkg1.Fa is statically determined to be T1. Similarly, the tag of the enclosing call is statically determined to be T2.

AARM 3.9(1.g) notes that there is a general principle that the subprograms called for a statically tagged call are the same as those that would be called in a dispatching call. The literal reading of the standard violates this principle in this example.

Note that it is impossible to create such a call explicitly, as the type mismatch would make the call illegal.

Additionally, the literal reading of the standard means that a call can have a parameter with the wrong tag. Consider the following similar example:

with Pkg1; package Pkg3 is

type T3 is new Pkg1.T1 with record New_Component : Integer; end record;

-- Inherits: -- procedure Pa (P : in T3 := Pkg1.Fa);

function Fa return T3;

private procedure Pa (P : in T3 := Pkg3.Fa); -- Private overriding. end Pkg3;

Now, the call Pkg3.Pa would be made with a parameter of type T1! The body of Pkg3.Pa could then attempt to read a non-existent P.New_Component.

The root of the problem is 3.9.2(18), which assumes that the only contexts that can control dispatching of a function with a controlling result of type T are those that involve controlling operands of the same type T. That's true for code that the user can write explicitly because if the two types differ there is an illegality and the dynamic semantics are irrelevant.

Here, as noted above, we have code that the user could not write explicitly. It is obvious that we want dispatching to happen, so we must relax 3.9.2(18) a bit. The phrase that requires the two types to match is "of type T". We are changing it to "of a descendant of type T". This is safe, because if the type of the parameter is descended from the type of the function result, it is guaranteed to inherit or override the function, and this ensures that there will be an appropriate body to dispatch to. Note that abstract functions are not an issue here because the call to the function is a dispatching call, so it is guaranteed to always land on a concrete body.

!corrigendum 3.9.2(18)

Replace the paragraph:

If the call has a controlling result and is itself a (possibly parenthesized or qualified) controlling operand of an enclosing call on a dispatching operation of type T, then its controlling tag value is determined by the controlling tag value of this enclosing call;

by:

If the call has a controlling result and is itself a (possibly parenthesized or qualified) controlling operand of an enclosing call on a dispatching operation of a descendant of type T, then its controlling tag value is determined by the controlling tag value of this enclosing call;

!ACATS test

This problem originally came up in ACATS test C392010; this test should have the offending cases replaced. In addition, the test in the appendix should be issued in order to insure that multiple parameter cases and cases where the wrong component could be read are also handled. (It is clear that existing compilers don't do that.)

!appendix


From: Randy Brukardt
Sent: Thursday, July 20, 2000 6:30 PM

This AI was created out of a recent discussion on the Fast Reaction Team.

Several people objected to the literal interpretation of the standard shown
in the question.

I created the attached test in order to determine the state of existing
compilers. I tried the test on the following compilers:
      GNAT 3.13a           -- Literal interpretation of the standard
                           -- (and other bugs).
      Janus/Ada 3.1.1e     -- Literal interpretation of the standard
                           -- (and other bugs).
      Rational Apex 3.0.2  -- Literal interpretation of the standard.
      AdaMagic (from Tucker) -- As suggested in this AI, but falls back to
                           -- a literal interpretation for defaults other than
                           -- the first.

The DDCI compiler passed the (original) disputed test in their conformity
assessments, so they are somewhere between AdaMagic and full support for this
AI.

In any case, this proves that there is no consistent interpretation of these
cases, so the ARG has to discuss them.

		Randy Brukardt
		ARG Editor.

----- The test:

package Pkg0 is

    type T0 is tagged null record;

    function Fa return T0;

    function Fc return T0'Class;

    procedure Pa (P : in T0 := Fa);

    procedure Pb (P : in T0 := Fa);

    procedure Pc (Param1, Param2 : in T0 := Fa);

    function Fd (P : in T0 := Fa) return T0'Class;

end Pkg0;

with TCTouch;
package body Pkg0 is

    function Fa return T0 is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('a'); TCTouch.Touch('0');
       return T0'(null record);
    end Fa;

    function Fc return T0'Class is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('c'); TCTouch.Touch('0');
       return T0'(null record);
    end Fc;

    procedure Pa (P : in T0 := Fa) is
    begin
       TCTouch.Touch('P'); TCTouch.Touch('a'); TCTouch.Touch('0');
    end Pa;

    procedure Pb (P : in T0 := Fa) is
    begin
       TCTouch.Touch('P'); TCTouch.Touch('b'); TCTouch.Touch('0');
    end Pb;

    procedure Pc (Param1, Param2 : in T0 := Fa) is
    begin
       TCTouch.Touch('P'); TCTouch.Touch('c'); TCTouch.Touch('0');
    end Pc;

    function Fd (P : in T0 := Fa) return T0'Class is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('d'); TCTouch.Touch('0');
       return T0'Class(P);
    end Fd;

end Pkg0;

with Pkg0;
package Pkg1 is

    type T1 is new Pkg0.T0 with null record;

    function Fa return T1;

    procedure Pa (P : in T1 := Fa);

    procedure Pb (P : in T1 := Fa);

    procedure Pc (Param1, Param2 : in T1 := Fa);

    procedure Pd (Param1 : in T1; Param2 : in Pkg0.T0 := Pkg0.Fa);
        -- Param2 is not a controlling operand.

    function Fc1 return T1'Class;

    function Fd (P : in T1 := Fa) return Pkg0.T0'Class;

    function Fe (P : in T1 := Fa) return T1'Class;

end Pkg1;

with TCTouch;
package body Pkg1 is

    function Fa return T1 is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('a'); TCTouch.Touch('1');
       return T1'(null record);
    end Fa;

    procedure Pa (P : in T1 := Fa) is
    begin
       TCTouch.Touch('P'); TCTouch.Touch('a'); TCTouch.Touch('1');
    end Pa;

    procedure Pb (P : in T1 := Fa) is
    begin
       TCTouch.Touch('P'); TCTouch.Touch('b'); TCTouch.Touch('1');
    end Pb;

    procedure Pc (Param1, Param2 : in T1 := Fa) is
    begin
       TCTouch.Touch('P'); TCTouch.Touch('c'); TCTouch.Touch('1');
    end Pc;

    procedure Pd (Param1 : in T1; Param2 : in Pkg0.T0 := Pkg0.Fa) is
    begin
       TCTouch.Touch('P'); TCTouch.Touch('d'); TCTouch.Touch('1');
    end Pd;

    function Fc1 return T1'Class is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('c'); TCTouch.Touch('1');
       return T1'(null record);
    end Fc1;

    function Fd (P : in T1 := Fa) return Pkg0.T0'Class is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('d'); TCTouch.Touch('1');
       return Pkg0.T0'Class(P);
    end Fd;

    function Fe (P : in T1 := Fa) return T1'Class is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('e'); TCTouch.Touch('1');
       return T1'Class(P);
    end Fe;

end Pkg1;

with Pkg0, Pkg1;
package Pkg2 is

    type T2 is new Pkg1.T1 with null record;

    -- Inherits:
    --procedure Pa (P : in T2 := Fa);
    --procedure Pb (P : in T2 := Fa);
    --procedure Pc (Param1, Param2 : in T2 := Fa);
    --procedure Pd (Param1 : in T2; Param2 : in Pkg0.T0 := Pkg0.Fa);
    --function Fe (P : in T2 := Fa) return Pkg1.T1'Class;

    function Fa return T2;

    function Fb return T2;

    function Fc2 return T2'Class;

    function Fd (P : in T2 := Fa) return Pkg0.T0'Class;

    function Ff (P : in T2 := Fa) return T2'Class;

private
    procedure Pb (P : in T2 := Fb); -- Privately override Pb with a
				    -- different default.
end Pkg2;

with TCTouch;
package body Pkg2 is

    function Fa return T2 is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('a'); TCTouch.Touch('2');
       return T2'(null record);
    end Fa;

    function Fb return T2 is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('b'); TCTouch.Touch('2');
       return T2'(null record);
    end Fb;

    function Fc2 return T2'Class is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('c'); TCTouch.Touch('2');
       return T2'(null record);
    end Fc2;

    procedure Pb (P : in T2 := Fb) is
    begin
       TCTouch.Touch('P'); TCTouch.Touch('b'); TCTouch.Touch('2');
    end Pb;

    function Fd (P : in T2 := Fa) return Pkg0.T0'Class is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('d'); TCTouch.Touch('2');
       return Pkg0.T0'Class(P);
    end Fd;

    function Ff (P : in T2 := Fa) return T2'Class is
    begin
       TCTouch.Touch('F'); TCTouch.Touch('f'); TCTouch.Touch('2');
       return T2'Class(P);
    end Ff;

end Pkg2;

with TcTouch, Report;
with Pkg0, Pkg1, Pkg2;
procedure Frn622 is
begin
   Report.Test ("Frn622", "Check handling of tag-indeterminate default " &
			  "expressions");

   Report.Comment ("If a test fails with a result matching ""literal"", that " &
		   "means that the implementation has a literal interpretation of " &
		   "3.9.2(18)");

   Pkg0.Pa; -- The default should be Fa0.
   TCTouch.Validate( "Fa0Pa0", "Subtest 1" );

   Pkg1.Pa; -- The default should be Fa1.
   TCTouch.Validate( "Fa1Pa1", "Subtest 2" );

   Pkg2.Pa; -- The default should be Fa2 by Tucker; literally, Fa1.
   TCTouch.Validate( "Fa2Pa1", "Subtest 3 (Literal=""Fa1Pa1"")");

   Pkg2.Pb; -- The default should be Fa2, not Fb2 (which is not visible).
	    -- By Tucker; literally, Fa1, not Fb2.
   TCTouch.Validate( "Fa2Pb2", "Subtest 4 (Literal=""Fa1Pb2"")");

   Pkg1.Pc; -- Two defaults.
   TCTouch.Validate( "Fa1Fa1Pc1", "Subtest 5");

   Pkg2.Pc; -- Two defaults, both Fa2 by Tucker; literally, Fa1.
   TCTouch.Validate( "Fa2Fa2Pc1", "Subtest 6 (Literal=""Fa1Fa1Pc1"")");

   declare
       O1 : Pkg1.T1;
       O2 : Pkg2.T2;
   begin
       Pkg1.Pc(O1); -- One default, Fa1.
       TCTouch.Validate( "Fa1Pc1", "Subtest 7");
       Pkg2.Pc(O2); -- One default, Fa2 by Tucker; literally, Fa1.
       TCTouch.Validate( "Fa2Pc1", "Subtest 8 (Literal=""Fa1Pc1"")");
       Pkg1.Pc(Pkg1.T1'Class(Pkg2.Fc2)); -- One default, Fa. Both Fa and Pc
		    -- are dispatching (for T2).
       TCTouch.Validate( "Fc2Fa2Pc1", "Subtest 9");
       Pkg2.Pc(Pkg2.Fc2); -- One default, Fa. Both Fa and Pc are
		    -- dispatching (for T2).
       TCTouch.Validate( "Fc2Fa2Pc1", "Subtest 10");
       Pkg1.Pc(Pkg1.Fc1); -- One default, Fa. Both Fa and Pc are
		    -- dispatching (for T1).
       TCTouch.Validate( "Fc1Fa1Pc1", "Subtest 11");
   end;

   declare
       O1 : Pkg1.T1;
       O2 : Pkg2.T2;
   begin
       Pkg1.Pd(O1); -- Default is Fa0 (not controlling).
       TCTouch.Validate( "Fa0Pd1", "Subtest 14");
       Pkg2.Pd(O2); -- Default is Fa0 (not controlling).
       TCTouch.Validate( "Fa0Pd1", "Subtest 15");
       Pkg2.Pd(Pkg2.Fc2); -- Default is Fa0 (not controlling).
       TCTouch.Validate( "Fc2Fa0Pd1", "Subtest 16");
       Pkg1.Pd(Pkg1.Fc1); -- Default is Fa0 (not controlling).
       TCTouch.Validate( "Fc1Fa0Pd1", "Subtest 17");
   end;

   Pkg1.Pb(Pkg1.Fe); -- The default is Fa1. Pb is dispatching.
   TCTouch.Validate( "Fa1Fe1Pb1", "Subtest 18" );

   Pkg2.Pb(Pkg2.Ff); -- The default is Fa2. Pb is dispatching.
   TCTouch.Validate( "Fa2Ff2Pb2", "Subtest 19");

   Pkg0.Pb(Pkg0.Fd); -- The default is Fa0. Pb is dispatching.
   TCTouch.Validate( "Fa0Fd0Pb0", "Subtest 20");

   Pkg0.Pb(Pkg1.Fd); -- The default is Fa1. Pb is dispatching.
   TCTouch.Validate( "Fa1Fd1Pb1", "Subtest 21");

   Pkg0.Pb(Pkg2.Fd); -- The default is Fa2. Pb is dispatching.
   TCTouch.Validate( "Fa2Fd2Pb2", "Subtest 22");

   Pkg1.Pb(Pkg2.Fe); -- The default is Fa2 by Tucker; literally, Fa1.
		     -- Pb is dispatching.
   TCTouch.Validate( "Fa2Fe1Pb2", "Subtest 23 (Literal=""Fa1Fe1Pb1"")");

   Pkg0.Pc(Pkg2.Fd, Pkg0.Fa); -- Default is Fa2; Pc and Fa are dispatching.
   TCTouch.Validate( "Fa2Fd2Fa2Pc1", "Subtest 24");

   Pkg0.Pc(Pkg1.Fd, Pkg0.Fa); -- Default is Fa1; Pc and Fa are dispatching.
   TCTouch.Validate( "Fa1Fd1Fa1Pc1", "Subtest 25");

   Pkg0.Pc(Pkg0.Fd, Pkg0.Fa); -- Default is Fa1; Pc and Fa are dispatching.
   TCTouch.Validate( "Fa0Fd0Fa0Pc0", "Subtest 26");

   Pkg1.Pc(Pkg1.Fe, Pkg1.Fa); -- Default is Fa1; Pc and Fa are dispatching.
   TCTouch.Validate( "Fa1Fe1Fa1Pc1", "Subtest 27");

   Pkg1.Pc(Pkg2.Fe, Pkg1.Fa); -- Default is Fa2 by Tucker, literally Fa1.
			      -- Pc and Fa are dispatching.
   TCTouch.Validate( "Fa2Fe1Fa2Pc1", "Subtest 28 (Literal=""Fa1Fe1Fa1Pc1"")");

   Report.Result;

end Frn622;

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

From: Jean-Pierre Rosen
Sent: Friday, July 21, 2000 2:36 AM

Ouch...
My first reaction is: can't we simply state that the call is illegal, precisely
because the types do not match?

After all, using a default value is equivalent (safe for visibility oddities) to
writing the default value explicitely, and as you note:

> Note that it is impossible to create such a call explicitly, as the type
> mismatch would make the call illegal.

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

From: Gary Dismukes [dismukes@GNAT.COM]
Sent: Friday, July 21, 2000 1:13 PM

Not realistically.  Such calls were also allowed in Ada 83 for untagged
derived types.  We can't consider creating that kind of incompatibility.

We know what semantics we want for the call, it's just a matter of
coming up with the proper RM wording to handle it :-)

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

From: Randy Brukardt
Sent: Friday, July 21, 2000 1:28 PM

Well, that would of course be incompatible with untagged types. It would be
necessary to repeal part of 3.4(22) in order to implement that rule. It also
would make the rule of 3.9.2(11) unnecessary (so in that case, it should be
repealed as well, as it is very annoying).

So I don't think that would be an improvement over rewriting 3.9.2(18).

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

Questions? Ask the ACAA Technical Agent