diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c7/c730003.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c7/c730003.a | 283 |
1 files changed, 0 insertions, 283 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c7/c730003.a b/gcc/testsuite/ada/acats/tests/c7/c730003.a deleted file mode 100644 index 47002f3aa8b..00000000000 --- a/gcc/testsuite/ada/acats/tests/c7/c730003.a +++ /dev/null @@ -1,283 +0,0 @@ --- C730003.A --- --- Grant of Unlimited Rights --- --- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and --- F08630-91-C-0015, the U.S. Government obtained unlimited rights in the --- software and documentation contained herein. Unlimited rights are --- defined in DFAR 252.227-7013(a)(19). By making this public release, --- the Government intends to confer upon all recipients unlimited rights --- equal to those held by the Government. These rights include rights to --- use, duplicate, release or disclose the released technical data and --- computer software in whole or in part, in any manner and for any purpose --- whatsoever, and to have or permit others to do so. --- --- DISCLAIMER --- --- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR --- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED --- WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE --- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE --- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A --- PARTICULAR PURPOSE OF SAID MATERIAL. ---* --- --- OBJECTIVE: --- Check that the characteristics of a type derived from a private --- extension (outside the scope of the full view) are those defined by --- the partial view of the private extension. --- In particular, check that a component of the derived type may be --- explicitly declared with the same name as a component declared for --- the full view of the private extension. --- Check that a component defined in the private extension of a type --- may be updated through a view conversion of a type derived from --- the type. --- --- TEST DESCRIPTION: --- Consider: --- --- package Parent is --- type T is tagged record --- ... --- end record; --- --- type DT is new T with private; --- procedure Op1 (P: in out DT); --- --- private --- type DT is new T with record --- Y: ...; -- (A) --- end record; --- end Parent; --- --- package body Parent is --- function Op1 (P: in DT) return ... is --- begin --- return P.Y; --- end Op1; --- end Parent; --- --- package Unrelated is --- type Intermediate is new DT with record --- Y: ...; -- Note: same name as component of -- (B) --- -- parent's full view. --- end record; --- end Unrelated; --- --- package Parent.Child is --- type DDT is new Intermediate with null record; --- -- Implicit declared Op1 (P.DDT); -- (C) --- --- procedure Op2 (P: in out DDT); --- end Parent.Child; --- --- package body Parent.Child is --- procedure Op2 (P: in out DDT) is --- Obj : DT renames DT(P); --- begin --- ... --- P.Y := ...; -- Updates DDT's Y. -- (D) --- DT(P).Y := ...; -- Updates DT's Y. -- (E) --- Obj.Y := ...; -- Updates DT's Y. -- (F) --- end Op2; --- end Parent.Child; --- --- Types DT and DDT both declare a component Y at (A) and (B), --- respectively. The component Y of the full view of DT is not visible --- at the place where DDT is declared. Therefore, it is invisible for --- all views of DDT (although it still exists for objects of DDT), and --- it is legal to declare another component for DDT with the same name. --- --- DDT inherits the primitive subprogram Op1 from DT at (C). Op1 returns --- the component Y; for calls with an operand of type DDT, Op1 returns --- the Y inherited from DT, not the new Y explicitly declared for DDT, --- even though the inherited Y is not visible for any view of DDT. --- --- Within the body of Op2, the assignment statement at (D) updates the --- Y explicitly declared for DDT. At (E) and (F), however, a view --- conversion denotes a new view of P as an object of type DT, which --- enables access to the Y from the full view of DT. Thus, the --- assignment statements at (E) and (F) update the (invisible) Y from DT. --- --- Note that the above analysis would be wrong if the new component Y --- were declared directly in Child. In that case, the two same-named --- components would be illegal -- see AI-150. --- --- --- CHANGE HISTORY: --- 06 Dec 1994 SAIC ACVC 2.0 --- 29 JUN 1999 RAD Declare same-named component in an --- unrelated package -- see AI-150. --- ---! - -package C730003_0 is - - type Suit_Kind is (Clubs, Diamonds, Hearts, Spades); - type Face_Kind is (Up, Down); - - type Playing_Card is tagged record - Face: Face_Kind; - Suit: Suit_Kind; - end record; - - procedure Turn_Over_Card (Card : in out Playing_Card); - - type Disp_Card is new Playing_Card with private; - - subtype ASCII_Representation is Natural range 1..14; - - function Get_Private_View (A_Card : Disp_Card) return ASCII_Representation; - -private - - type Disp_Card is new Playing_Card with record - View: ASCII_Representation; -- (A) - end record; - -end C730003_0; - ---==================================================================-- - -package body C730003_0 is - - procedure Turn_Over_Card (Card: in out Playing_Card) is - begin - Card.Face := Up; - end Turn_Over_Card; - - function Get_Private_View (A_Card : Disp_Card) - return ASCII_Representation is - begin - return A_Card.View; - end Get_Private_View; - -end C730003_0; - ---==================================================================-- - -with C730003_0; use C730003_0; -package C730003_1 is - - subtype Graphic_Representation is String (1 .. 2); - - type Graphic_Card is new Disp_Card with record - View : Graphic_Representation; -- (B) - -- "Duplicate" component field name. - end record; - -end C730003_1; - ---==================================================================-- - -with C730003_1; use C730003_1; -package C730003_0.C730003_2 is - - Queen_Of_Spades : constant C730003_0.ASCII_Representation := 12; - Ace_Of_Hearts : constant String := "AH"; - Close_To_The_Vest : constant C730003_0.ASCII_Representation := 14; - Read_Em_And_Weep : constant String := "AA"; - - type Graphic_Card is new C730003_1.Graphic_Card with null record; - - -- Implicit function Get_Private_View -- (C) - -- (A_Card : Graphic_Card) return C730003_0.ASCII_Representation; - - function Get_View (Card : Graphic_Card) return String; - procedure Update_View (Card : in out Graphic_Card); - procedure Hide_From_View (Card : in out Graphic_Card); - -end C730003_0.C730003_2; - ---==================================================================-- - -package body C730003_0.C730003_2 is - - function Get_View (Card : Graphic_Card) return String is - begin - return Card.View; - end Get_View; - - procedure Update_View (Card : in out Graphic_Card) is - ASCII_View : Disp_Card renames Disp_Card(Card); -- View conversion. - begin - ASCII_View.View := Queen_Of_Spades; -- (F) - -- Assignment to "hidden" field. - Card.View := Ace_Of_Hearts; -- (D) - -- Assignment to Graphic_Card declared field. - end Update_View; - - procedure Hide_From_View (Card : in out Graphic_Card) is - begin - -- Update both of Card's View components. - Disp_Card(Card).View := Close_To_The_Vest; -- (E) - -- Assignment to "hidden" field. - Card.View := Read_Em_And_Weep; -- (D) - -- Assignment to Graphic_Card declared field. - end Hide_From_View; - -end C730003_0.C730003_2; - ---==================================================================-- - -with C730003_0; -with C730003_0.C730003_2; -with Report; - -procedure C730003 is -begin - - Report.Test ("C730003", "Check that the characteristics of a type " & - "derived from a private extension (outside " & - "the scope of the full view) are those " & - "defined by the partial view of the private " & - "extension"); - - Check_Your_Cards: - declare - use C730003_0; - use C730003_0.C730003_2; - - Top_Card_On_The_Deck : Graphic_Card; - - begin - - -- Update value in the components of the card. There are two - -- component fields named View, although one is not visible for - -- any view of a Graphic_Card. - - Update_View(Top_Card_On_The_Deck); - - -- Verify that both "View" components of the card have been updated. - - if Get_View(Top_Card_On_The_Deck) /= Ace_Of_Hearts then - Report.Failed ("Incorrect value in visible component - 1"); - end if; - - if Get_Private_View(Top_Card_On_The_Deck) /= Queen_Of_Spades - then - Report.Failed ("Incorrect value in non-visible component - 1"); - end if; - - -- Again, update the components of the card (to blank values). - - Hide_From_View(Top_Card_On_The_Deck); - - -- Verify that both components have been updated. - - if Get_View(Top_Card_On_The_Deck) /= Read_Em_And_Weep then - Report.Failed ("Incorrect value in visible component - 2"); - end if; - - if Get_Private_View(Top_Card_On_The_Deck) /= Close_To_The_Vest - then - Report.Failed ("Incorrect value in non-visible component - 2"); - end if; - - exception - when others => Report.Failed("Exception raised in test block"); - end Check_Your_Cards; - - Report.Result; - -end C730003; |