From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Thread: 103376,dad94612ff745427 X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII Path: g2news2.google.com!postnews.google.com!e56g2000cwe.googlegroups.com!not-for-mail From: "Ludovic Brenta" Newsgroups: comp.lang.ada Subject: Re: Instantiating private types with discriminants? Date: 10 May 2006 08:45:07 -0700 Organization: http://groups.google.com Message-ID: <1147275907.235722.316850@e56g2000cwe.googlegroups.com> References: <1147252198.138173.203910@j73g2000cwa.googlegroups.com> <1147270882.727958.212080@u72g2000cwu.googlegroups.com> <%nn8g.29165$_k2.508499@news2.nokia.com> NNTP-Posting-Host: 212.123.3.11 Mime-Version: 1.0 Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable X-Trace: posting.google.com 1147275913 6296 127.0.0.1 (10 May 2006 15:45:13 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: Wed, 10 May 2006 15:45:13 +0000 (UTC) In-Reply-To: <%nn8g.29165$_k2.508499@news2.nokia.com> User-Agent: G2/0.2 X-HTTP-UserAgent: Mozilla/5.0 (X11; U; SunOS sun4u; fr-FR; rv:1.6) Gecko/20040116,gzip(gfe),gzip(gfe) X-HTTP-Via: 1.1 KUUPXS02 Complaints-To: groups-abuse@google.com Injection-Info: e56g2000cwe.googlegroups.com; posting-host=212.123.3.11; posting-account=ZjNXewwAAADyBPkwI57_UcX8yKfXWOss Xref: g2news2.google.com comp.lang.ada:4179 Date: 2006-05-10T08:45:07-07:00 List-Id: rick H a =E9crit : > with Ada.Integer_Text_IO; > with Ada.Float_Text_IO; > > procedure Simple_Case is > > type General_T is tagged null record; > type Access_T is access General_T'Class; > > type Type_A is new General_T with > record > Data : Integer; > end record; > > type Type_B is new General_T with > record > Data : Float; > end record; > > procedure Put (Item: in General_T) is > begin > null; > end Put; > > procedure Put (Item: in Type_A) is > begin > Ada.Integer_Text_IO.Put (Item.Data); > end Put; > > procedure Put (Item: in Type_B) is > begin > Ada.Float_Text_IO.Put (Item.Data); > end Put; > > Var_A : Access_T; -- could be "new Type_A" or a "new Type_B" > begin > > -- Var_A :=3D new Type_A' (Data =3D> 100); > Var_A :=3D new Type_B' (Data =3D> 100.0); > > Put (Var_A.all); > end Simple_Case; First , per ARM 3.2.3, you should declare the three types and the Put procedures inside a package (possibly nested in the Simple_Case procedure), so that they fall under ARM 3.2.3(6). Otherwise, the Put procedures are not primitive, and therefore not dispatching. Secondly, you are being hit by what may be Ada's most subtle rules: freezing rules (ARM 13.14). The declaration of type Type_A freezes General_T, per ARM 13.14(7). This means that after the declaration of Type_A, you can no longer declare primitive subprograms of General_T; any subprograms you declare thereafter are non-primitive, and so dynamic dispatching is forbidden. This is an opportunity to praise GNAT's excellent warnings: dispatch.adb:11:07: warning: no primitive operations for "General_T" after this line (this is the line declaring Type_A) dispatch.adb:19:17: this primitive operation is declared too late (this is the line declaring Put (General_T) dispatch.adb:52:15: class-wide argument not allowed here dispatch.adb:52:15: "Put" is not a primitive operation of "General_T" (quite explicit when you know the language rules) Move the declaration of Put (General_Type) before the declaration of Type_A, and the declaration of Put (Type_A) before the declaration of Type_B (which freezes Type_A). This will make these subprograms primitive. The basic idea behind freezing rules is that you cannot add a primitive operation to the vtable of a tagged type after declaring another type derived from it. --=20 Ludovic Brenta.