!standard 3.9.2 (18) 00-07-20 AI95-00239/01 !class binding intrepretation 00-07-20 !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 Pkg0 is type T0 is tagged null record; function Fa return T0; procedure Pa (P : in T0 := Pkg0.Fa); 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 := Pkg1.Fa); end Pkg1; with Pkg0, 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) The inherited specification of Pkg2.Pa is procedure Pa (P : in T2 := Pkg1.Fa); because 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 static determined to be T1. Similarly, the tag of the enclosing call is statically determined to be T2. This seems weird; is this the intent? (No.) !recommendation (See summary.) !wording Something has to be changed in 3.9.2(18). (Based on the quality of the summary, I don't think I should try to word this! But we have to do it to understand the ramifications, as this is likely to silently change the behavior of user code. [Many existing compilers implement the standard literally, which is shown below to cause significant problems.]) !discussion 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 the example given above. 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 Pkg0, 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. !corrigendum 3.9.2(18) !ACATS test This problem original 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; ****************************************************************