aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c3/c390011.a
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c390011.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/c3/c390011.a250
1 files changed, 0 insertions, 250 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c390011.a b/gcc/testsuite/ada/acats/tests/c3/c390011.a
deleted file mode 100644
index 74cf0eb0468..00000000000
--- a/gcc/testsuite/ada/acats/tests/c3/c390011.a
+++ /dev/null
@@ -1,250 +0,0 @@
--- C390011.A
---
--- Grant of Unlimited Rights
---
--- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--- F08630-91-C-0015, and DCA100-97-D-0025, 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 WHATSOEVER, 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 tagged types declared within generic package declarations
--- generate distinct tags for each instance of the generic.
---
--- TEST DESCRIPTION:
--- This test defines a very simple generic package (with the expectation
--- that it should be easily be shared), and a few instances of that
--- package. In true user-like fashion, two of the instances are identical
--- (to wit: IIO is new Integer_IO(Integer)). The tags generated for each
--- of them are placed into a list. The last action of the test is to
--- check that everything in the list is unique.
---
--- Almost as an aside, this test defines functions that return T'Base and
--- T'Class, and then exercises these functions.
---
--- (JPR) persistent objects really need a function like:
--- function Get_Object return T'class;
---
---
--- CHANGE HISTORY:
--- 20 OCT 95 SAIC Initial version
--- 23 APR 96 SAIC Commentary Corrections 2.1
---
---!
-
------------------------------------------------------------------ C390011_0
-
-with Ada.Tags;
-package C390011_0 is
-
- procedure Add_Tag_To_List( T : Ada.Tags.Tag; X_Name, X_Tag: String );
-
- procedure Check_List_For_Duplicates;
-
-end C390011_0;
-
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
-with Report;
-package body C390011_0 is
-
- use type Ada.Tags.Tag;
- type SP is access String;
-
- type List_Item;
- type List_P is access List_Item;
- type List_Item is record
- The_Tag : Ada.Tags.Tag;
- Exp_Name : SP;
- Ext_Tag : SP;
- Next : List_P;
- end record;
-
- The_List : List_P;
-
- procedure Add_Tag_To_List ( T : Ada.Tags.Tag; X_Name, X_Tag: String ) is
- begin -- prepend the tag information to the list
- The_List := new List_Item'( The_Tag => T,
- Exp_Name => new String'(X_Name),
- Ext_Tag => new String'(X_Tag),
- Next => The_List );
- end Add_Tag_To_List;
-
- procedure Check_List_For_Duplicates is
- Finger : List_P;
- Thumb : List_P := The_List;
- begin --
- while Thumb /= null loop
- Finger := Thumb.Next;
- while Finger /= null loop
- -- Check that the tag is unique
- if Finger.The_Tag = Thumb.The_Tag then
- Report.Failed("Duplicate Tag");
- end if;
-
- -- Check that the Expanded name is unique
- if Finger.Exp_Name.all = Thumb.Exp_Name.all then
- Report.Failed("Tag name " & Finger.Exp_Name.all & " repeats");
- end if;
-
- -- Check that the External Tag is unique
-
- if Finger.Ext_Tag.all = Thumb.Ext_Tag.all then
- Report.Failed("External Tag " & Finger.Ext_Tag.all & " repeats");
- end if;
- Finger := Finger.Next;
- end loop;
- Thumb := Thumb.Next;
- end loop;
- end Check_List_For_Duplicates;
-
-begin
- -- some things I just don't trust...
- if The_List /= null then
- Report.Failed("Implicit default for The_List not null");
- end if;
-end C390011_0;
-
------------------------------------------------------------------ C390011_1
-
-generic
- type Index is (<>);
- type Item is private;
-package C390011_1 is
-
- type List is array(Index range <>) of Item;
- type ListP is access all List;
-
- type Table is tagged record
- Data: ListP;
- end record;
-
- function Sort( T: in Table'Class ) return Table'Class;
-
- function Stable_Table return Table'Class;
-
- function Table_End( T: Table ) return Index'Base;
-
-end C390011_1;
-
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
-package body C390011_1 is
-
- -- In a user program this package would DO something
-
- function Sort( T: in Table'Class ) return Table'Class is
- begin
- return T;
- end Sort;
-
- Empty : Table'Class := Table'( Data => null );
-
- function Stable_Table return Table'Class is
- begin
- return Empty;
- end Stable_Table;
-
- function Table_End( T: Table ) return Index'Base is
- begin
- return Index'Base( T.Data.all'Last );
- end Table_End;
-
-end C390011_1;
-
------------------------------------------------------------------ C390011_2
-
-with C390011_1;
-package C390011_2 is new C390011_1( Index => Character, Item => Float );
-
------------------------------------------------------------------ C390011_3
-
-with C390011_1;
-package C390011_3 is new C390011_1( Index => Character, Item => Float );
-
------------------------------------------------------------------ C390011_4
-
-with C390011_1;
-package C390011_4 is new C390011_1( Index => Integer, Item => Character );
-
------------------------------------------------------------------ C390011_5
-
-with C390011_3;
-with C390011_4;
-package C390011_5 is
-
- type Table_3 is new C390011_3.Table with record
- Serial_Number : Integer;
- end record;
-
- type Table_4 is new C390011_4.Table with record
- Serial_Number : Integer;
- end record;
-
-end C390011_5;
-
--- no package body C390011_5 required
-
-------------------------------------------------------------------- C390011
-
-with Report;
-with C390011_0;
-with C390011_2;
-with C390011_3;
-with C390011_4;
-with C390011_5;
-with Ada.Tags;
-procedure C390011 is
-
-begin -- Main test procedure.
-
- Report.Test ("C390011", "Check that tagged types declared within " &
- "generic package declarations generate distinct " &
- "tags for each instance of the generic. " &
- "Check that 'Base may be used as a subtype mark. " &
- "Check that T'Base and T'Class are allowed as " &
- "the subtype mark in a function result" );
-
- -- build the tag information table
- C390011_0.Add_Tag_To_List(T => C390011_2.Table'Tag,
- X_Name => Ada.Tags.Expanded_Name(C390011_2.Table'Tag),
- X_Tag => Ada.Tags.External_Tag(C390011_2.Table'Tag) );
-
- C390011_0.Add_Tag_To_List(T => C390011_3.Table'Tag,
- X_Name => Ada.Tags.Expanded_Name(C390011_3.Table'Tag),
- X_Tag => Ada.Tags.External_Tag(C390011_3.Table'Tag) );
-
- C390011_0.Add_Tag_To_List(T => C390011_4.Table'Tag,
- X_Name => Ada.Tags.Expanded_Name(C390011_4.Table'Tag),
- X_Tag => Ada.Tags.External_Tag(C390011_4.Table'Tag) );
-
- C390011_0.Add_Tag_To_List(T => C390011_5.Table_3'Tag,
- X_Name => Ada.Tags.Expanded_Name(C390011_5.Table_3'Tag),
- X_Tag => Ada.Tags.External_Tag(C390011_5.Table_3'Tag) );
-
- C390011_0.Add_Tag_To_List(T => C390011_5.Table_4'Tag,
- X_Name => Ada.Tags.Expanded_Name(C390011_5.Table_4'Tag),
- X_Tag => Ada.Tags.External_Tag(C390011_5.Table_4'Tag) );
-
- -- preform the check for distinct tags
- C390011_0.Check_List_For_Duplicates;
-
- Report.Result;
-
-end C390011;
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-01 22:41:16 +0000