WITH REPORT;
PROCEDURE C48006B IS
USE REPORT ;
BEGIN
TEST("C48006B","CHECK THAT THE FORM 'NEW T'(X)' " &
"ALLOCATES A NEW OBJECT " &
"AND THAT IF T IS A RECORD, ARRAY, OR PRIVATE " &
"TYPE, THE ALLOCATED OBJECT HAS THE VALUE (X)");
DECLARE
TYPE TB0( A , B : INTEGER ) IS
RECORD
C : INTEGER := 7 ;
END RECORD;
SUBTYPE TB IS TB0( 2 , 3 );
TYPE ATB IS ACCESS TB ;
TYPE ATB0 IS ACCESS TB0 ;
VB1 , VB2 : ATB ;
VB01 , VB02 : ATB0 ;
TYPE ARR0 IS ARRAY( INTEGER RANGE <> ) OF INTEGER ;
SUBTYPE ARR IS ARR0( 1..4 );
TYPE A_ARR IS ACCESS ARR ;
TYPE A_ARR0 IS ACCESS ARR0 ;
VARR1 , VARR2 : A_ARR ;
VARR01 , VARR02 : A_ARR0 ;
BEGIN
VB1 := NEW TB'( 2 , 3 , 5 );
IF ( VB1.A /=IDENT_INT( 2) OR
VB1.B /=IDENT_INT( 3) OR
VB1.C /=IDENT_INT( 5) )
THEN FAILED( "WRONG VALUES - B1 1" );
END IF;
VB2 := NEW TB'( IDENT_INT(2), IDENT_INT(3), IDENT_INT(6));
IF ( VB2.A /= 2 OR
VB2.B /= 3 OR
VB2.C /= 6 OR
VB1.A /= 2 OR
VB1.B /= 3 OR
VB1.C /= 5 )
THEN FAILED( "WRONG VALUES - B1 2" );
END IF;
VB01 := NEW TB0'( 1 , 2 , 3 );
IF ( VB01.A /=IDENT_INT( 1) OR
VB01.B /=IDENT_INT( 2) OR
VB01.C /=IDENT_INT( 3) )
THEN FAILED( "WRONG VALUES - B2 1" );
END IF;
VB02 := NEW TB0'( IDENT_INT(4) , IDENT_INT(5) ,
IDENT_INT(6) );
IF ( VB02.A /=IDENT_INT( 4) OR
VB02.B /=IDENT_INT( 5) OR
VB02.C /=IDENT_INT( 6) OR
VB01.A /=IDENT_INT( 1) OR
VB01.B /=IDENT_INT( 2) OR
VB01.C /=IDENT_INT( 3) )
THEN FAILED( "WRONG VALUES - B2 2" );
END IF;
VARR1 := NEW ARR'( 5 , 6 , 7 , 8 );
IF ( VARR1(1) /=IDENT_INT( 5) OR
VARR1(2) /=IDENT_INT( 6) OR
VARR1(3) /=IDENT_INT( 7) OR
VARR1(4) /=IDENT_INT( 8) )
THEN FAILED( "WRONG VALUES - B3 1" );
END IF ;
VARR2 := NEW ARR'( IDENT_INT(1) , IDENT_INT(2) , IDENT_INT(3),
IDENT_INT(4) );
IF ( VARR2(1) /= 1 OR
VARR2(2) /= 2 OR
VARR2(3) /= 3 OR
VARR2(4) /= 4 OR
VARR1(1) /= 5 OR
VARR1(2) /= 6 OR
VARR1(3) /= 7 OR
VARR1(4) /= 8 )
THEN FAILED( "WRONG VALUES - B3 2" );
END IF ;
VARR01 := NEW ARR0'( 11 , 12 , 13 );
IF ( VARR01(INTEGER'FIRST) /= IDENT_INT(11) OR
VARR01(INTEGER'FIRST + 1) /= IDENT_INT(12) OR
VARR01(INTEGER'FIRST + 2) /= IDENT_INT(13) )
THEN FAILED( "WRONG VALUES - B4 1" );
END IF ;
IF ( VARR01.ALL'FIRST /= IDENT_INT( INTEGER'FIRST ) OR
VARR01.ALL'LAST /= IDENT_INT( INTEGER'FIRST + 2 ) )
THEN FAILED( "WRONG VALUES - B4 2" );
END IF ;
VARR02 := NEW ARR0'( 1 => IDENT_INT(14) , 2 => IDENT_INT(15));
IF ( VARR02(1) /= 14 OR
VARR02(2) /= 15 OR
VARR01(INTEGER'FIRST) /= 11 OR
VARR01(INTEGER'FIRST + 1) /= 12 OR
VARR01(INTEGER'FIRST + 2) /= 13 )
THEN FAILED( "WRONG VALUES - B4 3" );
END IF ;
END ;
DECLARE
PACKAGE P IS
TYPE UP(A, B : INTEGER) IS PRIVATE;
TYPE A_UP IS ACCESS UP;
CONS1_UP : CONSTANT UP;
CONS2_UP : CONSTANT UP;
CONS3_UP : CONSTANT UP;
CONS4_UP : CONSTANT UP;
PROCEDURE CHECK3 (X : A_UP);
PROCEDURE CHECK4 (X, Y : A_UP);
PRIVATE
TYPE UP(A, B : INTEGER) IS
RECORD
C : INTEGER;
END RECORD;
CONS1_UP : CONSTANT UP := (1, 2, 3);
CONS2_UP : CONSTANT UP := (IDENT_INT(1), IDENT_INT(2),
IDENT_INT(4));
CONS3_UP : CONSTANT UP := (7, 8, 9);
CONS4_UP : CONSTANT UP := (IDENT_INT(10), IDENT_INT(11),
IDENT_INT(12));
END P;
USE P;
V_A_UP1, V_A_UP2 : A_UP;
PACKAGE BODY P IS
PROCEDURE CHECK3 (X : A_UP) IS
BEGIN
IF (X.A /= IDENT_INT(7) OR
X.B /= IDENT_INT(8) OR
X.C /= IDENT_INT(9)) THEN
FAILED ("WRONG VALUES - UP1");
END IF;
END CHECK3;
PROCEDURE CHECK4 (X, Y : A_UP) IS
BEGIN
IF (X.A /= 7 OR X.B /= 8 OR X.C /= 9 OR
Y.A /= 10 OR Y.B /= 11 OR Y.C /= 12) THEN
FAILED ("WRONG VALUES - UP2");
END IF;
END CHECK4;
END P;
BEGIN
V_A_UP1 := NEW P.UP'(CONS3_UP);
CHECK3(V_A_UP1);
V_A_UP2 := NEW P.UP'(CONS4_UP);
CHECK4(V_A_UP1, V_A_UP2);
END;
RESULT;
END C48006B;