aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a')
-rw-r--r--gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a108
1 files changed, 108 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a
new file mode 100644
index 000000000..6921bf027
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c7/c760013.a
@@ -0,0 +1,108 @@
+-- C760013.A
+--
+-- Grant of Unlimited Rights
+--
+-- The Ada Conformity Assessment Authority (ACAA) holds unlimited
+-- rights in the software and documentation contained herein. Unlimited
+-- rights are the same as those granted by the U.S. Government for older
+-- parts of the Ada Conformity Assessment Test Suite, and are defined
+-- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
+-- intends to confer upon all recipients unlimited rights equal to those
+-- held by the ACAA. 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 Initialize is not called for default-initialized subcomponents
+-- of the ancestor type of an extension aggregate. (Defect Report
+-- 8652/0021, Technical Corrigendum 7.6(11/1)).
+--
+-- CHANGE HISTORY:
+-- 25 JAN 2001 PHL Initial version.
+-- 29 JUN 2001 RLB Reformatted for ACATS.
+--
+--!
+with Ada.Finalization;
+use Ada.Finalization;
+package C760013_0 is
+
+ type Ctrl1 is new Controlled with
+ record
+ C : Integer := 0;
+ end record;
+ type Ctrl2 is new Controlled with
+ record
+ C : Integer := 0;
+ end record;
+
+ procedure Initialize (Obj1 : in out Ctrl1);
+ procedure Initialize (Obj2 : in out Ctrl2);
+
+end C760013_0;
+
+with Report;
+use Report;
+package body C760013_0 is
+
+ procedure Initialize (Obj1 : in out Ctrl1) is
+ begin
+ Obj1.C := Ident_Int (47);
+ end Initialize;
+
+ procedure Initialize (Obj2 : in out Ctrl2) is
+ begin
+ Failed ("Initialize called for type Ctrl2");
+ end Initialize;
+
+end C760013_0;
+
+with Ada.Finalization;
+with C760013_0;
+use C760013_0;
+with Report;
+use Report;
+procedure C760013 is
+
+ type T is tagged
+ record
+ C1 : Ctrl1;
+ C2 : Ctrl2 := (Ada.Finalization.Controlled with
+ C => Ident_Int (23));
+ end record;
+
+ type Nt is new T with
+ record
+ C3 : Float;
+ end record;
+
+ X : Nt;
+
+begin
+ Test ("C760013",
+ "Check that Initialize is not called for " &
+ "default-initialized subcomponents of the ancestor type of an " &
+ "extension aggregate");
+
+ X := (T with C3 => 5.0);
+
+ if X.C1.C /= Ident_Int (47) then
+ Failed ("Initialize not called for type Ctrl1");
+ end if;
+ if X.C2.C /= Ident_Int (23) then
+ Failed ("Initial value not assigned for type Ctrl2");
+ end if;
+
+ Result;
+end C760013;
+